Tk Source Code

Changes On Branch core-8-1-branch-old
Login

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

Changes In Branch core-8-1-branch-old Excluding Merge-Ins

This is equivalent to a diff from 2bf55ca9 to 95f2a4dd

1999-04-09
23:32
Fix deadlock situtation in generic/tkWindow.c when Initialize() doesn't let go of the window mutex before returning (error situation). Closed-Leaf check-in: 95f2a4dd user: redman tags: core-8-1-branch-old
21:04
fixed doc bug 901 check-in: 1344d641 user: surles tags: core-8-1-branch-old
1998-09-29
00:15
removed deleted file check-in: 7e215d12 user: stanton tags: core-8-1-branch-old
1998-06-03
15:36
bug fix: 1) If the -initialdir option was "." the result would be "././foo.tcl" instead of an absolute path, like the Windows interface. 2) There is a traceVar on the data(selectPath) where the script was assumes the window exists. check-in: 6dfad3e1 user: surles tags: trunk
1998-04-01
09:51
Created branch core-8-0-2-synthetic Closed-Leaf check-in: 82669d44 user: cvs2fossil tags: core-8-0-2-synthetic, core-8-0-2
09:51
Initial revision check-in: 2bf55ca9 user: rjohnson tags: trunk
09:37
Initial revision check-in: 8922a99f user: rjohnson tags: trunk

Added 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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
1999-04-09    <[email protected]>

	* generic/tkWindow.c: Fixed deadlock situation when the Initialize()
	function returns without releasing the mutex.  Found while testing
	Bug 1700, during safe.test (tk).

1999-04-06    <[email protected]>

	* generic/tkMain.c (Tk_MainEx): Changed to reset result before
	calling Tcl_EvalFile.  The ensures that error messages will be
	generated cleanly.

	* tests/winfo.test: Enabled tests that previously failed.

1999-04-05    <[email protected]>

	* library/bgerror.tcl:
	* library/button.tcl:
	* library/clrpick.tcl:
	* library/console.tcl:
	* library/dialog.tcl:
	* library/entry.tcl:
	* library/focus.tcl:
	* library/listbox.tcl:
	* library/menu.tcl:
	* library/msgbox.tcl:
	* library/palette.tcl:
	* library/scale.tcl:
	* library/scrlbar.tcl:
	* library/tearoff.tcl:
	* library/text.tcl:
	* library/tk.tcl: Lots of minor performance improvements
	contributed by Jeffrey Hobbs. [Bug: 1118]

	* win/tkWinWm.c (Tk_WmCmd): Fixed bad code in tracing
	suboption. [Bug: 1519]

	* library/tkfbox.tcl: Change to restore button text after an
	action to avoid the sticky "Open" button in a save dialog.
	[Bug: 1640]

	* library/entry.tcl: Fixed so selection is returned using the
	-show character during cut and paste operations. [Bug: 1687]
	
1999-04-5     <[email protected]>

	* generic/tkInt.decls:
	* generic/tkIntXlibDecls.h:
	* generic/tkStubInit.c:
	* xlib/xgc.c:
	* xlib/X11/Xlib.h:
	* xlib/X11/Xutil.h: Added more X functions to the Win & Mac stubs
	tables.
	
1999-04-05    <[email protected]>

	* unix/configure.in:
	* generic/tkCanvPs.c: Added configure test for pw_gecos field in
	pwd to support OS/390. [Bug: 1724]

1999-04-02    <[email protected]>

	* tests/text.test: 
	* generic/tkText.c: Fixed handling of Unicode in text searches.
	The -count option was returning byte counts instead of character
	counts. [Bug: 1056, 1148, 1666]

1999-04-01    <[email protected]>

	* generic/tk.decls:
	* generic/tk.h:
	* generic/tkStubInit.c:
	* generic/tkWindow.c:
	* unix/Makefile.in:
	* win/makefile.vc: Tk now uses its own stub library to store
	pointers to its own stubs table.

	* doc/dde.n: (removed)
	* doc/send.n:
	* generic/tk.decls:
	* tests/winSend.test:
	* generic/tkPlatDecls.h:
	* win/tkWinSend.c:  Removed the DDE-based send and dde commands,
	they were causing Tk to lock up when any window on the system was
	not processing its message queue (more importantly, windows in Tcl
	and Tk).  The send command needs to be rewritten to prevent the
	deadlock situation (soon).  The dde command is being pushed into
	its own package and will provide almost all of the capabilities
	that send did before (using a "dde eval" command), not yet
	completed.

1999-03-31    <[email protected]>

	* win/tkWinSend.c: Modified dde/send code to work properly on
	Win95/Win98. String lengths are not returned properly by DDE, so
	NULL terminate all strings going in and ignore the string length
	coming back out.  Do not destroy handles until all necessary work
	on those handles (and child handles) is done.

1999-03-30    <[email protected]>

	* generic/tkWindow.c (Tk_DestroyWindow): Image handlers are now
	finalized before the font subsystem since complex image handlers
	may contain references to fonts (e.g. Tix compound images).
	[Bug: 1603]

1999-03-29    <[email protected]>

	* doc/MeasureChar.3: 
	* doc/TextLayout.3: 
	* generic/tk.decls: 
	* generic/tkCanvText.c: 
	* generic/tkEntry.c:
	* generic/tkFont.c: 
	* generic/tkListbox.c: 
	* generic/tkMessage.c: 
	* mac/tkMacFont.c: 
	* unix/tkUnixButton.c: 
	* unix/tkUnixFont.c: 
	* unix/tkUnixMenu.c: 
	* win/tkWinFont.c: 
	* win/tkWinMenu.c: Standardized text layout and font interfaces
	so they are consistent with respect to byte versus character
	oriented indices.  The layout functions all manipulate character
	oriented values while the lower level measurement functions all
	operate on byte oriented values.  This distinction was not clear
	and so the functions were being used improperly in a number of
	places.  [Bug: 1053, 747, 749, 1646]

	* generic/tk.decls: Eliminated uses of C++ STL types string and
	list from declarations.

	* generic/tkFont.c: Changes to named fonts were not being
	propagated in some cases. [Bug: 1144]
	
	* xlib/X11/Xlib.h:
	* generic/tkInt.decls: Added XParseColor to xlib stub
	tables. [Bug: 1574] 

	* doc/GetBitmap.3: 
	* generic/tkBitmap.c (BitmapInit): Eliminated use of Tk_Uid's in
	bitmaps.  Added a few CONST declarations.

1999-03-29    <[email protected]>

	* unix/configure.in:
	* unix/Makefile.in:
	* win/makefile.vc:
	* generic/tkDecls.h:
	* generic/tkIntDecls.h:
	* generic/tkIntPlatDecls.h:
	* generic/tkPlatDecls.h:
	* generic/tkIntXlibDecls.h: Removed stub functions. Always use the
	Tcl stubs when building with --enable-shared.
	

1999-03-26    <[email protected]>

	* generic/tkTextIndex.c:
	* tests/testIndex.test: Avoid looking past the beginning of the
	array storing data for the text widget (.t index end-2c).  Added
	test case to check for the bug.  [Bug 991]
	
	* generic/tkConsole.c: Copy static strings into a Tcl_DString
	before passing to Tcl_Eval, in case the compiler puts static
	strings into read-only memory.

1999-03-26    <[email protected]>
	
	* unix/configure.in:
        --nameble-shared is now the default and builds Tk as a shared
        library; specify --disable-shared to build a static Tk library
        and shell.

1999-03-26    <[email protected]>

	* library/menu.tcl: Fixed bug reported by Bryan Oakley in the
	menubutton bindings.  There was a false assumption that there was
	always a menu attached to the button.  [Bug 1116] 

1999-03-26    <[email protected]>

	* unix/configure.in: Removed --enable-tcl-stub.  Linking Tk to Tcl
 	stubs is causing too many problems when linking executables like wish.
  	Until the Tk is a fully loadable extension, linking against the Tcl
 	stubs is not supported in Tk.

1999-03-19    <[email protected]>

	* generic/tkBitmap.c:
	* generic/tkCursor.c:
	* generic/tkGC.c: When creating hash tables that key off of XID
 	handles, make sure to pass TCL_ONE_WORD_KEYS.  XIDs are guaranteed
 	to be 32bit numbers, although on some 64bit systems (including 64bit
 	Solaris 7) they are packed into a 64bit value where the upper 32bits
 	are zero. The normal method of sizeof(XID)/sizeof(int) causes the
 	hash table code to assume that the XID is a pointer to an array of 
	two ints, which it is not.  Tk now supports 64bit Solaris 7.

1999-03-17    <[email protected]>

	* win/makefile.vc: 
	* generic/tk.h: Changed to use TCL_BETA_RELEASE macro, and fixed
	so this works in rc files.
	
	* win/makefile.vc: 
	* win/makefile.bc: 
	* win/README: 
	* unix/configure.in: 
	* generic/tk.h: 
	* README: Updated version to 8.1b3.

1999-03-14    <stanton@GASPODE>

	* unix/configure.in: Added missing stub related definitions.

	* unix/Makefile.in: Install tkDecls.h in addition to tk.h.

	* generic/tkStubLib.c: Added flags to ensure we are using Tcl
	stub macros.

1999-03-11    <stanton@GASPODE>

	* generic/tkInt.decls: Added reserved slot for XSetDashes for use
	by the dash patch.

1999-03-10    <[email protected]>

	* xlib/xdraw.c:
	* xlib/X11/Xlib.h:
	* mac/tkMac.h:
	* mac/tkMacInt.h:
	* mac/tkMacPort.h:
	* mac/tkMacXStubs.c:
	* mac/tkMacAppInit.c:
	* mac/tkMacCursor.c:
	* win/makefile.vc:
	* win/tkWin.h:
	* win/tkWinInt.h:
	* win/tkWinPort.h:
	* win/winMain.c:
	* generic/tk.h:
	* generic/tkInt.h:
	* generic/tk.decls:
	* generic/tkInt.decls:
	* generic/tkDecls.h:
	* generic/tkPlatDecls.h:
	* generic/tkIntDecls.h:
	* generic/tkIntPlatDecls.h:
	* generic/tkIntXlibDecls.h:
	* generic/tkStubs.c:
	* generic/tkPlatStubs.c:
	* generic/tkIntStubs.c:
	* generic/tkIntPlatStubs.c:
	* generic/tkIntXlibStubs.c:
	* generic/tkStubInit.c:
	* generic/tkStubLib.c:
	* generic/tkBind.c:
	* generic/tkCmds.c:
	* generic/tkConfig.c:
	* generic/tkConsole.c: 
	* generic/tkCursor.c:
	* generic/tkGrab.c:
	* generic/tkImgPhoto.c:
	* generic/tkMain.c:
	* generic/tkMenu.c:
	* generic/tkPointer.c:
	* generic/tkTextDisp.c:
	* generic/tkWindow.c:
	* unix/tkUnixInt.h:
	* unix/tkUnixPort.h:
	* unix/Makefile.in:
	* unix/configure.in:
	* unix/tkConfig.sh.in:
	* unix/tkUnix.c:
	* unix/tkUnix3d.c:
	* unix/tkUnixDraw.c:
	* unix/tkUnixFont.c:
	* unix/tkUnixMenubu.c: Stubs implementation for 8.1.  Tk_Main() is
	replaced with a macro which calls Tk_MainEx(). Tk can link to the Tcl
	stubs library, wish links directly to Tcl and Tk. Use
	--enable-tcl-stubs to link Tk to the Tcl stubs library (Unix), on
	by default on Windows. Exported all public functions through the
	stubs mechanism (see the *.decls files) and many of the internal
	functions. Most of the changes dealt with shifting around the
	function declarations in the header files.  Mac code may not
	compile, but it shouldn't take much work to fix this.
	
	* mac/tkMacMenu.c: Added dummy TkpMenuThreadInit for Mac to be
	consistent with Unix and Windows versions.
	
1999-03-08    <[email protected]>

	* win/tkWinWm.c: Toplevel class no longer shared between 
	threads.
	
	* win/tkWinX.c: Multiple threads no longer share the same
	TkDisplay structure.  Required because TkDisplay stores much
	thread-specific data for a given thread.

	* win/tkWinSend.c: Moved application instance handle out
	out thread-local storage.  DDE was failing to initialize
	when the instance handles were different between threads.
	
	* win/makefile.vc: Added THREADDEFINES for building with
	threads enabled.
	
	* generic/tkMenu.c:
	* win/tkWinMenu.c:
	* unix/tkUnixMenu.c: Added TkpMenuThreadInit for initializing
	thread-specific Menu state.

1999-03-01    <[email protected]>

	* win/tkWinWm.c: 
	* win/tkWinPointer.c:
	* win/tkWinInt.h: Fix "focus -force" for Windows.  The Win32 API
	function SetForegroundWindow() does not work unless the window
	handle is a toplevel window (a Windows toplevel).  The handle
	being passed was a Tk toplevel, which is a child of the Windows
	toplevel.

1999-02-26    <[email protected]>

	* win/cat.c: Remove this file, use the one in the Tcl source directory.

	* win/makefile.vc: Remove the wishc.exe from the default targets.  Add
	a separate console-wish target to build it.  The need for a 
	console-wish will go away soon, so we don't want to encourage its
	use.

1999-02-25    <[email protected]>

	* win/tkWinWm.c: Properly initialize the tsdPtr->firstWindow field.
	
	* win/cat.c: Code for cat32.exe, copied from the Tcl sources. Required
	in order to run the test suite from the makefile

	* win/winMain.c: Add main() for a console-based wishc.exe, which meant
	adding code to disable the call to Tk_ConsoleInit().
	
	* generic/tkConsole.c: Check the standard handles before creating the
	new standard channels.	This allows a windows app that has stdin,
	stdout, or stderr to correctly connect to them.
	
	* generic/tkMain.c: Add a proper check for the interactive mode, since
	the standard channels may actually be connected in windows mode or
	even in the console-based wish.
	
	* win/makefile.vc: Add targets for wishc.exe (console-based wish) and
	cat32.exe (for testing). Fix the test suite target so it can be run
	from the makefile (which can happen since the standard handles have
	been fixed).

1999-02-12    <[email protected]>

	* generic/tkMenuButton.h:
	* generic/tkMenuButton.c:
	* mac/tkMacMenubutton.c:
	* mac/tkMacDefault.h
	* unix/tkUnixMenubu.c: Eliminated Tk_Uids used by -state option.
	* unix/tkUnixDefault.h
	* win/tkWinDefault.h
	

	* generic/tk.h:
	* generic/tkScale.h:
	* generic/tkScale.c:
	* generic/tkWindow.c:
	* unix/tkUnixScale.c:	
	* unix/tkUnixDefault.h:
	* unix/tkWinDefault.h:
	* mac/tkMacDefault.h:  Objectified scale widget.

	* win/tkWinX.c: Removed Thread-specific data from process
	initialization code that was stopping the Tk Dll from 
	loading.

1999-02-11    <stanton@GASPODE>

	* README:
	* generic/tk.h: 
	* unix/configure.in:
	* win/README:
	* win/makefile.bc:
	* win/makefile.vc: Updated version to 8.1b2.
	
	* unix/tkUnixSend.c: Fixed one more Tcl_*ObjVar instance.
	
1999-02-04    <stanton@GASPODE>

	* Various cleanup related to the Tcl_Eval and Tcl_ObjSetVar
	changes in Tcl.
	
	INTEGRATED PATCHES FROM 8.0.5b2: 
	
	* win/tkWinMenu.c (TkpDestroyMenu): Changed so modalMenuPtr is
	cleared when it is being destroyed.

	* generic/tkImgPhoto.c: Changed so color tables are freed
	immediately instead of being delayed.  This ensures that color
	tables are properly disposed at process exit.

	* library/prolog.ps: Changed string that determines font height to
	include European character with an umlaut.

	* generic/tkImgBmap.c (ImgBmapConfigureInstance): If an image
	mask changed but ended up with the same XID, the GC failed to be
	updated and so the new mask was not used. [Bug: 970]

	* generic/tkFocus.c (SetFocus): Changed so focus window is always
	set if -force is specified.  This fixes the problem on Windows
	where Tk does not activate the window if it already has focus.

	* generic/tkConsole.c: Fixed so errors in console eval are
	reported properly.  Eliminated duplicate result messages. [Bug: 973]

	* win/tkWinWm.c: Changed so windows that aren't resizable don't
	have resize handles and the zoom box is disabled.

	* win/tkWinInt.h:
	* win/tkWinPointer.c: Changed to cancel the mouse timer when a
	user initiated move/resize loop begins.

	* unix/configure.in: TK_LD_SEARCH_FLAGS was set incorrectly if
	SHLIB_LD_LIBS='${LIBS}', and shared linking is performed through
	the C compiler. Systems affected are Linux, MP-RAS and NEXTSTEP,
	but also with gcc on many more systems. [Bug: 908]

	* win/makefile.vc: First stab at install target.  Fixed quoting so
	paths with spaces work.
	
	* tests/main.test:
	* tests/unixWm.test: Better cleanup of temporary files.
	
	* mac/tkMacAppInit.c:
	* generic/tkTest.c:
	* generic/tkAppInit.c:
	* win/winMain.c: Changed some EXTERN declarations to extern
	since they are not defining exported interfaces.  This avoids
	generating useless declspec() attributes and makes the windows
	makefile simpler.

	* library/menu.tcl (tkMenuFind): Changed so keyboard shortcuts
	will only be found in the current toplevel.  Previously, they
	might be found in menus attached to other toplevels that might not
	even be mapped. [Bug: 924]

	* generic/tkCanvLine.c: Changed to treat zero width lines like
	they have width 1 for purposes of selection. [Bug: 925]

	* win/tkWinFont.c (Tk_MeasureChars): Added a workaround for a bug
	in GetTextExtentExPoint on Win NT 4.0/Japanese. [Bug: 1006]

	* unix/tkUnixSend.c (Tk_SetAppName): Fixed uninitialized memory
	access bug. [Bug: 919]

1999-1-28    <stanton@GASPODE>

	* generic/tkGrid.c: Fixed bug in "grid forget" that failed to cancel
	pending idle handlers, resulting in a crash in a few odd cases.

1999-01-06  <lfb@JUSTICE>

	* generic/tk.h, generic/tkGet.c, generic/tkConfig.c, 
	* generic/tkOldConfig.c, generic/tkEntry.c, generic/tkMenubutton.c, 
	* generic/tkMenubutton.h, generic/tkScale.c, generic/tkScale.h, 
	* generic/tkTextDisplay.c, generic/tkText.c, unix/tkUnixMenubu.c, 
	* unix/tkUnixScale.c, mac/tkMacMenu.c, mac/tkMacMenubutton.c, 
	
	Removed global Tk_Uids dealing with "-state" configuration option
	and added new TK_CONFIG_STATE configSpec that doesn't use 
	Tk_Uids.

1998-12-11    === Tk 8.1b1 Release ===
	
1998-12-11    <stanton@GASPODE>

	* generic/tkMain.c (Tk_Main): Fixed improper command line encoding
	handling. 

1998-12-08    <stanton@GASPODE>

	* win/tkWinClipboard.c (TkSelGetSelection, TkWinClipboardRender):
	Changed to handle multibyte characters properly. [Bug: 935]

1998-12-07    <stanton@GASPODE>

	* library/xmfbox.tcl (tkMotifFDialog_Create): In the cached case,
	the data array was not being initialized with the correct set of
	widgets.

1998-12-4    <welch@SAGE>

	* Changed patchLevel to 8.1b1

	* generic/tkMenu.c (ConfigureMenuCloneEntries): The -menu configuration
	option was being incorrectly specified as just "menu". 

1998-11-30    <stanton@GASPODE>

	* generic/tkButton.c (ConfigureButton): The error result was
	getting lost when restoring configuration options. [Bug: 619]

1998-11-25    <stanton@GASPODE>

	* unix/tkUnixFont.c (GetFontAttributes): Initialize an unspecified
	family to an empty string.
	(FontMapLoadPage): if the font included characters below 32, the
	index computation was incorrect because the range was shifted up
	to 32.
	(CreateClosestFont): check for empty locale as well as NULL.

	* generic/tkFont.c (TkFontParseXLFD): initialize charset to
	iso8859-1 if no charset is specified.

	* mac/tkMacHLEvents.c (OdocHandler): added conversion from
	external string to UTF [Bug: 869]

	* integrated tk8.0.4 changes.
	
	* generic/tkBind.c: fixed deletion order bug where a crash would
	result if a binding deleted "."

	* generic/tkMenu.c (MenuWidgetObjCmd): disabled menu entries were
	getting reenabled whenever the mouse passed over the entry [Bug: 860]

	* unix/tkUnixMenu.c (TkpComputeStandardMenuGeometry): hidemargin
	option was not honored properly in menus [Bug: 859]

1998-11-24    <stanton@GASPODE>

	* tkMacMenu.c, tkUnixMenu.c, tkWinMenu.c, tkMenuDraw.c, tkMenu.h,
	* tkMenu.c: Backed out the previous fix for bug 620 and
	eliminated a bunch of code that created unnecessary objects.
	Changed back to using internal types instead of objects for many
	configuration options.	There are many more fixes like this that
	could be made, but some require a little restructuring of the
	code. In any case the leaks are fixed and there is a lot less
	allocation happening. [Bug: 620]

1998-11-19    <stanton@GASPODE>

	* tkMenu.c (DestroyMenuEntry): fixed memory leaks [Bug: 620]
	
	* tkWinX.c (GetTranslatedKey): fixed bad code merge

	* tkWinWm.c, tkWinMenu.c: fixed titles and menus so they properly
	display Unicode [Bug: 819]

Changes to README.


1


2

3














4
5
6
7
8
9
10

11

12
13

14
15
16


17
18
19
20

21


22




23
24
25
26
27





28
29
30
31
32
33
34
35
36
37




















38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

58


59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126

127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308


309








310
311


312


313

314

315




316

317

318


319




320

321






322
323


324
325
326
327
328
329
330
331
332
333
334







335
336
337
338
339

340

341


342

343

344
345





346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377



378





379
380
381











The Tk Toolkit




SCCS: @(#) README 1.47 97/11/20 12:48:16















1. Introduction
---------------

This directory and its descendants contain the sources and documentation
for Tk, an X11 toolkit implemented with the Tcl scripting language.  The
information here corresponds to Tk 8.0p2, which is the second patch update

for Tk 8.0.  This release is designed to work with Tcl 8.0p2 and may not

work with any other version of Tcl.


Tk 8.0 is a major release with significant new features such as native
look and feel on Macintoshes and PCs, a new font mechanism, application
embedding, and proper support for Safe-Tcl.  See below for details.


There should be no backward incompatibilities in Tk 8.0 that affect
scripts.  This patch release fixes various bugs in Tk 8.0; there are no
feature changes relative to Tk 8.0.


Note: with Tk 8.0 the Tk version number skipped from 4.2 to 8.0. The


jump was made in order to synchronize the Tcl and Tk version numbers.





2. Documentation
----------------

The best way to get started with Tk is to read one of the introductory





books on Tcl and Tk:

    Practical Programming in Tcl and Tk, 2nd Edition, by Brent Welch,
    Prentice-Hall, 1997, ISBN 0-13-616830-2

    Tcl and the Tk Toolkit, by John Ousterhout,
    Addison-Wesley, 1994, ISBN 0-201-63337-X

    Exploring Expect, by Don Libes,
    O'Reilly and Associates, 1995, ISBN 1-56592-090-2





















The "doc" subdirectory in this release contains a complete set of
reference manual entries for Tk.  Files with extension ".1" are for
programs such as wish; files with extension ".3" are for C library
procedures; and files with extension ".n" describe Tcl commands.  To
print any of the manual entries, cd to the "doc" directory and invoke
your favorite variant of troff using the normal -man macros, for example

		ditroff -man wish.1

to print wish.1.  If Tk has been installed correctly and your "man"
program supports it, you should be able to access the Tcl manual entries
using the normal "man" mechanisms, such as

		man wish

If you are porting Tk 3.6 scripts to Tk 4.0 or later releases, you may
find the Postscript file doc/tk4.0.ps useful.  It is a porting guide
that summarizes the new features and discusses how to deal with the
changes in Tk 4.0 that are not backwards compatible.




There is also an official home for Tcl and Tk on the Web:
	http://www.smli.com/research/tcl
These Web pages include release updates, reports on bug fixes and porting
issues, HTML versions of the manual pages, and pointers to many other
Tcl/Tk Web pages at other sites.  Check them out!

3. Compiling and installing Tk
------------------------------

This release contains everything you should need to compile and run
Tk under UNIX, Macintoshes, and PCs (either Windows NT, Windows 95,
or Win 3.1 with Win32s).

Before trying to compile Tk you should do the following things:

    (a) Check for a binary release.  Pre-compiled binary releases are
        available now for PCs and Macintoshes, and several flavors of
        UNIX.  Binary releases are much easier to install than source
        releases.  To find out whether a binary release is available for
        your platform, check the home page for the Sun Tcl/Tk project
        (http://www.sunlabs.com/research/tcl) and also check in the FTP
        directory from which you retrieved the base distribution.


    (b) Make sure you have the most recent patch release.  Look in the
	FTP directory from which you retrieved this distribution to see
	if it has been updated with patches.  Patch releases fix bugs
	without changing any features, so you should normally use the
	latest patch release for the version of Tk that you want. 
	Patch releases are available in two forms.  A file like
	tk8.0p1.tar.Z is a complete release for patch level 1 of Tk
	version 8.0.  If there is a file with a higher patch level than
	this release, just fetch the file with the highest patch level
	and use it.

	Patches are also available in the form of patch files that just
	contain the changes from one patch level to another.  These
	files have names like tk8.0p1.patch, tk8.0p2.patch, etc.  They
	may also have .gz or .Z extensions to indicate compression.  To
	use one of these files, you apply it to an existing release with
	the "patch" program.  Patches must be applied in order:
	tk8.0p1.patch must be applied to an unpatched Tk 8.0 release
	to produce a Tk 8.0p1 release;  tk8.0p2.patch can then be
	applied to Tk 8.0p1 to produce Tk 8.0p2, and so on. To apply an
	uncompressed patch file such as tk8.0p1.patch, invoke a shell
	command like the following from the directory containing this
	file:
	    patch -p < tk8.0p1.patch
	If the patch file has a .gz extension, it was compressed with
	gzip.  To apply it, invoke a command like the following:
	    gunzip -c tk8.0p1.patch.gz | patch -p
	If the patch file has a .Z extension, it was compressed with
	compress.  To apply it, invoke a command like the following:
	    zcat tk8.0p1.patch.Z | patch -p
	If you're applying a patch to a release that has already been
	compiled, then before applying the patch you should cd to the
	"unix" subdirectory and type "make distclean" to restore the
	directory to a pristine state.

Once you've done this, change to the "unix" subdirectory if you're
compiling under UNIX, "win" if you're compiling under Windows, or
"mac" if you're compiling on a Macintosh.  Then follow the instructions
in the README file in that directory for compiling Tk, installing it,
and running the test suite.

4. Getting started
------------------

The best way to get started with Tk is by reading one of the introductory

books.

The subdirectory library/demos contains a number of pre-canned scripts
that demonstrate various features of Tk.  See the README file in the
directory for a description of what's available.  The file
library/demos/widget is a script that you can use to invoke many individual
demonstrations of Tk's facilities, see the code that produced the demos,
and modify the code to try out alternatives.

5. Summary of changes in Tk 8.0
-------------------------------

Here is a list of the most important new features in Tk 8.0.  The
release also includes several smaller feature changes and bug fixes. 
See the "changes" file for a complete list of all changes.

    1. Native look and feel.  The widgets have been rewritten to provide
    (nearly?) native look and feel on the Macintosh and PC.  Many
    widgets, including scrollbars, menus, and the button family, are
    implemented with native platform widgets.  Others, such as entries
    and texts, have been modified to emulate native look and feel. 
    These changes are backwards compatible except that (a) some
    configuration options are now ignored on some platforms and (b) you
    must use the new menu mechanism described below to native look and
    feel for menus.

    2. There is a new interface for creating menus, where a menubar is
    implemented as a menu widget instead of a frame containing menubuttons.
    The -menu option for a toplevel is used to specify the name of the
    menubar; the menu will be displayed *outside* the toplevel using
    different mechanisms on each platform (e.g. on the Macintosh the menu
    will appear at the top of the screen).  See the menu demos in the
    widget demo for examples.  The old style of menu still works, but
    does not provide native look and feel.  Menus have several new
    features:
        - New "-columnbreak" and "-hideMargin" options make it possible
	  to create multi-column menus.
	- It is now possible to manipulate the Apple and Help menus on
	  the Macintosh, and the system menu on Windows.  It is also
	  possible to have a right justified Help menu on Unix.
	- Menus now issue the virtual event <<MenuSelect>> whenever the
	  current item changes.  Applications can use this to generate
	  help messages.
        - There is a new "-direction" option for menubuttons, which
	  controls where the menu pops up revenues to the button.

    3. The font mechanism in Tk has been completely reworked:
	- Font names need not be nasty X LFDs: more intuitive names
	  like {Times 12 Bold} can also be used.  See the manual entry
	  font.n for details.
	- Font requests always succeed now.  If the requested font is
	  not available, Tk finds the closest available font and uses
	  that one.
	- Tk now supports named fonts whose precise attributes can be
	  changed dynamically.  If a named font is changed, any widget
	  using that font updates itself to reflect the change.
	- There is a new command "font" for creating named fonts and
	  querying various information about fonts.
	- There are now officially supported C APIs for measuring and
	  displaying text.  If you use these APIs now, your code will
	  automatically handle international text when internationalization
	  is added to Tk in a future release.  See the manual entries
	  MeasureChar.3, TextLayout.3, and FontId.3.
	- The old C procedures Tk_GetFontStruct, Tk_NameOfFontStruct,
	  and Tk_FreeFontStruct have been replaced with more portable
	  procedures Tk_GetFont, Tk_NameOfFont, and Tk_FreeFont.

    4. Application embedding.  It is now possible to embedded one Tcl/Tk
    application inside another, using the -container option on frame
    widgets and the -use option for toplevel widgets or on the command
    line for wish.  Embedding should be fully functional under Unix,
    but the implementation is incomplete on the Macintosh and PC.

    5. Tk now works correctly with Safe-Tcl: it can be loaded into
    safe interpreters using safe::loadTk.

    6. Text widgets now allow images to be embedded directly in the
    text without using embedded windows.  This is more efficient and
    provides smoother scrolling.

    7. Buttons have a new -default option for drawing default rings in
    a platform-specific manner.

    8. There is a new "gray75" bitmap, and the "gray25" bitmap is now
    really 25% on (due to an ancient mistake, it had been only 12% on).
    The Macintosh now supports native bitmaps, including new builtin
    bitmaps "stop", "caution", and "note", plus the ability to use
    bitmaps in the application's resource fork.

    9. The "destroy" command now ignores windows that don't exist
    instead of generating an error.

Tk 8.0 introduces the following incompatibilities that may affect Tcl/Tk
scripts that worked under Tk 4.2 and earlier releases:

    1. Font specifications such as "Times 12" now interpret the size
    as points, whereas it used to be pixels (this was actually a bug,
    since the behavior was documented as points).  To get pixels now,
    use a negative size such as "Times -12".

    2. The -transient option for menus is no longer supported.  You can
    achieve the same effect with the -type field.

    3. In the canvas "coords" command, polygons now return only the
    points that were explicitly specified when the polygon was created
    (they used to return an extra point if the polygon wasn't originally
    closed).  Internally, polygons are still closed automatically for
    purposes of display and hit detection; the extra point just isn't
    returned by the "coords" command.

    4. The photo image mechanism now uses Tcl_Channels instead of FILEs,
    in order to make it portable.  FILEs are no longer used anywhere
    in Tk.  The procedure Tk_FindPhoto now requires an extra "interp"
    argument in order to fix a bug where images in different interpreters
    with the same name could get confused.

    5. The procedures Tk_GetFontStruct, Tk_NameOfFontStruct,
    and Tk_FreeFontStruct have been removed.

Note: the new compiler in Tcl 8.0 may also affect Tcl/Tk scripts; check
the Tcl documentation for information on incompatibilities introduced by
Tcl 8.0.

6. Tcl/Tk newsgroup
-------------------

There is a network news group "comp.lang.tcl" intended for the exchange
of information about Tcl, Tk, and related applications.  Feel free to use
this newsgroup both for general information questions and for bug reports.
We read the newsgroup and will attempt to fix bugs and problems reported
to it.

When using comp.lang.tcl, please be sure that your e-mail return address
is correctly set in your postings.  This allows people to respond directly
to you, rather than the entire newsgroup, for answers that are not of
general interest.  A bad e-mail return address may prevent you from
getting answers to your questions.  You may have to reconfigure your news
reading software to ensure that it is supplying valid e-mail addresses.

7. Mailing lists
----------------

A couple of  Mailing List have been set up to discuss Macintosh or
Windows related Tcl issues.  In order to use these Mailing Lists you
must have access to the internet.  If you have access to the WWW the
home pages for these mailing lists are located at the following URLs:

	http://www.sunlabs.com/research/tcl/lists/mactcl-list.html

		-and-

	http://www.sunlabs.com/research/tcl/lists/wintcl-list.html

The home pages contain information about the lists and an HTML archive
of all the past messages on the list.  To subscribe send a message to:
	
	[email protected]
	
In the body of the message (the subject will be ignored) put:
	
	subscribe mactcl Joe Blow
	
Replacing Joe Blow with your real name, of course.  (Use wintcl
instead of mactcl if your interested in the Windows list.)  If you
would just like to receive more information about the list without
subscribing but the line:

	information mactcl
	
in the body instead (or wintcl).

8. Tcl/Tk contributed archive
--------------------------

Many people have created exciting packages and applications based on Tcl
and/or Tk and made them freely available to the Tcl community.  An archive
of these contributions is kept on the machine ftp.neosoft.com.  You
can access the archive using anonymous FTP;  the Tcl contributed archive is
in the directory "/pub/tcl".  The archive also contains several FAQ
("frequently asked questions") documents that provide solutions to problems
that are commonly encountered by TCL newcomers.



9. Support and bug fixes








------------------------



We're very interested in receiving bug reports and suggestions for


improvements.  We prefer that you send this information to the

comp.lang.tcl newsgroup rather than to any of us at Sun.  We'll see

anything on comp.lang.tcl, and in addition someone else who reads 




comp.lang.tcl may be able to offer a solution.  The normal turn-around

time for bugs is 3-6 weeks.  Enhancements may take longer and may not

happen at all unless there is widespread support for them (we're


trying to slow the rate at which Tk turns into a kitchen sink).  It's




very difficult to make incompatible changes to Tcl at this point, due

to the size of the installed base.







When reporting bugs, please provide a short wish script that we can


use to reproduce the bug.  Make sure that the script runs with a
bare-bones wish and doesn't depend on any extensions or other
programs, particularly those that exist only at your site.  Also,
please include three additional pieces of information with the
script:
    (a) how do we use the script to make the problem happen (e.g.
	what things do we click on, in what order)?
    (b) what happens when you do these things (presumably this is
        undesirable)?
    (c) what did you expect to happen instead?








The Tcl/Tk community is too large for us to provide much individual
support for users.  If you need help we suggest that you post questions
to comp.lang.tcl.  We read the newsgroup and will attempt to answer
esoteric questions for which no-one else is likely to know the answer.
In addition, Tcl/Tk support and training are available commercially from

NeoSoft ([email protected]), Computerized Processes Unlimited

([email protected]), and Data Kinetics ([email protected]).




10. Release organization

------------------------






Each Tk release is identified by two numbers separated by a dot, e.g.
3.2 or 3.3.  If a new release contains changes that are likely to break
existing C code or Tcl scripts then the major release number increments
and the minor number resets to zero: 3.0, 4.0, etc.  If a new release
contains only bug fixes and compatible changes, then the minor number
increments without changing the major number, e.g. 3.1, 3.2, etc.  If
you have C code or Tcl scripts that work with release X.Y, then they
should also work with any release X.Z as long as Z > Y.

Alpha and beta releases have an additional suffix of the form a2 or b1.
For example, Tk 3.3b1 is the first beta release of Tk version 3.3,
Tk 3.3b2 is the second beta release, and so on.  A beta release is an
initial version of a new release, used to fix bugs and bad features
before declaring the release stable.  An alpha release is like a beta
release, except it's likely to need even more work before it's "ready
for prime time".  New releases are normally preceded by one or more
alpha and beta releases.  We hope that lots of people will try out
the alpha and beta releases and report problems.  We'll make new alpha/
beta releases to fix the problems, until eventually there is a beta
release that appears to be stable.  Once this occurs we'll make the
final release.

We can't promise to maintain compatibility among alpha and beta releases.
For example, release 4.1b2 may not be backward compatible with 4.1b1, even
though the final 4.1 release will be backward compatible with 4.0.  This
allows us to change new features as we find problems during beta testing.
We'll try to minimize incompatibilities between beta releases, but if a
major problem turns up then we'll fix it even if it introduces an
incompatibility.  Once the official release is made then there won't
be any more incompatibilities until the next release with a new major
version number.




Patch releases have a suffix such as p1 or p2.  These releases contain





bug fixes only.  A patch release (e.g Tk 4.1p2) should be completely
compatible with the base release from which it is derived (e.g. Tk
4.1), and you should normally use the highest available patch release.










>
|
>
>

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




|
|
|
>
|
>
|

>
|
<
<
>
>
|
<
|

>
|
>
>
|
>
>
>
>




|
>
>
>
>
>
|









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
















|
<
<
<
>

>
>
|
|
|
|
<





|
|




|
|
|
|
|
|
>






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










|
>
|




|
|
|

|


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

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

<
<
|
<
<
<
<
<

<
<
|
<
<
|
<
<
<
<

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


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










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

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

|
>
>
|
|
|
|
|






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

>
|
>
|

>
>
>
>
>

|



|



|
|
|
|
|
|
|
|
|
|
|
|





|
|




>
>
>
|
>
>
>
>
>
|
|
|
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35


36
37
38

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106



107
108
109
110
111
112
113
114

115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138





























139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162



163









164



















165




















166

167



168


169



170


171





172


173


174




175























176
















177
178




179

180

181

182


183















184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
README:  Tk

	Tk is maintained, enhanced, and distributed freely as a
	service to the Tcl community by Scriptics Corporation.

RCS: @(#) $Id: README,v 1.1.4.6 1999/03/17 22:06:27 stanton Exp $

Contents
--------
    1. Introduction
    2. Documentation
    3. Compiling and installing Tk
    4. Getting started
    5. Summary of changes in Tk 8.1
    6. Development tools
    7. Tcl newsgroup
    8. Tcl contributed archive
    9. Tcl Resource Center
    10. Mailing lists
    11. Support and bug fixes
    12. Tk version numbers

1. Introduction
---------------

This directory contains the sources and documentation for Tk, an X11
toolkit implemented with the Tcl scripting language.  The information
here corresponds to release 8.1b3, which is the third beta release
for Tk 8.1.  This release is mostly feature complete but may have bugs
and be missing some minor features.  This release is for early
adopters who are willing to help us find and fix problems.  Please let
us know about any problems you uncover.

The most important change in Tk 8.1 is that it supports the new
internationalization features in Tcl 8.1.  It also contains a new


library for handling configuration options some of the widgets have
been converted to use the Tcl object facilities.  For details on
features, incompatibilities, and potential problems with this release,

see the Tcl/Tk 8.1 Web page at

	http://www.scriptics.com/software/8.1.html

or refer to the "changes" file in this directory, which contains a
historical record of all changes to Tk.

Tk is a freely available open source package.  You can do virtually
anything you like with it, such as modifying it, redistributing it,
and selling it either in whole or in part.  See the file
"license.terms" for complete information.

2. Documentation
----------------

The best way to get started with Tk is to read about Tk on the
Scriptics Web site at:

	http://www.scriptics.com/scripting

Another good way to get started with Tcl is to read one of the
introductory books on Tcl:

    Practical Programming in Tcl and Tk, 2nd Edition, by Brent Welch,
    Prentice-Hall, 1997, ISBN 0-13-616830-2

    Tcl and the Tk Toolkit, by John Ousterhout,
    Addison-Wesley, 1994, ISBN 0-201-63337-X

    Exploring Expect, by Don Libes,
    O'Reilly and Associates, 1995, ISBN 1-56592-090-2

Other books are listed at
http://www.scriptics.com/resource/doc/books/

There is also an official home for Tcl and Tk on the Scriptics Web site:

	http://www.scriptics.com

These Web pages include information about the latest releases, products
related to Tcl and Tk, reports on bug fixes and porting issues, HTML
versions of the manual pages, and pointers to many other Tcl/Tk Web
pages at other sites.  Check them out!

If you are porting Tk 3.6 scripts to Tk 4.0 or later releases, you may
find the Postscript file doc/tk4.0.ps useful.  It is a porting guide
that summarizes the new features and discusses how to deal with the
changes in Tk 4.0 that are not backwards compatible.

2a. Unix Documentation
----------------------

The "doc" subdirectory in this release contains a complete set of
reference manual entries for Tk.  Files with extension ".1" are for
programs such as wish; files with extension ".3" are for C library
procedures; and files with extension ".n" describe Tcl commands.  To
print any of the manual entries, cd to the "doc" directory and invoke
your favorite variant of troff using the normal -man macros, for example

		ditroff -man wish.1

to print wish.1.  If Tk has been installed correctly and your "man"
program supports it, you should be able to access the Tcl manual entries
using the normal "man" mechanisms, such as

		man wish

2b. Windows Documentation



-------------------------

The "doc/help" subdirectory in this release contains a complete set of
Windows help files for TclPro.  Once you install this Tcl release, a
shortcut to the Windows help Tcl documentation will appear in the
"Start" menu:

	Start | Programs | Tk | Tk Help


3. Compiling and installing Tk
------------------------------

This release contains everything you should need to compile and run
Tk under UNIX, PCs (either Windows NT, Windows 95, or Win 3.1 with
Win32s), and Macintoshes.

Before trying to compile Tk you should do the following things:

    (a) Check for a binary release.  Pre-compiled binary releases are
        available now for PCs, Macintoshes, and several flavors of UNIX.
        Binary releases are much easier to install than source releases.
        To find out whether a binary release is available for your
        platform, check the Scriptics Tcl Resource Center
        (http://www.scriptics.com/resource).  Also, check in
        the FTP directory from which you retrieved the base
        distribution.

    (b) Make sure you have the most recent patch release.  Look in the
	FTP directory from which you retrieved this distribution to see
	if it has been updated with patches.  Patch releases fix bugs
	without changing any features, so you should normally use the
	latest patch release for the version of Tk that you want. 






























Once you've done this, change to the "unix" subdirectory if you're
compiling under UNIX, "win" if you're compiling under Windows, or
"mac" if you're compiling on a Macintosh.  Then follow the instructions
in the README file in that directory for compiling Tk, installing it,
and running the test suite.

4. Getting started
------------------

The best way to get started with Tk is by reading one of the
introductory books.  See the documentation section above for more
details.

The subdirectory library/demos contains a number of pre-canned scripts
that demonstrate various features of Tk.  See the README file in the
directory for a description of what's available.  The file
library/demos/widget is a script that you can use to invoke many
individual demonstrations of Tk's facilities, see the code that
produced the demos, and modify the code to try out alternatives.

5. Summary of changes in Tk 8.1
-------------------------------




6. Development tools









--------------------








































A high quality set of commercial development tools is now available to

accelerate your Tk application development.  Scriptics' TclPro



product provides a debugger, static code checker, packaging utility,


and bytecode compiler.  Visit the Scriptics Web site at:






	http://www.scriptics.com/tclpro








for more information on TclPro and for a free 30-day evaluation


download.




























7. Tcl newsgroup
















----------------





There is a network news group "comp.lang.tcl" intended for the

exchange of information about Tcl, Tk, and related applications.  The

newsgroup is a greata place to ask general information questions.  For

bug reports, please see the "Support and bug fixes" section below.


















8. Tcl contributed archive
--------------------------

Many people have created exciting packages and applications based on Tcl
and/or Tk and made them freely available to the Tcl community.  An archive
of these contributions is kept on the machine ftp.neosoft.com.  You
can access the archive using anonymous FTP;  the Tcl contributed archive is
in the directory "/pub/tcl".  The archive also contains several FAQ
("frequently asked questions") documents that provide solutions to problems
that are commonly encountered by TCL newcomers.

9. Tcl Resource Center
----------------------

Visit http://www.scriptics.com/resource/ to see an annotated index of
many Tcl resources available on the World Wide Web.  This includes
papers, books, and FAQs, as well as development tools, extensions,
applications, binary releases, and patches.  You can also recommend
additional URLs for the resource center using the forms labeled "Add a
Resource".

10. Mailing lists
-----------------

A couple of  Mailing List have been set up to discuss Macintosh or
Windows related Tcl issues.  To subscribe send a message to:
	
	[email protected]
	[email protected]
	
In the body of the message (the subject will be ignored) put:
	
	subscribe mactcl Joe Smith
	
Replacing Joe Smith with your real name, of course.  (Use wintcl
instead of mactcl if your interested in the Windows list.)  If you
would just like to receive more information about the list without
subscribing put the line:

	information mactcl
	
in the body instead (or wintcl).

11. Support and bug fixes
-------------------------

Scriptics is very interested in receiving bug reports, patches, and
suggestions for improvements.  We prefer that you send this
information to us via the bug form on the Scriptics Web site, rather
than emailing us directly.  The bug form is at:

	http://www.scriptics.com/support/bugForm.html

The bug form was designed to give uniform structure to bug reports as
well as to solicit enough information to minimize followup questions.
The bug form also includes an option to automatically post your report
on comp.lang.tcl.  We strongly recommend that you select this option
because someone else who reads comp.lang.tcl may be able to offer a
solution.

When reporting bugs, please provide full information about the Tcl/Tk
version and the platform on which you are running Tcl/Tk.  Also,
please include a short wish script that we can use to reproduce the
bug.  Make sure that the script runs with a bare-bones wish and
doesn't depend on any extensions or other programs, particularly those
that exist only at your site.  Also, please include three additional
pieces of information with the script:

    (a) how do we use the script to make the problem happen (e.g.
	what things do we click on, in what order)?
    (b) what happens when you do these things (presumably this is
        undesirable)?
    (c) what did you expect to happen instead?

We will log and follow-up on each bug, although we cannot promise a
specific turn-around time.  Enhancements may take longer and may not
happen at all unless there is widespread support for them (we're
trying to slow the rate at which Tcl/Tk turns into a kitchen sink).
It's very difficult to make incompatible changes to Tcl/Tk at this
point, due to the size of the installed base.

The Tcl community is too large for us to provide much individual
support for users.  If you need help we suggest that you post
questions to comp.lang.tcl.  We read the newsgroup and will attempt to
answer esoteric questions for which no-one else is likely to know the
answer.  In addition, Tcl/Tk support and training are available
commercially from Scriptics at:

	http://www.scriptics.com/training

Also see the following Web site for links to other organizations that
offer Tcl/Tk training:

	http://www.scriptics.com/resource/commercial/training

12. Tk version numbers
----------------------

You can test the current version of Tk by examining the
tk_version and tk_patchLevel variables.  The tk_patchLevel
variable follows the naming rules outlined below (e.g., 8.0.5).
The tk_version just has the major.minor numbers in it (e.g., 8.0)

Each Tk release is identified by two numbers separated by a dot, e.g.
3.6 or 4.0.  If a new release contains changes that are likely to break
existing C code or Tcl scripts then the major release number increments
and the minor number resets to zero: 3.0, 4.0, etc.  If a new release
contains only bug fixes and compatible changes, then the minor number
increments without changing the major number, e.g. 4.1, 4.2, etc.  If
you have C code or Tcl scripts that work with release X.Y, then they
should also work with any release X.Z as long as Z > Y.

Alpha and beta releases have an additional suffix of the form a2 or
b1.  For example, Tk 4.0b1 is the first beta release of Tk version
4.0, Tk 4.0b2 is the second beta release, and so on.  A beta release
is an initial version of a new release, used to fix bugs and bad
features before declaring the release stable.  An alpha release is
like a beta release, except it's likely to need even more work before
it's "ready for prime time".  New releases are normally preceded by
one or more alpha and beta releases.  We hope that lots of people will
try out the alpha and beta releases and report problems.  We'll make
new alpha/beta releases to fix the problems, until eventually there is
a beta release that appears to be stable.  Once this occurs we'll make
the final release.

We can't promise to maintain compatibility among alpha and beta releases.
For example, release 4.1b2 may not be backward compatible with 4.1b1, even
though the final 4.1 release will be backward compatible with 4.0.  This
allows us to change new features as we find problems during beta testing.
We'll try to minimize incompatibilities between beta releases, but if
a major problem turns up then we'll fix it even if it introduces an
incompatibility.  Once the official release is made then there won't
be any more incompatibilities until the next release with a new major
version number.

(Note: This compatibility is true for Tcl scripts, but historically
the Tcl C APIs have changed enough between releases that you may need
to work a bit to upgrade extensions.)

Patch releases now have a suffix such as ".4" or ".5".  Prior to
version 8.0.3, patch releases had the suffix "p1" or "p2".  So, the
8.0 release went to 8.0p1, 8.0p2, 8.0.3, 8.0.4, and 8.0.5.  The alphas
and betas continue to use the 'a' and 'b' letters in their
tk_patchLevel.  Patch releases normally contain bug fixes only.  A
patch release (e.g Tk 8.0.5) should be completely compatible with the
base release from which it is derived (e.g. Tk 8.0), and you should
normally use the highest available patch release.

Note: with Tk 8.0 the Tk version number skipped from 4.2 to 8.0. The
jump was made in order to synchronize the Tcl and Tk version numbers.

13. Thank You
-------------

We'd like to express our thanks to the Tcl community for all the
helpful suggestions, bug reports, and patches we have received.
Tcl/Tk has improved vastly and will continue to do so with your help.

Changes to changes.

1
2
3
4
5
6
7
8
9
10
11
12
This file summarizes all changes made to Tk since version 1.0 was
released on March 13, 1991.  Changes that aren't backward compatible
are marked specially.

SCCS: @(#) changes 1.252 97/11/25 08:31:19

3/16/91 (bug fix) Modified tkWindow.c to remove Tk's Tcl commands from
the interpreter when the main window is deleted (otherwise there will
be dangling pointers to the non-existent window).

3/16/91 (bug fix) Modified tkColor.c not to free black or white colors:
some X servers get upset at this.




|







1
2
3
4
5
6
7
8
9
10
11
12
This file summarizes all changes made to Tk since version 1.0 was
released on March 13, 1991.  Changes that aren't backward compatible
are marked specially.

RCS: @(#) $Id: changes,v 1.1.4.13 1999/04/06 05:48:56 welch Exp $

3/16/91 (bug fix) Modified tkWindow.c to remove Tk's Tcl commands from
the interpreter when the main window is deleted (otherwise there will
be dangling pointers to the non-existent window).

3/16/91 (bug fix) Modified tkColor.c not to free black or white colors:
some X servers get upset at this.
4005
4006
4007
4008
4009
4010
4011




4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
key sequences from having the character echoed to the widget. Also
fixed Cut & Copy bindings.  (JI) (RJ)

9/18/97 (bug fix) Revamped Macintosh focus code.  Cut, Copy & Paste
virtual events now go to the correct (focus) window. (RJ)

9/19/97 (bug fix) Made Macintosh tearoff menus non-resizable. (RJ)





10/9/97 (bug fix) Image code could cause crashes during "exit" under
some conditions (such as an image named "place").  (JO)

10/9/97 (bug fix) Fixed bug that sometimes prevented listboxes from
scrolling far enough horizontally to see the rightmost character.  (JO)

10/9/97 (bug fix) Default font for new canvas text items was hardcoded to
"Helvetica 12" instead of using DEF_CANVTEXT_FONT defined in
tk{platform}Default.h like all the other widget settings.  (CCS)

10/10/97 (bug fix) In canvas text items, if the text ended with a \n, it
was not counted in the bbox height, as it did in tk4.2.  This caused
"hello\n" to be the same height as "hello" and you couldn't see the
cursor positioned on the next line. (CCS)

10/10/97 (bug fix) The grid geometry manager didn't always properly
forget about windows after a "grid forget" or "grid remove" command:
the windows could reappear on the screen later.  (JO)

10/13/97 (bug fix) Selection could not be restored to a text widget







>
>
>
>







<
<
<
<
|
|
|







4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022




4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
key sequences from having the character echoed to the widget. Also
fixed Cut & Copy bindings.  (JI) (RJ)

9/18/97 (bug fix) Revamped Macintosh focus code.  Cut, Copy & Paste
virtual events now go to the correct (focus) window. (RJ)

9/19/97 (bug fix) Made Macintosh tearoff menus non-resizable. (RJ)

10/9/97 (bug fix) Default font for new canvas text items was hardcoded to
"Helvetica 12" instead of using DEF_CANVTEXT_FONT defined in
tk{platform}Default.h like all the other widget settings.  (CCS)

10/9/97 (bug fix) Image code could cause crashes during "exit" under
some conditions (such as an image named "place").  (JO)

10/9/97 (bug fix) Fixed bug that sometimes prevented listboxes from
scrolling far enough horizontally to see the rightmost character.  (JO)





10/10/97 (bug fix) In canvas text items, if the text ended with a \n, it 
was not counted in the bbox height, as it did in tk4.2.  This caused 
"hello\n" to be the same height as "hello" and you couldn't see the 
cursor positioned on the next line. (CCS)

10/10/97 (bug fix) The grid geometry manager didn't always properly
forget about windows after a "grid forget" or "grid remove" command:
the windows could reappear on the screen later.  (JO)

10/13/97 (bug fix) Selection could not be restored to a text widget
4123
4124
4125
4126
4127
4128
4129







































































































































































































































































































































































































































































11/20/97 (bug fix) Fixed bug in rendering transparent gifs on Text
widgets. (JI)

11/20/97 (enhancement) Made the changes required to work with the new
Apple Universal Headers V. 3.0 so we can compile with CW Pro 2.0 (JI)

----------------- Released 8.0p2, 11/25/97 -----------------------














































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
11/20/97 (bug fix) Fixed bug in rendering transparent gifs on Text
widgets. (JI)

11/20/97 (enhancement) Made the changes required to work with the new
Apple Universal Headers V. 3.0 so we can compile with CW Pro 2.0 (JI)

----------------- Released 8.0p2, 11/25/97 -----------------------

11/25/97 (security bug fix + added feature) Tk Safe Init now asks
the master's safe::TkInit for the 'argv' to use. This is transparently
dealt with by the safe::loadTk API. New optional "-display displayName"
argument to safe::loadTk, and the "-use" argument accepts both window
Ids and Tk window names: see loadTk(n). Made the ":0.0" default display
work on the Mac as it works on Windows and Unix. (DL)

12/3/97 (bug fix/optimization) Removed unneeded and potentially dangerous
instances of double evaluations if "if" and "expr" statements from
the library files. It is recommended that unless you need a double
evaluation you always use "expr {...}" instead of "expr ..." and
"if {...} ..." instead of "if ... ...". It will also be faster
thanks to the byte compiler. (DL)

12/3/97 (new feature) Added support for browser/plugin style embedding, 
and made various other fixes to get the plugin working on the Mac. (JI)

12/8/97 (bug fix) on Windows, using "winfo pathname" before "." was mapped
was crashing. (DL)

---- Shipped as part of the plugin2.0b5 as 8.0p2Plugin1, Dec 8th 97 ----

12/97 (bug fix) more Macintosh embeding fixes needed for the plugin. (JI)

Jan/9/98 (improvement) Allow applications to have custom init script
without  having to patch the Tk core: Tk_Init will use an existing
"tkInit" proc if one exists in the interp where one tries to install Tk
instead of defining it's own (tkInit is the transient proc defined in
generic/tkInitScript.h that searches and sources tk.tcl and defines 
the 'correct' tk_library). (DL)

---- Shipped as part of the plugin2.0 as 8.0p2Plugin2, Jan 15th 98 ----

6/3/98 (bug fix) Fixed bugs in the tk_getOpenFile under Unix.
 1) If the -initialdir option was "." the result would be "././foo.tcl"
    instead of an absolute path, like the Windows interface.  
 2) There is a traceVar on the data(selectPath) where the script was
    assumes the window exists. (BS)

6/12/98 (feature change) Focus -force now sets the foreground window
on Windows platforms in addition to moving the focus. (SS)

6/12/98 (bug fix) Fixed bug in Windows font measurement that did not
take kerning into account. (BS)

6/24/98 (bug fix) On Unix, fixed -initialdir switch to tk_getOpenFile
and tk_getSaveFile to convert the specified directory to an absolute
path and to use the current working directory if the specified
directory does not exist. (SS)

6/25/98 (bug fix) On Unix, both the Tk and the Motif file dialogs
would fail if the -parent flag changed between two parent windows that
had been previously used as file dialog parents. (SS)

6/29/98 (compatibility patch)  Added reserved fields to several Tk
structures to match additions made by Jan Nijtmans dash patch.  This
means that extensions can be compiled against the dash patch
and still work with unpatched Tk, and vice versa.

7/6/98 (bug fix) Added keysym definitions for the new keys on the
Microsoft keyboards.  You can bind to <App>, <Win_L>, and <Win_R>,
but you cannot use the Win keys as modifiers. (SS, BW)

7/6/98 (new feature) Added support for the Macintosh Appearance Manager. (JI)

7/24/98 (feature change) Eliminated the static variable that sets
tk_library and simplified search order for tk.tcl.  The tk_library
variable can now be set before calling Tk_Init to avoid doing any
searches.  If it isn't set, then Tk checks env(TK_LIBRARY), relative
to tcl_library, an install directory relative to the executable, a
source directory relative to the executable, and a tk directory
relative to the source heirarchy containing the executable.  See the
comment at the top of generic/tkInitScript.h for more details. (SS)

7/27/98 (bug fix) The bbox for coords in the canvas were incorrectly
including the center of the coord as part of the bound area.  (RJ)

8/4/98 (bug fix) Fixed memory leak in Windows menu code. (SS)

8/4/98 (bug fix) Fixed bug where bgerror's were not being generated 
from menu callbacks on Windows. (SS)

8/4/98 (bug fix) Alt-key bindings were not being handled properly 
under Windows, resulting in annoying beeps. (SS)

8/4/98 (bug fix) Fixed bug in Windows menubar handling that allowed
a shared menubar to be deleted when any window using it was deleted. (SS)

8/4/98 (feature change) Introduced TkReadBitmapFile to replace
XReadBitmapFile so that all Tk file opens go through the Tcl channel
mechanism.  This lets us wrap applications that define their own
bitmaps and cursors. Note that XReadBitmapFile is no longer
emulated for non-unix platforms platforms (RJ, BW)

8/5/98 (bug fix) <Insert> binding in entries was masking the virtual
event <<Paste>> binding to Shift-Insert on Windows. (SS)

8/5/98 (bug fix) wm frame would crash if the window had not been
mapped yet on Windows. (SS)

8/5/98 (bug fix) Local grabs did not exclude menus or the caption bar
under Windows. (SS)

8/5/98 (bug fix) Reduced message traffic by setting
WS_EX_NOPARENTNOTIFY on TkChild windows. (SS)

8/6/98 (feature change) Changed tkInitScript.h to use the new
tcl_findLibrary procedure to locate its script library. (BW)

8/10/98 (bug fix) Added special case to font code to limit the
length of displayed strings to avoid wrap-around bugs in some
PC X servers when the pixel length of the string exceeds 0x7fff. (SS)

8/12/98 (bug fix) Macintosh, lock down some of the resources
associated with menus to try and stabilise the menu system
on memory limited machines. (JI)

8/12/98 (windows build change) Moved the tkConsole.obj into the tk80.dll
on windows.  If you build your own Tk main program, you no longer
need to compile and link this yourself. (SKS)

-------- Released 8.0.3 to the Tcl Consortium CD-ROM project, 8/13/98 ------

10/5/98 (new feature) Added the event "MouseWheel" that will fire on
Windows applications in response to mouse wheel movement.  You can
bind to the MouseWheel event and use the %D substitution to get the
delta the wheel moved.  The "event generate" command has also been
enhanced with the -delta flag so you can generate these events from
Tcl.  See the bind and event man pages for more details.  The listbox
and text widgets' default bindings have been updated to understand
MouseWheel events. (RJ)

10/12/98 (performance improvement) Added hash table to canvas widget
that holds numeric ids for items.  The hash table makes item lookup
almost constant time which improves certain canvas operations
(exspecially for canvases with large number items).  Thanks to Mark
Weissman <[email protected]> and Jan Nijtmans <[email protected]>
for submitting this improvement.  (RJ)

10/15/98 (bug fix) The -fill option to text items in the canvas did
not allow the empty string as an argument (meaning transparent) even
though every other item type did.  Thanks to Sebastian Wangnick
<[email protected]> for supplying this patch. (RJ)

10/20/98 (feature change) The Makefile and configure scripts have been
changed for IRIX to build n32 binaries instead of the old 32 abi
format.  If you have extensions built with the o32 abi's you will need
to update them to n32 for them to work with Tcl.  (RJ)
*** POTENTIAL INCOMPATIBILITY ***

11/10/98 (feature change) The Macintosh menus will use the Appearance
Theme backgrounds, separators and menu shape, if Appearance version
1.0.1 or greater is installed.  The version of Appearance that shipped
with MacOS 8.0 so it will not work with a straight 8.0, but it will
with MacOS 8.1 or later. (JI)

----------------- Released 8.0.4, 11/20/98 -----------------------

11/24/98 (bug fix) On some X servers, XQueryLoadFont will always
return a font, even if the name is meaningless.  This prevents Tk from
parsing the font name, so now we perform a quick sanity check on the
name before letting X have it. (stanton)

12/30/98 (bug fix) Fixed bug in "grid forget" that failed to cancel
pending idle handlers, resulting in a crash in a few odd cases. (stanton)

1/28/99 (configure change) Now support -pipe option on gcc.  (RJ)

2/4/99 (bug fix) Changed so color tables in photo images are freed
immediately instead of being delayed.  This ensures that color tables
are properly disposed at process exit. (stanton)

2/4/99 (bug fix) Changed postscript template to	include a European
character with an umlaut when determining font height. (stanton)

2/4/99 (bug fix) If an image bitmap mask changed but ended up with the
same XID, the GC failed to be updated and so the new mask was
not used. (stanton)

2/4/99 (bug fix) Changed so focus window is always set if -force is
specified.  This fixes the problem on Windows where Tk does not
activate the window if it already has focus. (stanton)

2/4/99 (bug fix) Fixed so errors in console eval are reported
properly.  Eliminated duplicate result messages. (stanton)

2/4/99 (bug fix) Under Windows, changed so toplevels that aren't
resizable don't have resize handles and the zoom box is disabled. (stanton)

2/4/99 (bug fix) Changed to cancel the mouse timer when a user
initiated move/resize loop begins on Windows. (stanton)

2/4/99 (configure change) TK_LD_SEARCH_FLAGS was set incorrectly if
SHLIB_LD_LIBS='${LIBS}', and shared linking is performed through the C
compiler. Systems affected are Linux, MP-RAS and NEXTSTEP, but also
with gcc on many more systems.

2/4/99 (bug fix) Changed some EXTERN declarations to extern since they
are not defining exported interfaces.  This avoids generating useless
declspec() attributes and makes the Windows makefile simpler. (stanton)

2/4/99 (bug fix) Changed so keyboard shortcuts will only be found in
the current toplevel.  Previously, they might be found in menus
attached to other toplevels that might not even be mapped. (stanton)
*** POTENTIAL INCOMPATIBILITY ***

2/4/99 (bug fix) Changed to treat zero width lines in the canvas like
they have width 1 for purposes of selection. (stanton)

2/4/99 (bug fix) Added a workaround for a bug in GetTextExtentExPoint
on Win NT 4.0/Japanese that cause a crash in some cases. (stanton)

2/4/99 (bug fix) Fixed uninitialized memory access bug in Unix send
code. (stanton)

----------------------------------------------------------
Changes for Tk 8.0 go above this line.
Changes for Tk 8.1 go below this line.
----------------------------------------------------------

1/16/98 (new feature) Tk now supports international characters sets:
    - Font display mechanism overhauled to display Unicode strings
      containing full set of international characters.  You do not need
      Unicode fonts on your system in order to use tk or see international
      characters.  For those familiar with the Japanese or Chinese patches,
      there is no "-kanjifont" option.  Characters from any available fonts
      will automatically be used if the widget's originally selected font is
      not capable of displaying a given character.  
    - Textual widgets are international aware.  For instance, cursor
      positioning commands would now move the cursor forwards/back by 1
      international character, not by 1 byte.  
    - Input Method Editors (IMEs) work on Mac and Windows.  Unix is still in
      progress.

7/7/97 (new feature) The send command now works for Microsoft
Windows. It is implemented using Dynamic Data Exchange, and a new
command, dde, allows Tk to send more generic DDE commands to other
applications. (SRP)

11/3/97 (new feature) Major overhaul of code that manages configuration
options to use Tcl_Obj structures instead of strings:
    - There is a new set of procedures including Tk_CreateOptionTable,
      Tk_InitOptions, and Tk_SetOptions, which replace Tk_ConfigureWidget
      and related procedures.  The old procedures are still available.
      The new procedures use a new format for configuration tables.
      See SetOptions.3 for more information.
    - There are new procedures Tk_AllocColorFromObj, Tk_GetColorFromObj,
      and Tk_FreeColorFromObj to manage colors using objects to hold the
      name of the color and cache the corresponding XColor pointer.
      There are similar procedures Tk_Alloc3DBorderFromObj,
      Tk_AllocBitmapFromObj, Tk_AllocCursorFromObj, Tk_AllocFontFromObj,
      and so on to manage borders, bitmaps, cursors, and fonts.
    - The old-style procedures such as Tk_GetColor and Tk_GetBitmap no
      longer take Tk_Uids for arguments; they just take strings.
    - Menus, labels, buttons, checkbuttons, and radiobuttons have been
      converted to use the new object-based configuration library.
      (SRP & JO)

11/7/97 (improvement) Changed code referring to "interp->result" to call
accessor functions like Tcl_SetResult().

12/23/97 (fix) Fixed transparency and web optimized the palette of
the images/ Tcl powered logos. (DL)

12/16/97 (bug fix) Canvas and text "bind" subcommands generated an
error with no message if called to fetch a binding that didn't exist.
They now silently return without an error like the "bind" command. (SS)

1/13/98 (bug fix) Keysyms for international characters were not being
reported properly under Windows. (SS)

----------------- Released 8.1a1, 1/22/98 -----------------------

2/4/98 (bug fix) Calling XFreeFontNames() twice if couldn't allocate
font. (CCS)

2/10/98 (bug fix) Inlined prolog.ps in tkCanvPs.c to make it accessible
from safe interpreters: canvas postscript now works in safe interps
(like in tk8.0plugin). (DL)

2/11/98 (bug fix) Windows "send" to a remote interp wasn't propagating
$errorInfo correctly from the remote interp to the local invoking interp.
(CCS)

2/11/98 (bug fix) Windows "send" should have accepted "--" to mean "no more
arguments". (CCS)

2/11/98 (bug fix) Windows "send" was concatenating its arguments
incorrectly (not consistent with "eval", "uplevel", or Unix "send"). (CCS)

2/18/98 (bug fix) Macintosh radiobuttons and checkbuttons now color
their backgrounds correctly under Appearance.  The controls gadgets themselves
however, remain the Theme colors. (JI)

2/18/98 (improvement) The corner pixels that peek through around the
rounded corners of the Mac button widget are now controlled by the
-highlightbackground, rather than the -background option. (JI)

2/18/98 (improvement) Implemented the intra-application Send on the
Mac (RJ)

2/18/98 (bug fix) Under X, a problem mapping from a fontStructPtr to an
XLFD (no XA_FONT attribute) would lead to dereferencing NULL. (CCS)

----------------- Released 8.1a2, Feb 20 1998 -----------------------

10/21/98 (bug fix) Tk_UnderlineChars did not handle UTF strings properly
so underline indices were in bytes instead of characters. (stanton)

11/19/98 (bug fix) Fixed menus and titles so they properly display
Unicode characters under Windows. [Bug: 819] (stanton)

11/24/98 (bug fix) Fixed a bunch of memory leaks in the Windows menu
code. [Bug: 620] (stanton)

11/25/98 (bug fix) Various small bug fixes: (stanton)
	- hidemargin option was not honored properly in menus [Bug: 859]
	- disabled menu entries were getting reenabled whenever the
	mouse passed over the entry [Bug: 860]
	- fixed deletion order bug where a crash would result if a
	binding deleted "."

11/30/98 (bug fix) The error result was getting lost when restoring
configuration options in buttons. [Bug: 619] (stanton)

12/8/98 (bug fix) The Windows clipboard was not correctly traslating
multibyte characters. [Bug: 935] (stanton)

----------------- Released 8.1b1, Dec 11 1998 -----------------------

1/29/99 (bug fix) Fixed bug in "grid forget" that failed to cancel
pending idle handlers, resulting in a crash in a few odd
cases. (stanton)

2/4/99 (bug fix): Fixed uninitialized memory access in
Tk_SetAppName. [Bug: 919] (stanton)

2/4/99 (bug fix): Added a workaround for a bug in GetTextExtentExPoint
on Win NT 4.0/Japanese. [Bug: 1006] (stanton)

2/4/99 (bug fix): Changed so keyboard shortcuts for menus will only be
found in the current toplevel.  Previously, they might be found in
menus attached to other toplevels that might not even be mapped.
[Bug: 924] (stanton)

2/4/99 (bug fix): Changed to treat zero width lines in the canvas like
they have width 1 for purposes of selection. [Bug: 925] (stanton)

2/4/99 (bug fix): TK_LD_SEARCH_FLAGS was set incorrectly if
SHLIB_LD_LIBS='${LIBS}', and shared linking is performed through the C
compiler. Systems affected are Linux, MP-RAS and NEXTSTEP, but also
with gcc on many more systems. [Bug: 908] (stanton)

2/4/99 (feature enhancement): Changed so windows that aren't resizable
don't have resize handles and the zoom box is disabled on
Windows. (stanton)

2/4/99 (bug fix): Fixed so errors in console eval are reported
properly.  Eliminated duplicate result messages. [Bug: 973] (stanton)

2/4/99 (bug fix): Changed so focus window is always set if -force is
specified.  This fixes the problem on Windows where Tk does not
activate the window if it already has focus. (stanton)

2/4/99 (bug fix): If an image mask changed but ended up with the same
XID, the GC failed to be updated and so the new mask was not
used. [Bug: 970] (stanton)

2/12/99 (new feature): Tk is now thread safe.  You enable this by
configuring with --enable-threads.  Tcl must also be compiled with
--enable-threads.  See Tcl for more information about the threading
interfaces. (lfb)

2/25/99 (bug fix) Under Windows, wish can now inherit pipe handles on
stdio so it is possible to use the wish executable in a command
pipeline to capture the output of puts or read from the pipe with
gets.  (redman)

3/1/99 (bug fix) Under Windows, Tk was not properly handling focus and
activation changes in some cases. (redman)

3/10/99 (new feature) Tk now uses the new stub library feature in Tcl.
The Tk library now contains no direct references to any symbols in
Tcl.  In addition, there is a new Tk_MainEx() function that takes an
interpreter as an argument.  See the Tcl documentation for more
information about the stubs mechanism. (redman)

3/14/99 (feature change) Test suite now uses "test" namespace to
define the test procedure and other auxiliary procedures as well as
global variables.
    - Global array testConfige is now called ::test::testConfig.
    - Global variable VERBOSE is now called ::test::verbose, and
      ::test::verbose no longer works with numerical values.  We've
      switched to a bitwise character string.  You can set
      ::test::verbose by using the -verbose option on the Tk command
      line.
    - Global variable TESTS is now called ::test::matchingTests, and
      can be set on the Tk command line via the -match option.
    - There is now a ::test::skipTests variable (works similarly to
      ::test::matchTests) that can be set on the Tk command line via
      the -match option.
    - The test suite can now be run in any working directory.  When
      you run "make test", the working directory is nolonger switched
      to ../tests.
(hirschl)
*** POTENTIAL INCOMPATIBILITY ***

----------------- Released 8.1b2, March 16, 1999 ---------------------

3/23/99 (feature change) Test suite now uses "tcltest" namespace to
define the test procedure and other auxiliary procedures as well as
global variables.  The previously chosen "test" namespace was thought
to be too generic and likely to create conflits.
(hirschl)
*** POTENTIAL INCOMPATIBILITY ***

3/26/99 [bug fix]  Fixed bug reported by Bryan Oakley in the
menubutton bindings.  There was a false assumption that there was
always a menu attached to the button.  [Bug 1116] (surles)

3/26/99 (feature change) Removed --enable-tcl-stub from the configure
script. Linking Tk to Tcl stubs is causing too many problems when
linking executables like wish.  Until the Tk is a fully loadable
extension, linking against the Tcl stubs is not supported in Tk.
(redman)

3/26/99 (feature change) --nameble-shared is now the default and builds
Tk as a shared library; specify --disable-shared to build a static Tk
library and shell.
*** POTENTIAL INCOMPATIBILITY ***

3/29/99 (api change) Standardized text layout and font interfaces
so they are consistent with respect to byte versus character
oriented indices.  The layout functions all manipulate character
oriented values while the lower level measurement functions all
operate on byte oriented values. (stanton)

4/1/99 (bug fix) Image handlers are finalized before the font subsystem
to fix crashes during finalization of complex widgets. (stanton)

4/1/99 (feature change) Removed the send command on Windows.  Moved
the DDE basis of that command out to its own extension.  The send
implementation on top of DDE was causing Tk to lock up in some cases.
(redman)

4/5/99 (bug fix) Fixed handling of Unicode in text searches.  The
-count option was returning byte counts instead of character counts.

4/5/99 (feature change) Cut and paste to an entry widget returns the
selection instead of the widget contents, which can be different if the
-show option is used to hide the display. (stanton)

--------------- Released 8.1b3, April 6, 1999 ----------------------

Changes to compat/limits.h.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) limits.h 1.8 96/07/08 18:00:13
 */

#define LONG_MIN		0x80000000
#define LONG_MAX		0x7fffffff
#define INT_MIN			0x80000000
#define INT_MAX			0x7fffffff
#define SHRT_MIN		0x8000







|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: limits.h,v 1.1.4.1 1998/09/30 02:15:14 stanton Exp $
 */

#define LONG_MIN		0x80000000
#define LONG_MAX		0x7fffffff
#define INT_MIN			0x80000000
#define INT_MAX			0x7fffffff
#define SHRT_MIN		0x8000

Changes to compat/stdlib.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
/*
 * stdlib.h --
 *
 *	Declares facilities exported by the "stdlib" portion of
 *	the C library.  This file isn't complete in the ANSI-C
 *	sense;  it only declares things that are needed by Tcl.
 *	This file is needed even on many systems with their own
 *	stdlib.h (e.g. SunOS) because not all stdlib.h files
 *	declare all the procedures needed here (such as strtod).
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) stdlib.h 1.10 96/02/15 14:43:54
 */

#ifndef _STDLIB
#define _STDLIB

#include <tcl.h>












|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
/*
 * stdlib.h --
 *
 *	Declares facilities exported by the "stdlib" portion of
 *	the C library.  This file isn't complete in the ANSI-C
 *	sense;  it only declares things that are needed by Tcl.
 *	This file is needed even on many systems with their own
 *	stdlib.h (e.g. SunOS) because not all stdlib.h files
 *	declare all the procedures needed here (such as strtod).
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: stdlib.h,v 1.1.4.2 1998/09/30 02:15:15 stanton Exp $
 */

#ifndef _STDLIB
#define _STDLIB

#include <tcl.h>

Changes to compat/unistd.h.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 * software and its documentation for any purpose and without
 * fee is hereby granted, provided that the above copyright
 * notice appear in all copies.  The University of California
 * makes no representations about the suitability of this
 * software for any purpose.  It is provided "as is" without
 * express or implied warranty.
 *
 * SCCS: @(#) unistd.h 1.7 96/02/15 14:43:57
 */

#ifndef _UNISTD
#define _UNISTD

#include <sys/types.h>
#ifndef _TCL







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 * software and its documentation for any purpose and without
 * fee is hereby granted, provided that the above copyright
 * notice appear in all copies.  The University of California
 * makes no representations about the suitability of this
 * software for any purpose.  It is provided "as is" without
 * express or implied warranty.
 *
 * RCS: @(#) $Id: unistd.h,v 1.1.4.1 1998/09/30 02:15:15 stanton Exp $
 */

#ifndef _UNISTD
#define _UNISTD

#include <sys/types.h>
#ifndef _TCL

Changes to doc/3DBorder.3.

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
'\"
'\" Copyright (c) 1990-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) 3DBorder.3 1.23 96/11/17 15:03:05
'\" 
.so man.macros
.TH Tk_Get3DBorder 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_Get3DBorder, Tk_Draw3DRectangle, Tk_Fill3DRectangle, Tk_Draw3DPolygon, Tk_Fill3DPolygon, Tk_3DVerticalBevel, Tk_3DHorizontalBevel, Tk_SetBackgroundFromBorder, Tk_NameOf3DBorder, Tk_3DBorderColor, Tk_3DBorderGC, Tk_Free3DBorder \- draw borders with three-dimensional appearance
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp

Tk_3DBorder



\fBTk_Get3DBorder(\fIinterp, tkwin, colorName\fB)\fR




.sp
void
\fBTk_Draw3DRectangle(\fItkwin, drawable, border, x, y, width, height, borderWidth, relief\fB)\fR
.sp
void
\fBTk_Fill3DRectangle(\fItkwin, drawable, border, x, y, width, height, borderWidth, relief\fB)\fR
.sp


|




|


|


|




>

>
>
>

>
>
>
>







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
'\"
'\" Copyright (c) 1990-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: 3DBorder.3,v 1.1.4.2 1998/09/30 02:15:16 stanton Exp $
'\" 
.so man.macros
.TH Tk_Alloc3DBorderFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_Alloc3DBorderFromObj, Tk_Get3DBorder, Tk_Get3DBorderFromObj, Tk_Draw3DRectangle, Tk_Fill3DRectangle, Tk_Draw3DPolygon, Tk_Fill3DPolygon, Tk_3DVerticalBevel, Tk_3DHorizontalBevel, Tk_SetBackgroundFromBorder, Tk_NameOf3DBorder, Tk_3DBorderColor, Tk_3DBorderGC, Tk_Free3DBorderFromObj, Tk_Free3DBorder \- draw borders with three-dimensional appearance
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
.VS 8.1
Tk_3DBorder
\fBTk_Alloc3DBorderFromObj(\fIinterp, tkwin, objPtr\fB)\fR
.sp
Tk_3DBorder
\fBTk_Get3DBorder(\fIinterp, tkwin, colorName\fB)\fR
.sp
Tk_3DBorder
\fBTk_Get3DBorderFromObj(\fItkwin, objPtr\fB)\fR
.VE
.sp
void
\fBTk_Draw3DRectangle(\fItkwin, drawable, border, x, y, width, height, borderWidth, relief\fB)\fR
.sp
void
\fBTk_Fill3DRectangle(\fItkwin, drawable, border, x, y, width, height, borderWidth, relief\fB)\fR
.sp
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
\fBTk_NameOf3DBorder(\fIborder\fB)\fR
.sp
XColor *
\fBTk_3DBorderColor(\fIborder\fB)\fR
.sp
GC *
\fBTk_3DBorderGC(\fItkwin, border, which\fB)\fR




.sp
\fBTk_Free3DBorder(\fIborder\fB)\fR
.SH ARGUMENTS
.AS "Tk_3DBorder" borderWidth
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
.AP Tk_Window tkwin in
Token for window (for all procedures except \fBTk_Get3DBorder\fR,
must be the window for which the border was allocated).
.AP Tk_Uid colorName in

Textual description of color corresponding to background (flat areas).
Illuminated edges will be brighter than this and shadowed edges will
be darker than this.




.AP Drawable drawable in
X token for window or pixmap;  indicates where graphics are to be drawn.
Must either be the X window for \fItkwin\fR or a pixmap with the
same screen and depth as \fItkwin\fR.
.AP Tk_3DBorder border in
Token for border previously allocated in call to \fBTk_Get3DBorder\fR.
.AP int x in







>
>
>
>









|
>
|
|
|
>
>
>
>







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
\fBTk_NameOf3DBorder(\fIborder\fB)\fR
.sp
XColor *
\fBTk_3DBorderColor(\fIborder\fB)\fR
.sp
GC *
\fBTk_3DBorderGC(\fItkwin, border, which\fB)\fR
.sp
.VS 8.1
\fBTk_Free3DBorderFromObj(\fItkwin, objPtr\fB)\fR
.VE
.sp
\fBTk_Free3DBorder(\fIborder\fB)\fR
.SH ARGUMENTS
.AS "Tk_3DBorder" borderWidth
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
.AP Tk_Window tkwin in
Token for window (for all procedures except \fBTk_Get3DBorder\fR,
must be the window for which the border was allocated).
.AP Tcl_Obj *objPtr in
.VS 8.1
Pointer to object whose value describes color corresponding to
background (flat areas).  Illuminated edges will be brighter than
this and shadowed edges will be darker than this.
.AP char *colorName in
Same as \fIobjPtr\fR except value is supplied as a string rather
than an object.
.VE
.AP Drawable drawable in
X token for window or pixmap;  indicates where graphics are to be drawn.
Must either be the X window for \fItkwin\fR or a pixmap with the
same screen and depth as \fItkwin\fR.
.AP Tk_3DBorder border in
Token for border previously allocated in call to \fBTk_Get3DBorder\fR.
.AP int x in
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
Specifies which of the border's graphics contexts is desired.
Must be TK_3D_FLAT_GC, TK_3D_LIGHT_GC, or TK_3D_DARK_GC.
.BE

.SH DESCRIPTION
.PP
These procedures provide facilities for drawing window borders in a
way that produces a three-dimensional appearance.  \fBTk_Get3DBorder\fR


allocates colors and Pixmaps needed to draw a border in the window
given by the \fItkwin\fR argument.  The \fIcolorName\fR
argument indicates what colors should be used in the border.
\fIColorName\fR may be any value acceptable to \fBTk_GetColor\fR.
The color indicated by \fIcolorName\fR will not actually be used in
the border;  it indicates the background color for the window
(i.e. a color for flat surfaces).
The illuminated portions of the border will appear brighter than indicated
by \fIcolorName\fR, and the shadowed portions of the border will appear
darker than \fIcolorName\fR.
.PP
\fBTk_Get3DBorder\fR returns a token that may be used in later calls
to \fBTk_Draw3DRectangle\fR.  If an error occurs in allocating information
for the border (e.g. \fIcolorName\fR isn't a legal color specifier),
then NULL is returned and an error message is left in \fIinterp->result\fR.



















.PP
Once a border structure has been created, \fBTk_Draw3DRectangle\fR may be
invoked to draw the border.
The \fItkwin\fR argument specifies the
window for which the border was allocated, and \fIdrawable\fR
specifies a window or pixmap in which the border is to be drawn.
\fIDrawable\fR need not refer to the same window as \fItkwin\fR, but it







|
>
>

|
|
<
|



|
|

|

|

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







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
Specifies which of the border's graphics contexts is desired.
Must be TK_3D_FLAT_GC, TK_3D_LIGHT_GC, or TK_3D_DARK_GC.
.BE

.SH DESCRIPTION
.PP
These procedures provide facilities for drawing window borders in a
way that produces a three-dimensional appearance.
.VS 8.1
\fBTk_Alloc3DBorderFromObj\fR
allocates colors and Pixmaps needed to draw a border in the window
given by the \fItkwin\fR argument.  The value of \fIobjPtr\fR
is a standard Tk color name that determines the border colors.

The color indicated by \fIobjPtr\fR will not actually be used in
the border;  it indicates the background color for the window
(i.e. a color for flat surfaces).
The illuminated portions of the border will appear brighter than indicated
by \fIobjPtr\fR, and the shadowed portions of the border will appear
darker than \fIobjPtr\fR.
.PP
\fBTk_Alloc3DBorderFromObj\fR returns a token that may be used in later calls
to \fBTk_Draw3DRectangle\fR.  If an error occurs in allocating information
for the border (e.g. a bogus color name was given)
then NULL is returned and an error message is left in \fIinterp->result\fR.
If it returns successfully, \fBTk_Alloc3DBorderFromObj\fR caches
information about the return value in \fIobjPtr\fR, which speeds up
future calls to \fBTk_Alloc3DBorderFromObj\fR with the same \fIobjPtr\fR
and \fItkwin\fR.
.PP
\fBTk_Get3DBorder\fR is identical to \fBTk_Alloc3DBorderFromObj\fR except
that the color is specified with a string instead of an object.  This
prevents \fBTk_Get3DBorder\fR from caching the return value, so
\fBTk_Get3DBorder\fR is less efficient than \fBTk_Alloc3DBorderFromObj\fR.
.PP
\fBTk_Get3DBorderFromObj\fR returns the token for an existing border, given
the window and color name used to create the border.
\fBTk_Get3DBorderFromObj\fR doesn't actually create the border; it must
already have been created with a previous call to
\fBTk_Alloc3DBorderFromObj\fR or \fBTk_Get3DBorder\fR.  The return
value is cached in \fIobjPtr\fR, which speeds up
future calls to \fBTk_Get3DBorderFromObj\fR with the same \fIobjPtr\fR
and \fItkwin\fR.
.VE
.PP
Once a border structure has been created, \fBTk_Draw3DRectangle\fR may be
invoked to draw the border.
The \fItkwin\fR argument specifies the
window for which the border was allocated, and \fIdrawable\fR
specifies a window or pixmap in which the border is to be drawn.
\fIDrawable\fR need not refer to the same window as \fItkwin\fR, but it
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
TK_RELIEF_SUNKEN means that the interior should appear depressed.
TK_RELIEF_GROOVE and TK_RELIEF_RIDGE mean that there should appear to be
a groove or ridge around the exterior of the rectangle.
.PP
\fBTk_Fill3DRectangle\fR is somewhat like \fBTk_Draw3DRectangle\fR except
that it first fills the rectangular area with the background color
(one corresponding
to the \fIcolorName\fR used to create \fIborder\fR).  Then it calls
\fBTk_Draw3DRectangle\fR to draw a border just inside the outer edge of
the rectangular area.  The argument \fIrelief\fR indicates the desired
effect (TK_RELIEF_FLAT means no border should be drawn; all that
happens is to fill the rectangle with the background color).
.PP
The procedure \fBTk_Draw3DPolygon\fR may be used to draw more complex
shapes with a three-dimensional appearance.  The \fIpointPtr\fR and







|







204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
TK_RELIEF_SUNKEN means that the interior should appear depressed.
TK_RELIEF_GROOVE and TK_RELIEF_RIDGE mean that there should appear to be
a groove or ridge around the exterior of the rectangle.
.PP
\fBTk_Fill3DRectangle\fR is somewhat like \fBTk_Draw3DRectangle\fR except
that it first fills the rectangular area with the background color
(one corresponding
to the color used to create \fIborder\fR).  Then it calls
\fBTk_Draw3DRectangle\fR to draw a border just inside the outer edge of
the rectangular area.  The argument \fIrelief\fR indicates the desired
effect (TK_RELIEF_FLAT means no border should be drawn; all that
happens is to fill the rectangle with the background color).
.PP
The procedure \fBTk_Draw3DPolygon\fR may be used to draw more complex
shapes with a three-dimensional appearance.  The \fIpointPtr\fR and
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255

256

257




258

259

260
261
262
For example, to draw a rectangular border the top bevel should be
drawn with 1 for both \fIleftIn\fR and \fIrightIn\fR, and the
bottom bevel should be drawn with 0 for both arguments.
.PP
The procedure \fBTk_SetBackgroundFromBorder\fR will modify the background
pixel and/or pixmap of \fItkwin\fR to produce a result compatible
with \fIborder\fR.  For color displays, the resulting background will
just be the color given by the \fIcolorName\fR argument passed to
\fBTk_Get3DBorder\fR when \fIborder\fR was created;  for monochrome
displays, the resulting background
will be a light stipple pattern, in order to distinguish the background from
the illuminated portion of the border.
.PP
Given a token for a border, the procedure \fBTk_NameOf3DBorder\fR
will return the \fIcolorName\fR string that was passed to
\fBTk_Get3DBorder\fR to create the border.
.PP
The procedure \fBTk_3DBorderColor\fR returns the XColor structure
that will be used for flat surfaces drawn for its \fIborder\fR
argument by procedures like \fBTk_Fill3DRectangle\fR.
The return value corresponds to the \fIcolorName\fR passed to
\fBTk_Get3DBorder\fR.
The XColor, and its associated pixel value, will remain allocated
as long as \fIborder\fR exists.
.PP
The procedure \fBTk_3DBorderGC\fR returns one of the X graphics contexts
that are used to draw the border.
The argument \fIwhich\fR selects which one of the three possible GC's:
TK_3D_FLAT_GC returns the context used for flat surfaces,
TK_3D_LIGHT_GC returns the context for light shadows,
and TK_3D_DARK_GC returns the context for dark shadows.
.PP

When a border is no longer needed, \fBTk_Free3DBorder\fR should

be called to release the resources associated with the border.




There should be exactly one call to \fBTk_Free3DBorder\fR for

each call to \fBTk_Get3DBorder\fR.


.SH KEYWORDS
3D, background, border, color, depressed, illumination, polygon, raised, shadow, three-dimensional effect







<
|





|
<




|
|










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


|
261
262
263
264
265
266
267

268
269
270
271
272
273
274

275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
For example, to draw a rectangular border the top bevel should be
drawn with 1 for both \fIleftIn\fR and \fIrightIn\fR, and the
bottom bevel should be drawn with 0 for both arguments.
.PP
The procedure \fBTk_SetBackgroundFromBorder\fR will modify the background
pixel and/or pixmap of \fItkwin\fR to produce a result compatible
with \fIborder\fR.  For color displays, the resulting background will

just be the color specified when \fIborder\fR was created;  for monochrome
displays, the resulting background
will be a light stipple pattern, in order to distinguish the background from
the illuminated portion of the border.
.PP
Given a token for a border, the procedure \fBTk_NameOf3DBorder\fR
will return the color name that was used to create the border.

.PP
The procedure \fBTk_3DBorderColor\fR returns the XColor structure
that will be used for flat surfaces drawn for its \fIborder\fR
argument by procedures like \fBTk_Fill3DRectangle\fR.
The return value corresponds to the color name that was used to
create the border.
The XColor, and its associated pixel value, will remain allocated
as long as \fIborder\fR exists.
.PP
The procedure \fBTk_3DBorderGC\fR returns one of the X graphics contexts
that are used to draw the border.
The argument \fIwhich\fR selects which one of the three possible GC's:
TK_3D_FLAT_GC returns the context used for flat surfaces,
TK_3D_LIGHT_GC returns the context for light shadows,
and TK_3D_DARK_GC returns the context for dark shadows.
.PP
.VS 8.1
When a border is no longer needed, \fBTk_Free3DBorderFromObj\fR
or \fBTk_Free3DBorder\fR should
be called to release the resources associated with it.
For \fBTk_Free3DBorderFromObj\fR the border to release is specified
with the window and color name used to create the
border; for \fBTk_Free3DBorder\fR the border to release is specified
with the Tk_3DBorder token for the border.
There should be exactly one call to \fBTk_Free3DBorderFromObj\fR or
\fBTk_Free3DBorder\fR for each call to \fBTk_Alloc3DBorderFromObj\fR
or \fBTk_Get3DBorder\fR.
.VE

.SH KEYWORDS
3D, background, border, color, depressed, illumination, object, polygon, raised, shadow, three-dimensional effect

Changes to doc/BindTable.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) BindTable.3 1.5 96/03/26 18:03:09
'\" 
.so man.macros
.TH Tk_CreateBindingTable 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateBindingTable, Tk_DeleteBindingTable, Tk_CreateBinding, Tk_DeleteBinding, Tk_GetBinding, Tk_GetAllBindings, Tk_DeleteAllBindings, Tk_BindEvent \- invoke scripts in response to X events
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: BindTable.3,v 1.1.4.1 1998/09/30 02:15:16 stanton Exp $
'\" 
.so man.macros
.TH Tk_CreateBindingTable 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateBindingTable, Tk_DeleteBindingTable, Tk_CreateBinding, Tk_DeleteBinding, Tk_GetBinding, Tk_GetAllBindings, Tk_DeleteAllBindings, Tk_BindEvent \- invoke scripts in response to X events
.SH SYNOPSIS

Changes to doc/CanvPsY.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) CanvPsY.3 1.6 96/03/26 18:03:26
'\" 
.so man.macros
.TH Tk_CanvasPsY 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CanvasPsY, Tk_CanvasPsBitmap, Tk_CanvasPsColor, Tk_CanvasPsFont, Tk_CanvasPsPath, Tk_CanvasPsStipple \- utility procedures for generating Postscript for canvases
.SH SYNOPSIS






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: CanvPsY.3,v 1.1.4.1 1998/09/30 02:15:17 stanton Exp $
'\" 
.so man.macros
.TH Tk_CanvasPsY 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CanvasPsY, Tk_CanvasPsBitmap, Tk_CanvasPsColor, Tk_CanvasPsFont, Tk_CanvasPsPath, Tk_CanvasPsStipple \- utility procedures for generating Postscript for canvases
.SH SYNOPSIS

Changes to doc/CanvTkwin.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) CanvTkwin.3 1.8 96/08/27 13:21:54
'\" 
.so man.macros
.TH Tk_CanvasTkwin 3 4.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CanvasTkwin, Tk_CanvasGetCoord, Tk_CanvasDrawableCoords, Tk_CanvasSetStippleOrigin, Tk_CanvasWindowCoords, Tk_CanvasEventuallyRedraw, Tk_CanvasTagsOption \- utility procedures for canvas type managers
.SH SYNOPSIS






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: CanvTkwin.3,v 1.1.4.1 1998/09/30 02:15:18 stanton Exp $
'\" 
.so man.macros
.TH Tk_CanvasTkwin 3 4.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CanvasTkwin, Tk_CanvasGetCoord, Tk_CanvasDrawableCoords, Tk_CanvasSetStippleOrigin, Tk_CanvasWindowCoords, Tk_CanvasEventuallyRedraw, Tk_CanvasTagsOption \- utility procedures for canvas type managers
.SH SYNOPSIS

Changes to doc/CanvTxtInfo.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) CanvTxtInfo.3 1.8 96/03/26 18:03:51
'\" 
.so man.macros
.TH Tk_CanvasTextInfo 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CanvasTextInfo \- additional information for managing text items in canvases
.SH SYNOPSIS






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: CanvTxtInfo.3,v 1.1.4.1 1998/09/30 02:15:18 stanton Exp $
'\" 
.so man.macros
.TH Tk_CanvasTextInfo 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CanvasTextInfo \- additional information for managing text items in canvases
.SH SYNOPSIS

Changes to doc/Clipboard.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) Clipboard.3 1.5 96/03/26 18:04:10
'\" 
.so man.macros
.TH Tk_ClipboardClear 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ClipboardClear, Tk_ClipboardAppend \- Manage the clipboard
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: Clipboard.3,v 1.1.4.1 1998/09/30 02:15:18 stanton Exp $
'\" 
.so man.macros
.TH Tk_ClipboardClear 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ClipboardClear, Tk_ClipboardAppend \- Manage the clipboard
.SH SYNOPSIS

Changes to doc/ClrSelect.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) ClrSelect.3 1.10 96/08/27 13:21:16
'\" 
.so man.macros
.TH Tk_ClearSelection 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ClearSelection \- Deselect a selection
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: ClrSelect.3,v 1.1.4.1 1998/09/30 02:15:19 stanton Exp $
'\" 
.so man.macros
.TH Tk_ClearSelection 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ClearSelection \- Deselect a selection
.SH SYNOPSIS

Changes to doc/ConfigWidg.3.

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
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) ConfigWidg.3 1.30 96/08/27 13:21:18
'\" 
.so man.macros
.TH Tk_ConfigureWidget 3 4.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ConfigureWidget, Tk_Offset, Tk_ConfigureInfo, Tk_ConfigureValue, Tk_FreeOptions \- process configuration options for widgets
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
int
\fBTk_ConfigureWidget(\fIinterp, tkwin, specs, argc, argv, widgRec, flags\fB)\fR
.sp
int
\fBTk_Offset(\fItype, field\fB)\fR
.sp
int
\fBTk_ConfigureInfo(\fIinterp, tkwin, specs, widgRec, argvName, flags\fB)\fR
.sp
int

.sp
\fBTk_FreeOptions(\fIspecs, widgRec, display, flags\fB)\fR
.SH ARGUMENTS
.AS Tk_ConfigSpec *widgRec
.AP Tcl_Interp *interp in
Interpreter to use for returning error messages.
.AP Tk_Window tkwin in
Window used to represent widget (needed to set up X resources).
.AP Tk_ConfigSpec *specs in
Pointer to table specifying legal configuration options for this
widget.







|




















>



|







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
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: ConfigWidg.3,v 1.1.4.2 1998/09/30 02:15:19 stanton Exp $
'\" 
.so man.macros
.TH Tk_ConfigureWidget 3 4.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ConfigureWidget, Tk_Offset, Tk_ConfigureInfo, Tk_ConfigureValue, Tk_FreeOptions \- process configuration options for widgets
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
int
\fBTk_ConfigureWidget(\fIinterp, tkwin, specs, argc, argv, widgRec, flags\fB)\fR
.sp
int
\fBTk_Offset(\fItype, field\fB)\fR
.sp
int
\fBTk_ConfigureInfo(\fIinterp, tkwin, specs, widgRec, argvName, flags\fB)\fR
.sp
int
\fBTk_ConfigureValue(\fIinterp, tkwin, specs, widgRec, argvName, flags\fB)\fR
.sp
\fBTk_FreeOptions(\fIspecs, widgRec, display, flags\fB)\fR
.SH ARGUMENTS
.AS Tk_ConfigSpec *widgRec in/out
.AP Tcl_Interp *interp in
Interpreter to use for returning error messages.
.AP Tk_Window tkwin in
Window used to represent widget (needed to set up X resources).
.AP Tk_ConfigSpec *specs in
Pointer to table specifying legal configuration options for this
widget.

Changes to doc/ConfigWind.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) ConfigWind.3 1.27 96/08/27 13:21:19
'\" 
.so man.macros
.TH Tk_ConfigureWindow 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ConfigureWindow, Tk_MoveWindow, Tk_ResizeWindow, Tk_MoveResizeWindow, Tk_SetWindowBorderWidth, Tk_ChangeWindowAttributes, Tk_SetWindowBackground, Tk_SetWindowBackgroundPixmap, Tk_SetWindowBorder, Tk_SetWindowBorderPixmap, Tk_SetWindowColormap, Tk_DefineCursor, Tk_UndefineCursor \- change window configuration or attributes
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: ConfigWind.3,v 1.1.4.1 1998/09/30 02:15:20 stanton Exp $
'\" 
.so man.macros
.TH Tk_ConfigureWindow 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ConfigureWindow, Tk_MoveWindow, Tk_ResizeWindow, Tk_MoveResizeWindow, Tk_SetWindowBorderWidth, Tk_ChangeWindowAttributes, Tk_SetWindowBackground, Tk_SetWindowBackgroundPixmap, Tk_SetWindowBorder, Tk_SetWindowBorderPixmap, Tk_SetWindowColormap, Tk_DefineCursor, Tk_UndefineCursor \- change window configuration or attributes
.SH SYNOPSIS

Changes to doc/CoordToWin.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) CoordToWin.3 1.9 96/03/26 18:05:14
'\" 
.so man.macros
.TH Tk_CoordsToWindow 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CoordsToWindow \- Find window containing a point
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: CoordToWin.3,v 1.1.4.1 1998/09/30 02:15:47 stanton Exp $
'\" 
.so man.macros
.TH Tk_CoordsToWindow 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CoordsToWindow \- Find window containing a point
.SH SYNOPSIS

Changes to doc/CrtErrHdlr.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) CrtErrHdlr.3 1.12 96/03/26 18:05:30
'\" 
.so man.macros
.TH Tk_CreateErrorHandler 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateErrorHandler, Tk_DeleteErrorHandler \- handle X protocol errors
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: CrtErrHdlr.3,v 1.1.4.1 1998/09/30 02:15:47 stanton Exp $
'\" 
.so man.macros
.TH Tk_CreateErrorHandler 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateErrorHandler, Tk_DeleteErrorHandler \- handle X protocol errors
.SH SYNOPSIS

Changes to doc/CrtGenHdlr.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) CrtGenHdlr.3 1.9 96/03/26 18:06:21
'\" 
.so man.macros
.TH Tk_CreateGenericHandler 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateGenericHandler, Tk_DeleteGenericHandler \- associate procedure callback with all X events
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: CrtGenHdlr.3,v 1.1.4.1 1998/09/30 02:15:47 stanton Exp $
'\" 
.so man.macros
.TH Tk_CreateGenericHandler 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateGenericHandler, Tk_DeleteGenericHandler \- associate procedure callback with all X events
.SH SYNOPSIS

Changes to doc/CrtImgType.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) CrtImgType.3 1.9 97/08/08 15:43:15
'\" 
.so man.macros
.TH Tk_CreateImageType 3 8.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateImageType, Tk_GetImageMasterData \- define new kind of image
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: CrtImgType.3,v 1.1.4.1 1998/09/30 02:15:48 stanton Exp $
'\" 
.so man.macros
.TH Tk_CreateImageType 3 8.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateImageType, Tk_GetImageMasterData \- define new kind of image
.SH SYNOPSIS

Changes to doc/CrtItemType.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1994-1995 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) CrtItemType.3 1.7 96/02/16 10:30:28
'\" 
.so man.macros
.TH Tk_CreateItemType 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateItemType, Tk_GetItemTypes \- define new kind of canvas item
.SH SYNOPSIS






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1994-1995 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: CrtItemType.3,v 1.1.4.1 1998/09/30 02:15:48 stanton Exp $
'\" 
.so man.macros
.TH Tk_CreateItemType 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateItemType, Tk_GetItemTypes \- define new kind of canvas item
.SH SYNOPSIS

Changes to doc/CrtPhImgFmt.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
'\"
'\" Copyright (c) 1994 The Australian National University
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" Author: Paul Mackerras ([email protected]),
'\"	    Department of Computer Science,
'\"	    Australian National University.
'\"
'\" SCCS: @(#) CrtPhImgFmt.3 1.10 97/10/31 12:58:54
'\"
.so man.macros
.TH Tk_CreatePhotoImageFormat 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreatePhotoImageFormat \- define new file format for photo images
.SH SYNOPSIS











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
'\"
'\" Copyright (c) 1994 The Australian National University
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" Author: Paul Mackerras ([email protected]),
'\"	    Department of Computer Science,
'\"	    Australian National University.
'\"
'\" RCS: @(#) $Id: CrtPhImgFmt.3,v 1.1.4.1 1998/09/30 02:15:49 stanton Exp $
'\"
.so man.macros
.TH Tk_CreatePhotoImageFormat 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreatePhotoImageFormat \- define new file format for photo images
.SH SYNOPSIS

Changes to doc/CrtSelHdlr.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) CrtSelHdlr.3 1.18 96/08/27 13:21:21
'\" 
.so man.macros
.TH Tk_CreateSelHandler 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateSelHandler, Tk_DeleteSelHandler \- arrange to handle requests for a selection
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: CrtSelHdlr.3,v 1.1.4.1 1998/09/30 02:15:49 stanton Exp $
'\" 
.so man.macros
.TH Tk_CreateSelHandler 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateSelHandler, Tk_DeleteSelHandler \- arrange to handle requests for a selection
.SH SYNOPSIS

Changes to doc/CrtWindow.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" @(#) CrtWindow.c 1.21 96/11/01 09:42:20
'\" 
.so man.macros
.TH Tk_CreateWindow 3 4.2 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateWindow, Tk_CreateWindowFromPath, Tk_DestroyWindow, Tk_MakeWindowExist \- create or delete window
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: CrtWindow.3,v 1.1.4.2 1998/09/30 02:15:49 stanton Exp $
'\" 
.so man.macros
.TH Tk_CreateWindow 3 4.2 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateWindow, Tk_CreateWindowFromPath, Tk_DestroyWindow, Tk_MakeWindowExist \- create or delete window
.SH SYNOPSIS

Changes to doc/DeleteImg.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) DeleteImg.3 1.4 96/03/26 18:07:21
'\" 
.so man.macros
.TH Tk_DeleteImage 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_DeleteImage \- Destroy an image.
.SH SYNOPSIS






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: DeleteImg.3,v 1.1.4.1 1998/09/30 02:15:50 stanton Exp $
'\" 
.so man.macros
.TH Tk_DeleteImage 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_DeleteImage \- Destroy an image.
.SH SYNOPSIS

Changes to doc/DrawFocHlt.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) DrawFocHlt.3 1.4 96/03/26 18:07:35
'\" 
.so man.macros
.TH Tk_DrawFocusHighlight 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_DrawFocusHighlight \- draw the traversal highlight ring for a widget
.SH SYNOPSIS






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: DrawFocHlt.3,v 1.1.4.1 1998/09/30 02:15:50 stanton Exp $
'\" 
.so man.macros
.TH Tk_DrawFocusHighlight 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_DrawFocusHighlight \- draw the traversal highlight ring for a widget
.SH SYNOPSIS

Changes to doc/EventHndlr.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) EventHndlr.3 1.15 96/03/14 10:55:08
'\" 
.so man.macros
.TH Tk_CreateEventHandler 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateEventHandler, Tk_DeleteEventHandler \- associate procedure callback with an X event
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: EventHndlr.3,v 1.1.4.1 1998/09/30 02:15:51 stanton Exp $
'\" 
.so man.macros
.TH Tk_CreateEventHandler 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateEventHandler, Tk_DeleteEventHandler \- associate procedure callback with an X event
.SH SYNOPSIS

Changes to doc/FindPhoto.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
'\"
'\" Copyright (c) 1994 The Australian National University
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" Author: Paul Mackerras ([email protected]),
'\"	    Department of Computer Science,
'\"	    Australian National University.
'\"
'\" "@(#) FindPhoto.3 1.11 97/08/22 18:52:33"
'\"
.so man.macros
.TH Tk_FindPhoto 3 8.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_FindPhoto, Tk_PhotoPutBlock, Tk_PhotoPutZoomedBlock, Tk_PhotoGetImage, Tk_PhotoBlank, Tk_PhotoExpand, Tk_PhotoGetSize, Tk_PhotoSetSize \- manipulate the image data stored in a photo image.
.SH SYNOPSIS











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
'\"
'\" Copyright (c) 1994 The Australian National University
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" Author: Paul Mackerras ([email protected]),
'\"	    Department of Computer Science,
'\"	    Australian National University.
'\"
'\" RCS: @(#) $Id: FindPhoto.3,v 1.1.4.1 1998/09/30 02:15:51 stanton Exp $
'\"
.so man.macros
.TH Tk_FindPhoto 3 8.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_FindPhoto, Tk_PhotoPutBlock, Tk_PhotoPutZoomedBlock, Tk_PhotoGetImage, Tk_PhotoBlank, Tk_PhotoExpand, Tk_PhotoGetSize, Tk_PhotoSetSize \- manipulate the image data stored in a photo image.
.SH SYNOPSIS

Changes to doc/FontId.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) FontId.3 1.4 97/11/04 18:03:07
'\" 
.so man.macros
.TH Tk_FontId 3 8.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_FontId, Tk_FontMetrics, Tk_PostscriptFontName \- accessor functions for 
fonts






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: FontId.3,v 1.1.4.1 1998/09/30 02:15:51 stanton Exp $
'\" 
.so man.macros
.TH Tk_FontId 3 8.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_FontId, Tk_FontMetrics, Tk_PostscriptFontName \- accessor functions for 
fonts

Changes to doc/FreeXId.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) FreeXId.3 1.5 96/03/26 18:07:59
'\" 
.so man.macros
.TH Tk_FreeXId 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_FreeXId \- make X resource identifier available for reuse
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: FreeXId.3,v 1.1.4.1 1998/09/30 02:15:52 stanton Exp $
'\" 
.so man.macros
.TH Tk_FreeXId 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_FreeXId \- make X resource identifier available for reuse
.SH SYNOPSIS

Changes to doc/GeomReq.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" 
'\" SCCS: @(#) GeomReq.3 1.11 96/03/26 18:08:21
'\" 
.so man.macros
.TH Tk_GeometryRequest 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GeometryRequest, Tk_SetInternalBorder \- specify desired geometry or internal border for a window
.SH SYNOPSIS








|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" 
'\" RCS: @(#) $Id: GeomReq.3,v 1.1.4.1 1998/09/30 02:15:52 stanton Exp $
'\" 
.so man.macros
.TH Tk_GeometryRequest 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GeometryRequest, Tk_SetInternalBorder \- specify desired geometry or internal border for a window
.SH SYNOPSIS

Changes to doc/GetAnchor.3.

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
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetAnchor.3 1.9 96/03/26 18:08:45
'\" 
.so man.macros
.TH Tk_GetAnchor 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetAnchor, Tk_NameOfAnchor \- translate between strings and anchor positions
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR





.sp
int
\fBTk_GetAnchor(\fIinterp, string, anchorPtr\fB)\fR
.sp
char *
\fBTk_NameOfAnchor(\fIanchor\fB)\fR
.SH ARGUMENTS
.AS "Tk_Anchor" *anchorPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.





.AP char *string in
String containing name of anchor point: one of ``n'', ``ne'', ``e'', ``se'',
``s'', ``sw'', ``w'', ``nw'', or ``center''.


.AP int *anchorPtr out
Pointer to location in which to store anchor position corresponding to
\fIstring\fR.
.AP Tk_Anchor anchor in
Anchor position, e.g. \fBTCL_ANCHOR_CENTER\fR.
.BE

.SH DESCRIPTION
.PP

\fBTk_GetAnchor\fR places in \fI*anchorPtr\fR an anchor position
(enumerated type \fBTk_Anchor\fR)
corresponding to \fIstring\fR,  which will be one of
\fBTK_ANCHOR_N\fR, \fBTK_ANCHOR_NE\fR, \fBTK_ANCHOR_E\fR, \fBTK_ANCHOR_SE\fR,
\fBTK_ANCHOR_S\fR, \fBTK_ANCHOR_SW\fR, \fBTK_ANCHOR_W\fR, \fBTK_ANCHOR_NW\fR,
or \fBTK_ANCHOR_CENTER\fR.
Anchor positions are typically used for indicating a point on an object
that will be used to position that object, e.g. \fBTK_ANCHOR_N\fR means
position the top center point of the object at a particular place.
.PP
Under normal circumstances the return value is \fBTCL_OK\fR and
\fIinterp\fR is unused.
If \fIstring\fR doesn't contain a valid anchor position
or an abbreviation of one of these names, then an error message is
stored in \fIinterp->result\fR, \fBTCL_ERROR\fR is returned, and
\fI*anchorPtr\fR is unmodified.











.PP
\fBTk_NameOfAnchor\fR is the logical inverse of \fBTk_GetAnchor\fR.
Given an anchor position such as \fBTK_ANCHOR_N\fR it returns a
statically-allocated string corresponding to \fIanchor\fR.
If \fIanchor\fR isn't a legal anchor value, then
``unknown anchor position'' is returned.



|




|


|


|



>
>
>
>
>









|
>
>
>
>
>

|
<
>
>


|






>
|

|




|





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







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
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetAnchor.3,v 1.1.4.2 1998/09/30 02:15:52 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetAnchorFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetAnchorFromObj, Tk_GetAnchor, Tk_NameOfAnchor \- translate between strings and anchor positions
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
.VS 8.1
int
\fBTk_GetAnchorFromObj(\fIinterp, objPtr, anchorPtr\fB)\fR
.VE
.sp
int
\fBTk_GetAnchor(\fIinterp, string, anchorPtr\fB)\fR
.sp
char *
\fBTk_NameOfAnchor(\fIanchor\fB)\fR
.SH ARGUMENTS
.AS "Tk_Anchor" *anchorPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting, or NULL.
.VS 8.1 br
.AP Tcl_Obj *objPtr in/out
String value contains name of anchor point: \fBn\fR, \fBne\fR,
\fBe\fR, \fBse\fR, \fBs\fR, \fBsw\fR, \fBw\fR, \fBnw\fR, or \fBcenter\fR;
internal rep will be modified to cache corresponding Tk_Anchor.
.AP char *string in
Same as \fIobjPtr\fR except description of anchor point is passed as

a string.
.VE
.AP int *anchorPtr out
Pointer to location in which to store anchor position corresponding to
\fIobjPtr\fR or \fIstring\fR.
.AP Tk_Anchor anchor in
Anchor position, e.g. \fBTCL_ANCHOR_CENTER\fR.
.BE

.SH DESCRIPTION
.PP
.VS 8.1
\fBTk_GetAnchorFromObj\fR places in \fI*anchorPtr\fR an anchor position
(enumerated type \fBTk_Anchor\fR)
corresponding to \fIobjPtr\fR's value.  The result will be one of
\fBTK_ANCHOR_N\fR, \fBTK_ANCHOR_NE\fR, \fBTK_ANCHOR_E\fR, \fBTK_ANCHOR_SE\fR,
\fBTK_ANCHOR_S\fR, \fBTK_ANCHOR_SW\fR, \fBTK_ANCHOR_W\fR, \fBTK_ANCHOR_NW\fR,
or \fBTK_ANCHOR_CENTER\fR.
Anchor positions are typically used for indicating a point on an object
that will be used to position the object, e.g. \fBTK_ANCHOR_N\fR means
position the top center point of the object at a particular place.
.PP
Under normal circumstances the return value is \fBTCL_OK\fR and
\fIinterp\fR is unused.
If \fIstring\fR doesn't contain a valid anchor position
or an abbreviation of one of these names, \fBTCL_ERROR\fR is returned,

\fI*anchorPtr\fR is unmodified, and an error message is
stored in \fIinterp\fR's result if \fIinterp\fR isn't NULL.
\fBTk_GetAnchorFromObj\fR caches information about the return
value in \fIobjPtr\fR, which speeds up future calls to
\fBTk_GetAnchorFromObj\fR with the same \fIobjPtr\fR.
.PP
\fBTk_GetAnchor\fR is identical to \fBTk_GetAnchorFromObj\fR except
that the description of the anchor is specified with a string instead
of an object.  This prevents \fBTk_GetAnchor\fR from caching the
return value, so \fBTk_GetAnchor\fR is less efficient than
\fBTk_GetAnchorFromObj\fR.
.VE
.PP
\fBTk_NameOfAnchor\fR is the logical inverse of \fBTk_GetAnchor\fR.
Given an anchor position such as \fBTK_ANCHOR_N\fR it returns a
statically-allocated string corresponding to \fIanchor\fR.
If \fIanchor\fR isn't a legal anchor value, then
``unknown anchor position'' is returned.

Changes to doc/GetBitmap.3.

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
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetBitmap.3 1.27 97/08/22 18:52:11
'\" 
.so man.macros
.TH Tk_GetBitmap 3 8.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetBitmap, Tk_DefineBitmap, Tk_NameOfBitmap, Tk_SizeOfBitmap, Tk_FreeBitmap, Tk_GetBitmapFromData \- maintain database of single-plane pixmaps
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp

Pixmap



\fBTk_GetBitmap(\fIinterp, tkwin, id\fB)\fR
.sp




int
\fBTk_DefineBitmap(\fIinterp, nameId, source, width, height\fB)\fR
.sp
Tk_Uid

\fBTk_NameOfBitmap(\fIdisplay, bitmap\fB)\fR
.sp
\fBTk_SizeOfBitmap(\fIdisplay, bitmap, widthPtr, heightPtr\fB)\fR




.sp
\fBTk_FreeBitmap(\fIdisplay, bitmap\fB)\fR
.SH ARGUMENTS
.AS "unsigned long" *pixelPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.

.AP Tk_Window tkwin in
Token for window in which the bitmap will be used.

.AP Tk_Uid id in



Description of bitmap;  see below for possible values.


.AP Tk_Uid nameId in
Name for new bitmap to be defined.
.AP char *source in
Data for bitmap, in standard bitmap format.
Must be stored in static memory whose value will never change.
.AP "int" width in
Width of bitmap.
.AP "int" height in
Height of bitmap.
.AP "int" *widthPtr out
Pointer to word to fill in with \fIbitmap\fR's width.
.AP "int" *heightPtr out
Pointer to word to fill in with \fIbitmap\fR's height.
.AP Display *display in
Display for which \fIbitmap\fR was allocated.
.AP Pixmap bitmap in
Identifier for a bitmap allocated by \fBTk_GetBitmap\fR.

.BE

.SH DESCRIPTION
.PP
These procedures manage a collection of bitmaps (one-plane pixmaps)
being used by an application.  The procedures allow bitmaps to be
re-used efficiently, thereby avoiding server overhead, and also
allow bitmaps to be named with character strings.
.PP
\fBTk_GetBitmap\fR takes as argument a Tk_Uid describing a bitmap.
It returns a Pixmap identifier for a bitmap corresponding to the

description.  It re-uses an existing bitmap, if possible, and
creates a new one otherwise.  At present, \fIid\fR must have
one of the following forms:

.TP 20
\fB@\fIfileName\fR
\fIFileName\fR must be the name of a file containing a bitmap
description in the standard X11 or X10 format.
.TP 20
\fIname\fR
\fIName\fR must be the name of a bitmap defined previously with


|




|


|


|




>

>
>
>
|

>
>
>
>

|

<
>



>
>
>
>





|
>


>
|
>
>
>
|
>
>
|















|
>









|
|
>
|
|
|
>







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
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetBitmap.3,v 1.1.4.4 1999/04/07 00:36:10 stanton Exp $
'\" 
.so man.macros
.TH Tk_AllocBitmapFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_AllocBitmapFromObj, Tk_GetBitmap, Tk_GetBitmapFromObj, Tk_DefineBitmap, Tk_NameOfBitmap, Tk_SizeOfBitmap, Tk_FreeBitmapFromObj, Tk_FreeBitmap, Tk_GetBitmapFromData \- maintain database of single-plane pixmaps
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
.VS 8.1
Pixmap
\fBTk_GetBitmapFromObj(\fIinterp, tkwin, objPtr\fB)\fR
.sp
Pixmap
\fBTk_GetBitmap(\fIinterp, tkwin, info\fB)\fR
.sp
Pixmap
\fBTk_GetBitmapFromObj(\fItkwin, objPtr\fB)\fR
.VE
.sp
int
\fBTk_DefineBitmap(\fIinterp, name, source, width, height\fB)\fR
.sp

char *
\fBTk_NameOfBitmap(\fIdisplay, bitmap\fB)\fR
.sp
\fBTk_SizeOfBitmap(\fIdisplay, bitmap, widthPtr, heightPtr\fB)\fR
.sp
.VS 8.1
\fBTk_FreeBitmapFromObj(\fItkwin, objPtr\fB)\fR
.VE
.sp
\fBTk_FreeBitmap(\fIdisplay, bitmap\fB)\fR
.SH ARGUMENTS
.AS "unsigned long" *pixelPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting; if NULL then no error message
is left after errors.
.AP Tk_Window tkwin in
Token for window in which the bitmap will be used.
.VS 8.1 br
.AP Tcl_Obj *objPtr in/out
String value describes desired bitmap; internal rep will be
modified to cache pointer to corresponding Pixmap.
.AP "CONST char" *info in
Same as \fIobjPtr\fR except description of bitmap is passed as a string and
resulting Pixmap isn't cached.
.VE
.AP "CONST char" *name in
Name for new bitmap to be defined.
.AP char *source in
Data for bitmap, in standard bitmap format.
Must be stored in static memory whose value will never change.
.AP "int" width in
Width of bitmap.
.AP "int" height in
Height of bitmap.
.AP "int" *widthPtr out
Pointer to word to fill in with \fIbitmap\fR's width.
.AP "int" *heightPtr out
Pointer to word to fill in with \fIbitmap\fR's height.
.AP Display *display in
Display for which \fIbitmap\fR was allocated.
.AP Pixmap bitmap in
Identifier for a bitmap allocated by \fBTk_AllocBitmapFromObj\fR or
\fBTk_GetBitmap\fR.
.BE

.SH DESCRIPTION
.PP
These procedures manage a collection of bitmaps (one-plane pixmaps)
being used by an application.  The procedures allow bitmaps to be
re-used efficiently, thereby avoiding server overhead, and also
allow bitmaps to be named with character strings.
.PP
.VS 8.1
\fBTk_AllocBitmapFromObj\fR returns a Pixmap identifier for a bitmap
that matches the description in \fIobjPtr\fR and is suitable for use
in \fItkwin\fR.  It re-uses an existing bitmap, if possible, and
creates a new one otherwise.  \fIObjPtr\fR's value must have one
of the following forms:
.VE
.TP 20
\fB@\fIfileName\fR
\fIFileName\fR must be the name of a file containing a bitmap
description in the standard X11 or X10 format.
.TP 20
\fIname\fR
\fIName\fR must be the name of a bitmap defined previously with
162
163
164
165
166
167
168

169
170
171
172
173



















174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189

190
191
192
193
194
195
196
197
198

199
200
201
202
203
204
205
206

207
208
209
210

211
212
213
214

215
216
217
218
219
220
221
222
223

224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244

245

246
247




248

249
250
251
252

253
254
255
256
257
258
259
260
261
262
263
264
265
266
\fBnote\fR
A face with ballon words.
.TP 12
\fBcaution\fR
A triangle with an exclamation point.
.RE
.LP

Under normal conditions, \fBTk_GetBitmap\fR
returns an identifier for the requested bitmap.  If an error
occurs in creating the bitmap, such as when \fIid\fR refers
to a non-existent file, then \fBNone\fR is returned and an error
message is left in \fIinterp->result\fR.



















.PP
\fBTk_DefineBitmap\fR associates a name with
in-memory bitmap data so that the name can be used in later
calls to \fBTk_GetBitmap\fR.  The \fInameId\fR
argument gives a name for the bitmap;  it must not previously
have been used in a call to \fBTk_DefineBitmap\fR.
The arguments \fIsource\fR, \fIwidth\fR, and \fIheight\fR
describe the bitmap.
\fBTk_DefineBitmap\fR normally returns TCL_OK;  if an error occurs
(e.g. a bitmap named \fInameId\fR has already been defined) then
TCL_ERROR is returned and an error message is left in
\fIinterp->result\fR.
Note:  \fBTk_DefineBitmap\fR expects the memory pointed to by
\fIsource\fR to be static:  \fBTk_DefineBitmap\fR doesn't make
a private copy of this memory, but uses the bytes pointed to
by \fIsource\fR later in calls to \fBTk_GetBitmap\fR.

.PP
Typically \fBTk_DefineBitmap\fR is used by \fB#include\fR-ing a
bitmap file directly into a C program and then referencing
the variables defined by the file.
For example, suppose there exists a file \fBstip.bitmap\fR,
which was created by the \fBbitmap\fR program and contains
a stipple pattern.
The following code uses \fBTk_DefineBitmap\fR to define a
new bitmap named \fBfoo\fR:

.CS
Pixmap bitmap;
#include "stip.bitmap"
Tk_DefineBitmap(interp, Tk_GetUid("foo"), stip_bits,
	stip_width, stip_height);
\&...
bitmap = Tk_GetBitmap(interp, tkwin, Tk_GetUid("foo"));
.CE

This code causes the bitmap file to be read
at compile-time and incorporates the bitmap information into
the program's executable image.  The same bitmap file could be
read at run-time using \fBTk_GetBitmap\fR:

.CS
Pixmap bitmap;
bitmap = Tk_GetBitmap(interp, tkwin, Tk_GetUid("@stip.bitmap"));
.CE

The second form is a bit more flexible (the file could be modified
after the program has been compiled, or a different string could be
provided to read a different file), but it is a little slower and
requires the bitmap file to exist separately from the program.
.PP
\fBTk_GetBitmap\fR maintains a
database of all the bitmaps that are currently in use.
Whenever possible, it will return an existing bitmap rather
than creating a new one.

This approach can substantially reduce server overhead, so
\fBTk_GetBitmap\fR should generally be used in preference to Xlib
procedures like \fBXReadBitmapFile\fR.
.PP
The bitmaps returned by \fBTk_GetBitmap\fR
are shared, so callers should never modify them.
If a bitmap must be modified dynamically, then it should be
created by calling Xlib procedures such as \fBXReadBitmapFile\fR
or \fBXCreatePixmap\fR directly.
.PP
The procedure \fBTk_NameOfBitmap\fR is roughly the inverse of
\fBTk_GetBitmap\fR.
Given an X Pixmap argument, it returns the \fIid\fR that was
passed to \fBTk_GetBitmap\fR when the bitmap was created.
\fIBitmap\fR must have been the return value from a previous
call to \fBTk_GetBitmap\fR.
.PP
\fBTk_SizeOfBitmap\fR returns the dimensions of its \fIbitmap\fR
argument in the words pointed to by the \fIwidthPtr\fR and
\fIheightPtr\fR arguments.  As with \fBTk_NameOfBitmap\fR,
\fIbitmap\fR must have been created by \fBTk_GetBitmap\fR.

.PP

When a bitmap returned by \fBTk_GetBitmap\fR
is no longer needed, \fBTk_FreeBitmap\fR should be called to release it.




There should be exactly one call to \fBTk_FreeBitmap\fR for

each call to \fBTk_GetBitmap\fR.
When a bitmap is no longer in use anywhere (i.e. it has been freed as
many times as it has been gotten) \fBTk_FreeBitmap\fR will release
it to the X server and delete it from the database.


.SH BUGS
In determining whether an existing bitmap can be used to satisfy
a new request, \fBTk_GetBitmap\fR
considers only the immediate value of its \fIid\fR argument.  For
example, when a file name is passed to \fBTk_GetBitmap\fR,
\fBTk_GetBitmap\fR will assume it is safe to re-use an existing
bitmap created from the same file name:  it will not check to
see whether the file itself has changed, or whether the current
directory has changed, thereby causing the name to refer to
a different file.

.SH KEYWORDS
bitmap, pixmap







>
|

|

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



|











|
>









>



|


|

>




>


|

>





<
|


>

|
|

|







|


|




|
>

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



|
|









184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266

267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303



304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
\fBnote\fR
A face with ballon words.
.TP 12
\fBcaution\fR
A triangle with an exclamation point.
.RE
.LP
.VS 8.1
Under normal conditions, \fBTk_AllocBitmapFromObj\fR
returns an identifier for the requested bitmap.  If an error
occurs in creating the bitmap, such as when \fIobjPtr\fR refers
to a non-existent file, then \fBNone\fR is returned and an error
message is left in \fIinterp\fR's result if \fIinterp\fR isn't
NULL. \fBTk_AllocBitmapFromObj\fR caches information about the return
value in \fIobjPtr\fR, which speeds up future calls to procedures
such as \fBTk_AllocBitmapFromObj\fR and \fBTk_GetBitmapFromObj\fR.
.PP
\fBTk_GetBitmap\fR is identical to \fBTk_AllocBitmapFromObj\fR except
that the description of the bitmap is specified with a string instead
of an object.  This prevents \fBTk_GetBitmap\fR from caching the
return value, so \fBTk_GetBitmap\fR is less efficient than
\fBTk_AllocBitmapFromObj\fR.
.PP
\fBTk_GetBitmapFromObj\fR returns the token for an existing bitmap, given
the window and description used to create the bitmap.
\fBTk_GetBitmapFromObj\fR doesn't actually create the bitmap; the bitmap
must already have been created with a previous call to
\fBTk_AllocBitmapFromObj\fR or \fBTk_GetBitmap\fR.  The return
value is cached in \fIobjPtr\fR, which speeds up
future calls to \fBTk_GetBitmapFromObj\fR with the same \fIobjPtr\fR
and \fItkwin\fR.
.VE
.PP
\fBTk_DefineBitmap\fR associates a name with
in-memory bitmap data so that the name can be used in later
calls to \fBTk_AllocBitmapFromObj\fR or \fBTk_GetBitmap\fR.  The \fInameId\fR
argument gives a name for the bitmap;  it must not previously
have been used in a call to \fBTk_DefineBitmap\fR.
The arguments \fIsource\fR, \fIwidth\fR, and \fIheight\fR
describe the bitmap.
\fBTk_DefineBitmap\fR normally returns TCL_OK;  if an error occurs
(e.g. a bitmap named \fInameId\fR has already been defined) then
TCL_ERROR is returned and an error message is left in
\fIinterp->result\fR.
Note:  \fBTk_DefineBitmap\fR expects the memory pointed to by
\fIsource\fR to be static:  \fBTk_DefineBitmap\fR doesn't make
a private copy of this memory, but uses the bytes pointed to
by \fIsource\fR later in calls to \fBTk_AllocBitmapFromObj\fR or
\fBTk_GetBitmap\fR.
.PP
Typically \fBTk_DefineBitmap\fR is used by \fB#include\fR-ing a
bitmap file directly into a C program and then referencing
the variables defined by the file.
For example, suppose there exists a file \fBstip.bitmap\fR,
which was created by the \fBbitmap\fR program and contains
a stipple pattern.
The following code uses \fBTk_DefineBitmap\fR to define a
new bitmap named \fBfoo\fR:
.VS
.CS
Pixmap bitmap;
#include "stip.bitmap"
Tk_DefineBitmap(interp, "foo", stip_bits,
	stip_width, stip_height);
\&...
bitmap = Tk_GetBitmap(interp, tkwin, "foo");
.CE
.VE
This code causes the bitmap file to be read
at compile-time and incorporates the bitmap information into
the program's executable image.  The same bitmap file could be
read at run-time using \fBTk_GetBitmap\fR:
.VS
.CS
Pixmap bitmap;
bitmap = Tk_GetBitmap(interp, tkwin, "@stip.bitmap");
.CE
.VE
The second form is a bit more flexible (the file could be modified
after the program has been compiled, or a different string could be
provided to read a different file), but it is a little slower and
requires the bitmap file to exist separately from the program.
.PP

Tk maintains a database of all the bitmaps that are currently in use.
Whenever possible, it will return an existing bitmap rather
than creating a new one.
When a bitmap is no longer used, Tk will release it automatically.
This approach can substantially reduce server overhead, so
\fBTk_AllocBitmapFromObj\fR and \fBTk_GetBitmap\fR should generally
be used in preference to Xlib procedures like \fBXReadBitmapFile\fR.
.PP
The bitmaps returned by \fBTk_AllocBitmapFromObj\fR and \fBTk_GetBitmap\fR
are shared, so callers should never modify them.
If a bitmap must be modified dynamically, then it should be
created by calling Xlib procedures such as \fBXReadBitmapFile\fR
or \fBXCreatePixmap\fR directly.
.PP
The procedure \fBTk_NameOfBitmap\fR is roughly the inverse of
\fBTk_GetBitmap\fR.
Given an X Pixmap argument, it returns the textual description that was
passed to \fBTk_GetBitmap\fR when the bitmap was created.
\fIBitmap\fR must have been the return value from a previous
call to \fBTk_AllocBitmapFromObj\fR or \fBTk_GetBitmap\fR.
.PP
\fBTk_SizeOfBitmap\fR returns the dimensions of its \fIbitmap\fR
argument in the words pointed to by the \fIwidthPtr\fR and
\fIheightPtr\fR arguments.  As with \fBTk_NameOfBitmap\fR,
\fIbitmap\fR must have been created by \fBTk_AllocBitmapFromObj\fR or
\fBTk_GetBitmap\fR.
.PP
.VS 8.1
When a bitmap is no longer needed, \fBTk_FreeBitmapFromObj\fR or
\fBTk_FreeBitmap\fR should be called to release it.
For \fBTk_FreeBitmapFromObj\fR the bitmap to release is specified
with the same information used to create it; for
\fBTk_FreeBitmap\fR the bitmap to release is specified
with its Pixmap token.
There should be exactly one call to \fBTk_FreeBitmapFromObj\fR
or \fBTk_FreeBitmap\fR for each call to \fBTk_AllocBitmapFromObj\fR or
\fBTk_GetBitmap\fR.



.VE

.SH BUGS
In determining whether an existing bitmap can be used to satisfy
a new request, \fBTk_AllocBitmapFromObj\fR and \fBTk_GetBitmap\fR
consider only the immediate value of the string description.  For
example, when a file name is passed to \fBTk_GetBitmap\fR,
\fBTk_GetBitmap\fR will assume it is safe to re-use an existing
bitmap created from the same file name:  it will not check to
see whether the file itself has changed, or whether the current
directory has changed, thereby causing the name to refer to
a different file.

.SH KEYWORDS
bitmap, pixmap

Changes to doc/GetCapStyl.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetCapStyl.3 1.9 96/03/26 18:09:14
'\" 
.so man.macros
.TH Tk_GetCapStyle 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetCapStyle, Tk_NameOfCapStyle \- translate between strings and cap styles
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetCapStyl.3,v 1.1.4.1 1998/09/30 02:15:53 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetCapStyle 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetCapStyle, Tk_NameOfCapStyle \- translate between strings and cap styles
.SH SYNOPSIS

Changes to doc/GetClrmap.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetClrmap.3 1.5 96/03/26 18:09:27
'\" 
.so man.macros
.TH Tk_GetColormap 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetColormap, Tk_FreeColormap \- allocate and free colormaps
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetClrmap.3,v 1.1.4.1 1998/09/30 02:15:53 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetColormap 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetColormap, Tk_FreeColormap \- allocate and free colormaps
.SH SYNOPSIS

Changes to doc/GetColor.3.

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
'\"
'\" Copyright (c) 1990, 1991 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetColor.3 1.22 96/08/27 13:21:26
'\" 
.so man.macros
.TH Tk_GetColor 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetColor, Tk_GetColorByValue, Tk_NameOfColor, Tk_FreeColor \- maintain database of colors
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR

.sp
XColor *



\fBTk_GetColor\fR(\fIinterp, tkwin, nameId\fB)\fR
.sp
XColor *




\fBTk_GetColorByValue\fR(\fItkwin, prefPtr\fB)\fR
.sp
char *
\fBTk_NameOfColor(\fIcolorPtr\fB)\fR
.sp
GC
\fBTk_GCForColor\fR(\fIcolorPtr, drawable\fR)




.sp
\fBTk_FreeColor(\fIcolorPtr\fB)\fR
.SH ARGUMENTS
.AS "Tcl_Interp" *colorPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
.AP Tk_Window tkwin in
Token for window in which color will be used.




.AP Tk_Uid nameId in
Textual description of desired color.


.AP XColor *prefPtr in
Indicates red, green, and blue intensities of desired
color.
.AP XColor *colorPtr in
Pointer to X color information.  Must have been allocated by previous
call to \fBTk_GetColor\fR or \fBTk_GetColorByValue\fR, except when passed
to \fBTk_NameOfColor\fR.
.AP Drawable drawable in
Drawable in which the result graphics context will be used.  Must have
same screen and depth as the window for which the color was allocated.
.BE

.SH DESCRIPTION

.PP
The \fBTk_GetColor\fR and \fBTk_GetColorByValue\fR procedures





locate pixel values that may be used to render particular
colors in the window given by \fItkwin\fR.  In \fBTk_GetColor\fR
the desired color is specified with a Tk_Uid (\fInameId\fR), which
may have any of the following forms:

.TP 20
\fIcolorname\fR
Any of the valid textual names for a color defined in the
server's color database file, such as \fBred\fR or \fBPeachPuff\fR.
.TP 20
\fB#\fIRGB\fR
.TP 20
\fB#\fIRRGGBB\fR
.TP 20
\fB#\fIRRRGGGBBB\fR
.TP 20
\fB#\fIRRRRGGGGBBBB\fR
A numeric specification of the red, green, and blue intensities
to use to display the color.  Each \fIR\fR, \fIG\fR, or \fIB\fR
represents a single hexadecimal digit.  The four forms permit
colors to be specified with 4-bit, 8-bit, 12-bit or 16-bit values.
When fewer than 16 bits are provided for each color, they represent
the most significant bits of the color.  For example, #3a7 is the
same as #3000a0007000.
.PP
In \fBTk_GetColorByValue\fR, the desired color is indicated with
the \fIred\fR, \fIgreen\fR, and \fIblue\fR fields of the structure
pointed to by \fIcolorPtr\fR.
.PP
If \fBTk_GetColor\fR or \fBTk_GetColorByValue\fR is successful
in allocating the desired color, then it returns a pointer to
an XColor structure;  the structure indicates the exact intensities of
the allocated color (which may differ slightly from those requested,
depending on the limitations of the screen) and a pixel value
that may be used to draw in the color.



If the colormap for \fItkwin\fR is full, \fBTk_GetColor\fR
and \fBTk_GetColorByValue\fR will use the closest existing color





in the colormap.

If \fBTk_GetColor\fR encounters an error while allocating




the color (such as an unknown color name) then NULL is returned and


an error message is stored in \fIinterp->result\fR;




\fBTk_GetColorByValue\fR never returns an error.


.PP
\fBTk_GetColor\fR and \fBTk_GetColorByValue\fR maintain a database
of all the colors currently in use.
If the same \fInameId\fR is requested multiple times from

\fBTk_GetColor\fR (e.g. by different windows), or if the
same intensities are requested multiple times from
\fBTk_GetColorByValue\fR, then existing pixel values will
be re-used.  Re-using an existing pixel avoids any interaction
with the X server, which makes the allocation much more

efficient.  For this reason, you should generally use
\fBTk_GetColor\fR or \fBTk_GetColorByValue\fR
instead of Xlib procedures like \fBXAllocColor\fR,
\fBXAllocNamedColor\fR, or \fBXParseColor\fR.
.PP
Since different calls to \fBTk_GetColor\fR or \fBTk_GetColorByValue\fR
may return the same shared
pixel value, callers should never change the color of a pixel
returned by the procedures.
If you need to change a color value dynamically, you should use
\fBXAllocColorCells\fR to allocate the pixel value for the color.
.PP
The procedure \fBTk_NameOfColor\fR is roughly the inverse of
\fBTk_GetColor\fR.  If its \fIcolorPtr\fR argument was created
by \fBTk_GetColor\fR, then the return value is the \fInameId\fR
string that was passed to \fBTk_GetColor\fR to create the
color.  If \fIcolorPtr\fR was created by a call to \fBTk_GetColorByValue\fR,
or by any other mechanism, then the return value is a string
that could be passed to \fBTk_GetColor\fR to return the same
color.  Note:  the string returned by \fBTk_NameOfColor\fR is
only guaranteed to persist until the next call to \fBTk_NameOfColor\fR.

.PP
\fBTk_GCForColor\fR returns a graphics context whose \fBForeground\fR
field is the pixel allocated for \fIcolorPtr\fR and whose other fields
all have default values.
This provides an easy way to do basic drawing with a color.
The graphics context is cached with the color and will exist only as
long as \fIcolorPtr\fR exists;  it is freed when the last reference
to \fIcolorPtr\fR is freed by calling \fBTk_FreeColor\fR.
.PP
When a pixel value returned by \fBTk_GetColor\fR or
\fBTk_GetColorByValue\fR is no longer
needed, \fBTk_FreeColor\fR should be called to release the color.




There should be exactly one call to \fBTk_FreeColor\fR for

each call to \fBTk_GetColor\fR or \fBTk_GetColorByValue\fR.
When a pixel value is no longer in
use anywhere (i.e. it has been freed as many times as it has been gotten)
\fBTk_FreeColor\fR will release it to the X server and delete it from
the database.

.SH KEYWORDS
color, intensity, pixel value

|
|




|


|


|



>


>
>
>
|


>
>
>
>
|





|
>
>
>
>








>
>
>
>
|
|
>
>





|
|






>

|
>
>
>
>
>
|
<
|
|
>




















<
<
<
|
<
|



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

|

|
>
|



|
>
|
|
|
<

|








|
|




|
>

|







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

|
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
'\"
'\" Copyright (c) 1990-1991 The Regents of the University of California.
'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetColor.3,v 1.1.4.2 1998/09/30 02:15:54 stanton Exp $
'\" 
.so man.macros
.TH Tk_AllocColorFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_AllocColorFromObj, Tk_GetColor, Tk_GetColorFromObj, Tk_GetColorByValue, Tk_NameOfColor, Tk_FreeColorFromObj, Tk_FreeColor \- maintain database of colors
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.VS 8.1
.sp
XColor *
\fBTk_AllocColorFromObj(\fIinterp, tkwin, objPtr\fB)\fR
.sp
XColor *
\fBTk_GetColor(\fIinterp, tkwin, name\fB)\fR
.sp
XColor *
\fBTk_GetColorFromObj(\fItkwin, objPtr\fB)\fR
.VE
.sp
XColor *
\fBTk_GetColorByValue(\fItkwin, prefPtr\fB)\fR
.sp
char *
\fBTk_NameOfColor(\fIcolorPtr\fB)\fR
.sp
GC
\fBTk_GCForColor(\fIcolorPtr, drawable\fB)\fR
.sp
.VS 8.1
\fBTk_FreeColorFromObj(\fItkwin, objPtr\fB)\fR
.VE
.sp
\fBTk_FreeColor(\fIcolorPtr\fB)\fR
.SH ARGUMENTS
.AS "Tcl_Interp" *colorPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
.AP Tk_Window tkwin in
Token for window in which color will be used.
.VS 8.1 br
.AP Tcl_Obj *objPtr in/out
String value describes desired color; internal rep will be
modified to cache pointer to corresponding (XColor *).
.AP char *name in
Same as \fIobjPtr\fR except description of color is passed as a string and
resulting (XColor *) isn't cached.
.VE
.AP XColor *prefPtr in
Indicates red, green, and blue intensities of desired
color.
.AP XColor *colorPtr in
Pointer to X color information.  Must have been allocated by previous
call to \fBTk_AllocColorFromObj\fR, \fBTk_GetColor\fR or
\fBTk_GetColorByValue\fR, except when passed to \fBTk_NameOfColor\fR.
.AP Drawable drawable in
Drawable in which the result graphics context will be used.  Must have
same screen and depth as the window for which the color was allocated.
.BE

.SH DESCRIPTION
.VS 8.1
.PP
These procedures manage the colors being used by a Tk application.
They allow colors to be shared whenever possible, so that colormap
space is preserved, and they pick closest available colors when
colormap space is exhausted.
.PP
Given a textual description of a color, \fBTk_AllocColorFromObj\fR
locates a pixel value that may be used to render the color

in a particular window.  The desired color is specified with an
object whose string value must have one of the following forms:
.VE
.TP 20
\fIcolorname\fR
Any of the valid textual names for a color defined in the
server's color database file, such as \fBred\fR or \fBPeachPuff\fR.
.TP 20
\fB#\fIRGB\fR
.TP 20
\fB#\fIRRGGBB\fR
.TP 20
\fB#\fIRRRGGGBBB\fR
.TP 20
\fB#\fIRRRRGGGGBBBB\fR
A numeric specification of the red, green, and blue intensities
to use to display the color.  Each \fIR\fR, \fIG\fR, or \fIB\fR
represents a single hexadecimal digit.  The four forms permit
colors to be specified with 4-bit, 8-bit, 12-bit or 16-bit values.
When fewer than 16 bits are provided for each color, they represent
the most significant bits of the color.  For example, #3a7 is the
same as #3000a0007000.
.PP



.VS 8.1

\fBTk_AllocColorFromObj\fR returns a pointer to
an XColor structure;  the structure indicates the exact intensities of
the allocated color (which may differ slightly from those requested,
depending on the limitations of the screen) and a pixel value
that may be used to draw with the color in \fItkwin\fR.
If an error occurs in \fBTk_AllocColorFromObj\fR (such as an unknown
color name) then NULL is returned and an error message is stored in
\fIinterp\fR's result if \fIinterp\fR isn't NULL.
If the colormap for \fItkwin\fR is full, \fBTk_AllocColorFromObj\fR
will use the closest existing color in the colormap.
\fBTk_AllocColorFromObj\fR caches information about
the return value in \fIobjPtr\fR, which speeds up future calls to procedures
such as \fBTk_AllocColorFromObj\fR and \fBTk_GetColorFromObj\fR.
.PP
\fBTk_GetColor\fR is identical to \fBTk_AllocColorFromObj\fR except
that the description of the color is specified with a string instead
of an object.  This prevents \fBTk_GetColor\fR from caching the
return value, so \fBTk_GetColor\fR is less efficient than
\fBTk_AllocColorFromObj\fR.
.PP
\fBTk_GetColorFromObj\fR returns the token for an existing color, given
the window and description used to create the color.
\fBTk_GetColorFromObj\fR doesn't actually create the color; the color
must already have been created with a previous call to
\fBTk_AllocColorFromObj\fR or \fBTk_GetColor\fR.  The return
value is cached in \fIobjPtr\fR, which speeds up
future calls to \fBTk_GetColorFromObj\fR with the same \fIobjPtr\fR
and \fItkwin\fR.
.VE
.PP
\fBTk_GetColorByValue\fR is similar to \fBTk_GetColor\fR except that
the desired color is indicated with the \fIred\fR, \fIgreen\fR, and
\fIblue\fR fields of the structure pointed to by \fIcolorPtr\fR.
.PP
This package maintains a database
of all the colors currently in use.
If the same color is requested multiple times from
\fBTk_GetColor\fR or \fBTk_AllocColorFromObj\fR (e.g. by different
windows), or if the 
same intensities are requested multiple times from
\fBTk_GetColorByValue\fR, then existing pixel values will
be re-used.  Re-using an existing pixel avoids any interaction
with the window server, which makes the allocation much more
efficient.  These procedures also provide a portable interface that
works across all platforms.  For this reason, you should generally use
\fBTk_AllocColorFromObj\fR, \fBTk_GetColor\fR, or \fBTk_GetColorByValue\fR
instead of lower level procedures like \fBXAllocColor\fR.

.PP
Since different calls to this package
may return the same shared
pixel value, callers should never change the color of a pixel
returned by the procedures.
If you need to change a color value dynamically, you should use
\fBXAllocColorCells\fR to allocate the pixel value for the color.
.PP
The procedure \fBTk_NameOfColor\fR is roughly the inverse of
\fBTk_GetColor\fR.  If its \fIcolorPtr\fR argument was created
by \fBTk_AllocColorFromObj\fR or \fBTk_GetColor\fR then the return value
is the string that was used to create the
color.  If \fIcolorPtr\fR was created by a call to \fBTk_GetColorByValue\fR,
or by any other mechanism, then the return value is a string
that could be passed to \fBTk_GetColor\fR to return the same
color.  Note:  the string returned by \fBTk_NameOfColor\fR is
only guaranteed to persist until the next call to
\fBTk_NameOfColor\fR.
.PP
\fBTk_GCForColor\fR returns a graphics context whose \fBforeground\fR
field is the pixel allocated for \fIcolorPtr\fR and whose other fields
all have default values.
This provides an easy way to do basic drawing with a color.
The graphics context is cached with the color and will exist only as
long as \fIcolorPtr\fR exists;  it is freed when the last reference
to \fIcolorPtr\fR is freed by calling \fBTk_FreeColor\fR.
.PP
.VS 8.1
When a color is no longer needed \fBTk_FreeColorFromObj\fR or
\fBTk_FreeColor\fR should be called to release it.
For \fBTk_FreeColorFromObj\fR the color to release is specified
with the same information used to create it; for
\fBTk_FreeColor\fR the color to release is specified
with a pointer to its XColor structure.
There should be exactly one call to \fBTk_FreeColorFromObj\fR
or \fBTk_FreeColor\fR for each call to \fBTk_AllocColorFromObj\fR,
\fBTk_GetColor\fR, or \fBTk_GetColorByValue\fR.




.VE
.SH KEYWORDS
color, intensity, object, pixel value

Changes to doc/GetCursor.3.

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
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetCursor.3 1.23 96/08/27 13:21:26
'\" 
.so man.macros
.TH Tk_GetCursor 3 4.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetCursor, Tk_GetCursorFromData, Tk_NameOfCursor, Tk_FreeCursor \- maintain database of cursors
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp

Tk_Cursor



\fBTk_GetCursor(\fIinterp, tkwin, nameId\fB)\fR




.sp
Tk_Cursor
\fBTk_GetCursorFromData(\fIinterp, tkwin, source, mask, width, height, xHot, yHot, fg, bg\fB)\fR
.sp
char *
\fBTk_NameOfCursor(\fIdisplay, cursor\fB)\fR




.sp
\fBTk_FreeCursor(\fIdisplay, cursor\fB)\fR
.SH ARGUMENTS
.AS "unsigned long" *pixelPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
.AP Tk_Window tkwin in
Token for window in which the cursor will be used.

.AP Tk_Uid nameId in
Description of cursor;  see below for possible values.





.AP char *source in
Data for cursor bitmap, in standard bitmap format.
.AP char *mask in
Data for mask bitmap, in standard bitmap format.
.AP "int" width in
Width of \fIsource\fR and \fImask\fR.
.AP "int" height in
Height of \fIsource\fR and \fImask\fR.
.AP "int" xHot in
X-location of cursor hot-spot.
.AP "int" yHot in
Y-location of cursor hot-spot.
.AP Tk_Uid fg in
Textual description of foreground color for cursor.
.AP Tk_Uid bg in
Textual description of background color for cursor.
.AP Display *display in
Display for which \fIcursor\fR was allocated.
.AP Tk_Cursor cursor in
Opaque Tk identifier for cursor.  If passed to\fBTk_FreeCursor\fR, must
have been returned by some previous call to \fBTk_GetCursor\fR or
\fBTk_GetCursorFromData\fR.
.BE

.SH DESCRIPTION
.PP
These procedures manage a collection of cursors
being used by an application.  The procedures allow cursors to be
re-used efficiently, thereby avoiding server overhead, and also
allow cursors to be named with character strings (actually Tk_Uids).
.PP

\fBTk_GetCursor\fR takes as argument a Tk_Uid describing a cursor,
and returns an opaque Tk identifier for a cursor corresponding to the
description. 
It re-uses an existing cursor if possible and
creates a new one otherwise.  \fINameId\fR must be a standard Tcl






list with one of the following forms:

.TP
\fIname\fR\0[\fIfgColor\fR\0[\fIbgColor\fR]]
\fIName\fR is the name of a cursor in the standard X cursor font,
i.e., any of the names defined in \fBcursorfont.h\fR, without
the \fBXC_\fR.  Some example values are \fBX_cursor\fR, \fBhand2\fR,
or \fBleft_ptr\fR.  Appendix B of ``The X Window System''
by Scheifler & Gettys has illustrations showing what each of these
cursors looks like.  If \fIfgColor\fR and \fIbgColor\fR are both
specified, they give the foreground and background colors to use
for the cursor (any of the forms acceptable to \fBTk_GetColor\fR
may be used).  If only \fIfgColor\fR is specified, then there
will be no background color:  the background will be transparent.
If no colors are specified, then the cursor
will use black for its foreground color and white for its background
color.


The Macintosh version of Tk also supports all of the X cursors.
Tk on the Mac will also accept any of the standard Mac cursors
including \fBibeam\fR, \fBcrosshair\fR, \fBwatch\fR, \fBplus\fR, and
\fBarrow\fR.  In addition, Tk will load Macintosh cursor resources of
the types \fBcrsr\fR (color) and \fBCURS\fR (black and white) by the
name of the of the resource.  The application and all its open
dynamic library's resource files will be searched for the named
cursor.  If there are conflicts color cursors will always be loaded
in preference to black and white cursors.

.TP
\fB@\fIsourceName\0maskName\0fgColor\0bgColor\fR
In this form, \fIsourceName\fR and \fImaskName\fR are the names of
files describing bitmaps for the cursor's source bits and mask.
Each file must be in standard X11 or X10 bitmap format.
\fIFgColor\fR and \fIbgColor\fR 
indicate the colors to use for the
cursor, in any of the forms acceptable to \fBTk_GetColor\fR.  This
form of the command will not work on Macintosh or Windows computers.
.TP
\fB@\fIsourceName\0fgColor\fR
This form is similar to the one above, except that the source is
used as mask also.  This means that the cursor's background is
transparent.  This form of the command will not work on Macintosh
or Windows computers.
.PP

















\fBTk_GetCursorFromData\fR allows cursors to be created from
in-memory descriptions of their source and mask bitmaps.  \fISource\fR
points to standard bitmap data for the cursor's source bits, and
\fImask\fR points to standard bitmap data describing
which pixels of \fIsource\fR are to be drawn and which are to be
considered transparent.  \fIWidth\fR and \fIheight\fR give the
dimensions of the cursor, \fIxHot\fR and \fIyHot\fR indicate the
location of the cursor's hot-spot (the point that is reported when
an event occurs), and \fIfg\fR and \fIbg\fR describe the cursor's
foreground and background colors textually (any of the forms
suitable for \fBTk_GetColor\fR may be used).  Typically, the
arguments to \fBTk_GetCursorFromData\fR are created by including
a cursor file directly into the source code for a program, as in
the following example:
.CS
Tk_Cursor cursor;
#include "source.cursor"
#include "mask.cursor"
cursor = Tk_GetCursorFromData(interp, tkwin, source_bits,
	mask_bits, source_width, source_height, source_x_hot,
	source_y_hot, Tk_GetUid("red"), Tk_GetUid("blue"));
.CE
.PP
Under normal conditions, \fBTk_GetCursor\fR and \fBTk_GetCursorFromData\fR
will return an identifier for the requested cursor.  If an error
occurs in creating the cursor, such as when \fInameId\fR refers
to a non-existent file, then \fBNone\fR is returned and an error
message will be stored in \fIinterp->result\fR.
.PP

\fBTk_GetCursor\fR and \fBTk_GetCursorFromData\fR maintain a
database of all the cursors they have created.  Whenever possible,

a call to \fBTk_GetCursor\fR or \fBTk_GetCursorFromData\fR will
return an existing cursor rather than creating a new one.  This
approach can substantially reduce server overhead, so the Tk
procedures should generally be used in preference to Xlib procedures
like \fBXCreateFontCursor\fR or \fBXCreatePixmapCursor\fR, which
create a new cursor on each call.

.PP
The procedure \fBTk_NameOfCursor\fR is roughly the inverse of
\fBTk_GetCursor\fR.  If its \fIcursor\fR argument was created
by \fBTk_GetCursor\fR, then the return value is the \fInameId\fR
argument that was passed to \fBTk_GetCursor\fR to create the
cursor.  If \fIcursor\fR was created by a call to \fBTk_GetCursorFromData\fR,
or by any other mechanism, then the return value is a hexadecimal string
giving the X identifier for the cursor.
Note:  the string returned by \fBTk_NameOfCursor\fR is
only guaranteed to persist until the next call to
\fBTk_NameOfCursor\fR.  Also, this call is not portable except for
cursors returned by \fBTk_GetCursor\fR.
.PP


When a cursor returned by \fBTk_GetCursor\fR or \fBTk_GetCursorFromData\fR
is no longer needed, \fBTk_FreeCursor\fR should be called to release it.





There should be exactly one call to \fBTk_FreeCursor\fR for

each call to \fBTk_GetCursor\fR or \fBTk_GetCursorFromData\fR.
When a cursor is no longer in use anywhere (i.e. it has been freed as
many times as it has been gotten) \fBTk_FreeCursor\fR will release
it to the X server and remove it from the database.


.SH BUGS
In determining whether an existing cursor can be used to satisfy

a new request, \fBTk_GetCursor\fR and \fBTk_GetCursorFromData\fR
consider only the immediate values of their arguments.  For
example, when a file name is passed to \fBTk_GetCursor\fR,
\fBTk_GetCursor\fR will assume it is safe to re-use an existing
cursor created from the same file name:  it will not check to
see whether the file itself has changed, or whether the current
directory has changed, thereby causing the name to refer to
a different file.  Similarly, \fBTk_GetCursorFromData\fR assumes
that if the same \fIsource\fR pointer is used in two different calls,
then the pointers refer to the same data;  it does not check to
see if the actual data values have changed.

.SH KEYWORDS
cursor


|




|


|


|




>

>
>
>
|
>
>
>
>






>
>
>
>








>
|
|
>
>
>
>
>

|

|















|









|

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

>


|
|











|
>
|
|







>



|
|











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

|
|
|



















|

<
|
|

>
|

>
|




|
>



|









>
>
|
|
>
>
>
>
>

>
|
<
<
<
>



>
|













1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88

89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222



223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetCursor.3,v 1.1.4.2 1998/09/30 02:15:54 stanton Exp $
'\" 
.so man.macros
.TH Tk_AllocCursorFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_AllocCursorFromObj, Tk_GetCursor, Tk_GetCursorFromObj, Tk_GetCursorFromData, Tk_NameOfCursor, Tk_FreeCursorFromObj, Tk_FreeCursor \- maintain database of cursors
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
.VS 8.1
Tk_Cursor
\fBTk_AllocCursorFromObj(\fIinterp, tkwin, objPtr\fB)\fR
.sp
Tk_Cursor
\fBTk_GetCursor(\fIinterp, tkwin, name\fB)\fR
.sp
Tk_Cursor
\fBTk_GetCursorFromObj(\fItkwin, objPtr\fB)\fR
.VE
.sp
Tk_Cursor
\fBTk_GetCursorFromData(\fIinterp, tkwin, source, mask, width, height, xHot, yHot, fg, bg\fB)\fR
.sp
char *
\fBTk_NameOfCursor(\fIdisplay, cursor\fB)\fR
.sp
.VS 8.1
\fBTk_FreeCursorFromObj(\fItkwin, objPtr\fB)\fR
.VE
.sp
\fBTk_FreeCursor(\fIdisplay, cursor\fB)\fR
.SH ARGUMENTS
.AS "unsigned long" *pixelPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
.AP Tk_Window tkwin in
Token for window in which the cursor will be used.
.VS 8.1 br
.AP Tcl_Obj *objPtr in/out
Description of cursor;  see below for possible values.  Internal rep will be
modified to cache pointer to corresponding Tk_Cursor.
.AP char *name in
Same as \fIobjPtr\fR except description of cursor is passed as a string and
resulting Tk_Cursor isn't cached.
.VE
.AP char *source in
Data for cursor cursor, in standard cursor format.
.AP char *mask in
Data for mask cursor, in standard cursor format.
.AP "int" width in
Width of \fIsource\fR and \fImask\fR.
.AP "int" height in
Height of \fIsource\fR and \fImask\fR.
.AP "int" xHot in
X-location of cursor hot-spot.
.AP "int" yHot in
Y-location of cursor hot-spot.
.AP Tk_Uid fg in
Textual description of foreground color for cursor.
.AP Tk_Uid bg in
Textual description of background color for cursor.
.AP Display *display in
Display for which \fIcursor\fR was allocated.
.AP Tk_Cursor cursor in
Opaque Tk identifier for cursor.  If passed to \fBTk_FreeCursor\fR, must
have been returned by some previous call to \fBTk_GetCursor\fR or
\fBTk_GetCursorFromData\fR.
.BE

.SH DESCRIPTION
.PP
These procedures manage a collection of cursors
being used by an application.  The procedures allow cursors to be
re-used efficiently, thereby avoiding server overhead, and also
allow cursors to be named with character strings.
.PP
.VS 8.1
\fBTk_AllocCursorFromObj\fR takes as argument an object describing a
cursor, and returns an opaque Tk identifier for a cursor corresponding

to the description.  It re-uses an existing cursor if possible and
creates a new one otherwise.  \fBTk_AllocCursorFromObj\fR caches
information about the return value in \fIobjPtr\fR, which speeds up
future calls to procedures such as \fBTk_AllocCursorFromObj\fR and
\fBTk_GetCursorFromObj\fR. If an error occurs in creating the cursor,
such as when \fIobjPtr\fR refers to a non-existent file, then \fBNone\fR
is returned and an error message will be stored in \fIinterp\fR's result
if \fIinterp\fR isn't NULL.  \fIObjPtr\fR must contain a standard Tcl
list with one of the following forms:
.VE
.TP
\fIname\fR\0[\fIfgColor\fR\0[\fIbgColor\fR]]
\fIName\fR is the name of a cursor in the standard X cursor cursor,
i.e., any of the names defined in \fBcursorcursor.h\fR, without
the \fBXC_\fR.  Some example values are \fBX_cursor\fR, \fBhand2\fR,
or \fBleft_ptr\fR.  Appendix B of ``The X Window System''
by Scheifler & Gettys has illustrations showing what each of these
cursors looks like.  If \fIfgColor\fR and \fIbgColor\fR are both
specified, they give the foreground and background colors to use
for the cursor (any of the forms acceptable to \fBTk_GetColor\fR
may be used).  If only \fIfgColor\fR is specified, then there
will be no background color:  the background will be transparent.
If no colors are specified, then the cursor
will use black for its foreground color and white for its background
color.
.RS
.PP
The Macintosh version of Tk supports all of the X cursors and
will also accept any of the standard Mac cursors
including \fBibeam\fR, \fBcrosshair\fR, \fBwatch\fR, \fBplus\fR, and
\fBarrow\fR.  In addition, Tk will load Macintosh cursor resources of
the types \fBcrsr\fR (color) and \fBCURS\fR (black and white) by the
name of the of the resource.  The application and all its open
dynamic library's resource files will be searched for the named
cursor.  If there are conflicts color cursors will always be loaded
in preference to black and white cursors.
.RE
.TP
\fB@\fIsourceName\0maskName\0fgColor\0bgColor\fR
In this form, \fIsourceName\fR and \fImaskName\fR are the names of
files describing cursors for the cursor's source bits and mask.
Each file must be in standard X11 or X10 cursor format.
\fIFgColor\fR and \fIbgColor\fR 
indicate the colors to use for the
cursor, in any of the forms acceptable to \fBTk_GetColor\fR.  This
form of the command will not work on Macintosh or Windows computers.
.TP
\fB@\fIsourceName\0fgColor\fR
This form is similar to the one above, except that the source is
used as mask also.  This means that the cursor's background is
transparent.  This form of the command will not work on Macintosh
or Windows computers.
.PP
.VS 8.1
\fBTk_GetCursor\fR is identical to \fBTk_AllocCursorFromObj\fR except
that the description of the cursor is specified with a string instead
of an object.  This prevents \fBTk_GetCursor\fR from caching the
return value, so \fBTk_GetCursor\fR is less efficient than
\fBTk_AllocCursorFromObj\fR.
.PP
\fBTk_GetCursorFromObj\fR returns the token for an existing cursor, given
the window and description used to create the cursor.
\fBTk_GetCursorFromObj\fR doesn't actually create the cursor; the cursor
must already have been created with a previous call to
\fBTk_AllocCursorFromObj\fR or \fBTk_GetCursor\fR.  The return
value is cached in \fIobjPtr\fR, which speeds up
future calls to \fBTk_GetCursorFromObj\fR with the same \fIobjPtr\fR
and \fItkwin\fR.
.VE
.PP
\fBTk_GetCursorFromData\fR allows cursors to be created from
in-memory descriptions of their source and mask cursors.  \fISource\fR
points to standard cursor data for the cursor's source bits, and
\fImask\fR points to standard cursor data describing
which pixels of \fIsource\fR are to be drawn and which are to be
considered transparent.  \fIWidth\fR and \fIheight\fR give the
dimensions of the cursor, \fIxHot\fR and \fIyHot\fR indicate the
location of the cursor's hot-spot (the point that is reported when
an event occurs), and \fIfg\fR and \fIbg\fR describe the cursor's
foreground and background colors textually (any of the forms
suitable for \fBTk_GetColor\fR may be used).  Typically, the
arguments to \fBTk_GetCursorFromData\fR are created by including
a cursor file directly into the source code for a program, as in
the following example:
.CS
Tk_Cursor cursor;
#include "source.cursor"
#include "mask.cursor"
cursor = Tk_GetCursorFromData(interp, tkwin, source_bits,
	mask_bits, source_width, source_height, source_x_hot,
	source_y_hot, Tk_GetUid("red"), Tk_GetUid("blue"));
.CE
.PP
Under normal conditions \fBTk_GetCursorFromData\fR
will return an identifier for the requested cursor.  If an error

occurs in creating the cursor then \fBNone\fR is returned and an error
message will be stored in \fIinterp\fR's result.
.PP
\fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR, and
\fBTk_GetCursorFromData\fR maintain a
database of all the cursors they have created.  Whenever possible,
a call to \fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR, or
\fBTk_GetCursorFromData\fR will
return an existing cursor rather than creating a new one.  This
approach can substantially reduce server overhead, so the Tk
procedures should generally be used in preference to Xlib procedures
like \fBXCreateFontCursor\fR or \fBXCreatePixmapCursor\fR, which
create a new cursor on each call.  The Tk procedures are also more
portable than the lower-level X procedures.
.PP
The procedure \fBTk_NameOfCursor\fR is roughly the inverse of
\fBTk_GetCursor\fR.  If its \fIcursor\fR argument was created
by \fBTk_GetCursor\fR, then the return value is the \fIname\fR
argument that was passed to \fBTk_GetCursor\fR to create the
cursor.  If \fIcursor\fR was created by a call to \fBTk_GetCursorFromData\fR,
or by any other mechanism, then the return value is a hexadecimal string
giving the X identifier for the cursor.
Note:  the string returned by \fBTk_NameOfCursor\fR is
only guaranteed to persist until the next call to
\fBTk_NameOfCursor\fR.  Also, this call is not portable except for
cursors returned by \fBTk_GetCursor\fR.
.PP
.VS 8.1
When a cursor returned by \fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR,
or \fBTk_GetCursorFromData\fR
is no longer needed, \fBTk_FreeCursorFromObj\fR or
\fBTk_FreeCursor\fR should be called to release it.
For \fBTk_FreeCursorFromObj\fR the cursor to release is specified
with the same information used to create it; for
\fBTk_FreeCursor\fR the cursor to release is specified
with its Tk_Cursor token.
There should be exactly one call to \fBTk_FreeCursor\fR for
each call to \fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR,
or \fBTk_GetCursorFromData\fR.



.VE

.SH BUGS
In determining whether an existing cursor can be used to satisfy
a new request, \fBTk_AllocCursorFromObj\fR, \fBTk_GetCursor\fR,
and \fBTk_GetCursorFromData\fR
consider only the immediate values of their arguments.  For
example, when a file name is passed to \fBTk_GetCursor\fR,
\fBTk_GetCursor\fR will assume it is safe to re-use an existing
cursor created from the same file name:  it will not check to
see whether the file itself has changed, or whether the current
directory has changed, thereby causing the name to refer to
a different file.  Similarly, \fBTk_GetCursorFromData\fR assumes
that if the same \fIsource\fR pointer is used in two different calls,
then the pointers refer to the same data;  it does not check to
see if the actual data values have changed.

.SH KEYWORDS
cursor

Changes to doc/GetFont.3.

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
'\"
'\" Copyright (c) 1990-1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetFont.3 1.11 96/07/31 14:07:40
'\" 
.so man.macros
.TH Tk_GetFont 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetFont, Tk_NameOfFont, Tk_FreeFont \- maintain database of fonts
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp

Tk_Font 



\fBTk_GetFont(\fIinterp, tkwin, string\fB)\fR




.sp
char *
\fBTk_NameOfFont(\fItkfont\fB)\fR





.sp
void
\fBTk_FreeFont(\fItkfont\fB)\fR

.SH ARGUMENTS
.AS "const char" *tkfont
.AP "Tcl_Interp" *interp in
Interpreter to use for error reporting.

.AP Tk_Window tkwin in
Token for window on the display in which font will be used.

.AP "const char" *string in
Name or description of desired font.  See documentation for the \fBfont\fR 
command for details on acceptable formats.





.AP Tk_Font tkfont in
Opaque font token.
.BE
.SH DESCRIPTION
.PP

\fBTk_GetFont\fR finds the font indicated by \fIstring\fR and returns a
token that represents the font.  The return value can be used in subsequent
calls to procedures such as \fBTk_FontMetrics\fR, \fBTk_MeasureChars\fR, and
\fBTk_FreeFont\fR.  The token returned by \fBTk_GetFont\fR will remain

valid until \fBTk_FreeFont\fR is called to release it.  \fIString\fR can
be either a symbolic name or a font description; see the documentation for
the \fBfont\fR command for a description of the valid formats.  If
\fBTk_GetFont\fR is unsuccessful (because, for example, \fIstring\fR was
not a valid font specification) then it returns \fBNULL\fR and stores an
error message in \fIinterp->result\fR.




















.PP

\fBTk_GetFont\fR maintains a database of all fonts it has allocated.  If
the same \fIstring\fR is requested multiple times (e.g. by different
windows or for different purposes), then additional calls for the same
\fIstring\fR will be handled without involving the platform-specific
graphics server.

.PP
The procedure \fBTk_NameOfFont\fR is roughly the inverse of
\fBTk_GetFont\fR.  Given a \fItkfont\fR that was created by

\fBTk_GetFont\fR, the return value is the \fIstring\fR argument that was
passed to \fBTk_GetFont\fR to create the font.  The string returned by
\fBTk_NameOfFont\fR is only guaranteed to persist until the \fItkfont\fR
is deleted.  The caller must not modify this string.
.PP

When a font returned by \fBTk_GetFont\fR is no longer needed,




\fBTk_FreeFont\fR should be called to release it.  There should be
exactly one call to \fBTk_FreeFont\fR for each call to \fBTk_GetFont\fR.
When a font is no longer in use anywhere (i.e. it has been freed as many
times as it has been gotten) \fBTk_FreeFont\fR will release any
platform-specific storage and delete it from the database.  


.SH KEYWORDS
font


|




|


|


|




>

>
>
>
|
>
>
>
>



>
>
>
>
>







|
>

|
>
|
|
|
>
>
>
>
>





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

>
|
|
|
|
<
>



>
|




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



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
'\"
'\" Copyright (c) 1990-1992 The Regents of the University of California.
'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetFont.3,v 1.1.4.2 1998/09/30 02:15:55 stanton Exp $
'\" 
.so man.macros
.TH Tk_AllocFontFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_AllocFontFromObj, Tk_GetFont, Tk_GetFontFromObj, Tk_NameOfFont, Tk_FreeFontFromObj, Tk_FreeFont \- maintain database of fonts
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
.VS 8.1
Tk_Font 
\fBTk_AllocFontFromObj(\fIinterp, tkwin, objPtr\fB)\fR
.sp
Tk_Font 
\fBTk_GetFont(\fIinterp, tkwin, string\fB)\fR 
.sp
Tk_Font 
\fBTk_GetFontFromObj(\fItkwin, objPtr\fB)\fR
.VE
.sp
char *
\fBTk_NameOfFont(\fItkfont\fB)\fR
.sp
.VS 8.1
Tk_Font 
\fBTk_FreeFontFromObj(\fItkwin, objPtr\fB)\fR
.VE
.sp
void
\fBTk_FreeFont(\fItkfont\fB)\fR

.SH ARGUMENTS
.AS "const char" *tkfont
.AP "Tcl_Interp" *interp in
Interpreter to use for error reporting.  If NULL, then no error
messages are left after errors.
.AP Tk_Window tkwin in
Token for window in which font will be used.
.VS 8.1 br
.AP Tcl_Obj *objPtr in/out
Gives name or description of font.  See documentation
for the \fBfont\fR command for details on acceptable formats.
Internal rep will be modified to cache corresponding Tk_Font.
.AP "const char" *string in
Same as \fIobjPtr\fR except description of font is passed as a string and
resulting Tk_Font isn't cached.
.VE
.AP Tk_Font tkfont in
Opaque font token.
.BE
.SH DESCRIPTION
.PP
.VS 8.1
\fBTk_AllocFontFromObj\fR finds the font indicated by \fIobjPtr\fR and
returns a token that represents the font.  The return value can be used
in subsequent calls to procedures such as \fBTk_FontMetrics\fR,
\fBTk_MeasureChars\fR, and \fBTk_FreeFont\fR.  The Tk_Font token
will remain valid until
\fBTk_FreeFontFromObj\fR or \fBTk_FreeFont\fR is called to release it. 
\fIObjPtr\fR can contain either a symbolic name or a font description; see
the documentation for the \fBfont\fR command for a description of the
valid formats.  If \fBTk_AllocFontFromObj\fR is unsuccessful (because,
for example, \fIobjPtr\fR did not contain a valid font specification) then it
returns \fBNULL\fR and leaves an error message in \fIinterp\fR's result
if \fIinterp\fR isn't NULL.  \fBTk_AllocFontFromObj\fR caches
information about the return
value in \fIobjPtr\fR, which speeds up future calls to procedures
such as \fBTk_AllocFontFromObj\fR and \fBTk_GetFontFromObj\fR.
.PP
\fBTk_GetFont\fR is identical to \fBTk_AllocFontFromObj\fR except
that the description of the font is specified with a string instead
of an object.  This prevents \fBTk_GetFont\fR from caching the
matching Tk_Font, so \fBTk_GetFont\fR is less efficient than
\fBTk_AllocFontFromObj\fR.
.PP
\fBTk_GetFontFromObj\fR returns the token for an existing font, given
the window and description used to create the font.
\fBTk_GetFontFromObj\fR doesn't actually create the font; the font
must already have been created with a previous call to
\fBTk_AllocFontFromObj\fR or \fBTk_GetFont\fR.  The return
value is cached in \fIobjPtr\fR, which speeds up
future calls to \fBTk_GetFontFromObj\fR with the same \fIobjPtr\fR
and \fItkwin\fR.
.VE
.PP
\fBTk_AllocFontFromObj\fR and \fBTk_GetFont\fR maintain
a database of all fonts they have allocated.  If
the same font is requested multiple times (e.g. by different
windows or for different purposes), then a single Tk_Font will be
shared for all uses.  The underlying resources will be freed automatically

when no-one is using the font anymore.
.PP
The procedure \fBTk_NameOfFont\fR is roughly the inverse of
\fBTk_GetFont\fR.  Given a \fItkfont\fR that was created by
\fBTk_GetFont\fR (or \fBTk_AllocFontFromObj\fR), the return value is
the \fIstring\fR argument that was
passed to \fBTk_GetFont\fR to create the font.  The string returned by
\fBTk_NameOfFont\fR is only guaranteed to persist until the \fItkfont\fR
is deleted.  The caller must not modify this string.
.PP
.VS 8.1
When a font is no longer needed,
\fBTk_FreeFontFromObj\fR or \fBTk_FreeFont\fR should be called to
release it.  For \fBTk_FreeFontFromObj\fR the font to release is specified
with the same information used to create it; for
\fBTk_FreeFont\fR the font to release is specified
with its Tk_Font token.  There should be
exactly one call to \fBTk_FreeFontFromObj\fR or \fBTk_FreeFont\fR

for each call to \fBTk_AllocFontFromObj\fR or \fBTk_GetFont\fR.

.VE

.SH KEYWORDS
font

Changes to doc/GetGC.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetGC.3 1.11 96/03/26 18:10:14
'\" 
.so man.macros
.TH Tk_GetGC 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetGC, Tk_FreeGC \- maintain database of read-only graphics contexts
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetGC.3,v 1.1.4.1 1998/09/30 02:15:55 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetGC 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetGC, Tk_FreeGC \- maintain database of read-only graphics contexts
.SH SYNOPSIS

Changes to doc/GetImage.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetImage.3 1.8 96/03/26 18:10:29
'\" 
.so man.macros
.TH Tk_GetImage 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetImage, Tk_RedrawImage, Tk_SizeOfImage, Tk_FreeImage \- use an image in a widget
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetImage.3,v 1.1.4.1 1998/09/30 02:15:55 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetImage 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetImage, Tk_RedrawImage, Tk_SizeOfImage, Tk_FreeImage \- use an image in a widget
.SH SYNOPSIS

Changes to doc/GetJoinStl.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetJoinStl.3 1.8 96/03/26 18:10:46
'\" 
.so man.macros
.TH Tk_GetJoinStyle 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetJoinStyle, Tk_NameOfJoinStyle \- translate between strings and join styles
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetJoinStl.3,v 1.1.4.1 1998/09/30 02:15:56 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetJoinStyle 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetJoinStyle, Tk_NameOfJoinStyle \- translate between strings and join styles
.SH SYNOPSIS

Changes to doc/GetJustify.3.

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
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetJustify.3 1.11 96/08/27 13:21:27
'\" 
.so man.macros
.TH Tk_GetJustify 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetJustify, Tk_NameOfJustify \- translate between strings and justification styles
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp


Tk_Justify


\fBTk_GetJustify(\fIinterp, string, justifyPtr\fB)\fR
.sp
char *
\fBTk_NameOfJustify(\fIjustify\fB)\fR
.SH ARGUMENTS
.AS "Tk_Justify" *justifyPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.





.AP char *string in
String containing name of justification style (``left'', ``right'', or

``center'').
.AP int *justifyPtr out
Pointer to location in which to store justify value corresponding to
\fIstring\fR.
.AP Tk_Justify justify in
Justification style (one of the values listed below).
.BE

.SH DESCRIPTION
.PP

\fBTk_GetJustify\fR places in \fI*justifyPtr\fR the justify value


corresponding to \fIstring\fR.  This value will be one of the following:
.TP
\fBTK_JUSTIFY_LEFT\fR
Means that the text on each line should start at the left edge of
the line;  as a result, the right edges of lines may be ragged.
.TP
\fBTK_JUSTIFY_RIGHT\fR
Means that the text on each line should end at the right edge of
the line;  as a result, the left edges of lines may be ragged.
.TP
\fBTK_JUSTIFY_CENTER\fR
Means that the text on each line should be centered;  as a result,
both the left and right edges of lines may be ragged.
.PP

Under normal circumstances the return value is \fBTCL_OK\fR and
\fIinterp\fR is unused.
If \fIstring\fR doesn't contain a valid justification style
or an abbreviation of one of these names, then an error message is
stored in \fIinterp->result\fR, \fBTCL_ERROR\fR is returned, and
\fI*justifyPtr\fR is unmodified.











.PP
\fBTk_NameOfJustify\fR is the logical inverse of \fBTk_GetJustify\fR.
Given a justify value it returns a statically-allocated string
corresponding to \fIjustify\fR.
If \fIjustify\fR isn't a legal justify value, then
``unknown justification style'' is returned.



|




|


|


|




>
>
|
>
>







|
>
>
>
>
>

|
>
|


|






>
|
>
>
|













>


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







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
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetJustify.3,v 1.1.4.2 1998/09/30 02:15:56 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetJustifyFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetJustifyFromObj, Tk_GetJustify, Tk_NameOfJustify \- translate between strings and justification styles
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
.VS 8.1
int
\fBTk_GetJustifyFromObj(\fIinterp, objPtr, justifyPtr\fB)\fR
.sp
int
\fBTk_GetJustify(\fIinterp, string, justifyPtr\fB)\fR
.sp
char *
\fBTk_NameOfJustify(\fIjustify\fB)\fR
.SH ARGUMENTS
.AS "Tk_Justify" *justifyPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting, or NULL.
.VS 8.1 br
.AP Tcl_Obj *objPtr in/out
String value contains name of justification style (\fBleft\fR, \fBright\fR, or
\fBcenter\fR).  The
internal rep will be modified to cache corresponding justify value.
.AP char *string in
Same as \fIobjPtr\fR except description of justification style is passed as
a string.
.VE
.AP int *justifyPtr out
Pointer to location in which to store justify value corresponding to
\fIobjPtr\fR or \fIstring\fR.
.AP Tk_Justify justify in
Justification style (one of the values listed below).
.BE

.SH DESCRIPTION
.PP
.VS 8.1
\fBTk_GetJustifyFromObj\fR places in \fI*justifyPtr\fR the justify value
corresponding to \fIobjPtr\fR's value.
.VE
This value will be one of the following:
.TP
\fBTK_JUSTIFY_LEFT\fR
Means that the text on each line should start at the left edge of
the line;  as a result, the right edges of lines may be ragged.
.TP
\fBTK_JUSTIFY_RIGHT\fR
Means that the text on each line should end at the right edge of
the line;  as a result, the left edges of lines may be ragged.
.TP
\fBTK_JUSTIFY_CENTER\fR
Means that the text on each line should be centered;  as a result,
both the left and right edges of lines may be ragged.
.PP
.VS 8.1
Under normal circumstances the return value is \fBTCL_OK\fR and
\fIinterp\fR is unused.
If \fIobjPtr\fR doesn't contain a valid justification style
or an abbreviation of one of these names, \fBTCL_ERROR\fR is returned,

\fI*justifyPtr\fR is unmodified, and an error message is
stored in \fIinterp\fR's result if \fIinterp\fR isn't NULL.
\fBTk_GetJustifyFromObj\fR caches information about the return
value in \fIobjPtr\fR, which speeds up future calls to
\fBTk_GetJustifyFromObj\fR with the same \fIobjPtr\fR.
.PP
\fBTk_GetJustify\fR is identical to \fBTk_GetJustifyFromObj\fR except
that the description of the justification is specified with a string instead
of an object.  This prevents \fBTk_GetJustify\fR from caching the
return value, so \fBTk_GetJustify\fR is less efficient than
\fBTk_GetJustifyFromObj\fR.
.VE
.PP
\fBTk_NameOfJustify\fR is the logical inverse of \fBTk_GetJustify\fR.
Given a justify value it returns a statically-allocated string
corresponding to \fIjustify\fR.
If \fIjustify\fR isn't a legal justify value, then
``unknown justification style'' is returned.

Changes to doc/GetOption.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetOption.3 1.9 96/03/26 18:11:11
'\" 
.so man.macros
.TH Tk_GetOption 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetOption \- retrieve an option from the option database
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetOption.3,v 1.1.4.1 1998/09/30 02:15:56 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetOption 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetOption \- retrieve an option from the option database
.SH SYNOPSIS

Changes to doc/GetPixels.3.

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
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetPixels.3 1.8 96/03/26 18:11:30
'\" 
.so man.macros
.TH Tk_GetPixels 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetPixels, Tk_GetScreenMM \- translate between strings and screen units
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp

int




\fBTk_GetPixels(\fIinterp, tkwin, string, intPtr\fB)\fR





.sp
int
\fBTk_GetScreenMM(\fIinterp, tkwin, string, doublePtr\fB)\fR
.SH ARGUMENTS
.AS "Tcl_Interp" *joinPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
.AP Tk_Window tkwin in
Window whose screen geometry determines the conversion between absolute
units and pixels. 




.AP char *string in

String that specifies a distance on the screen.

.AP int *intPtr out
Pointer to location in which to store converted distance in pixels.
.AP double *doublePtr out
Pointer to location in which to store converted distance in millimeters.
.BE

.SH DESCRIPTION
.PP
These two procedures take as argument a specification of distance on

the screen (\fIstring\fR) and compute the corresponding distance

either in integer pixels or floating-point millimeters.




In either case, \fIstring\fR specifies a screen distance as a
floating-point number followed by one of the following characters
that indicates units:
.TP
<none>
The number specifies a distance in pixels.
.TP
\fBc\fR
The number specifies a distance in centimeters on the screen.
.TP
\fBi\fR
The number specifies a distance in inches on the screen.
.TP
\fBm\fR
The number specifies a distance in millimeters on the screen.
.TP
\fBp\fR
The number specifies a distance in printer's points (1/72 inch)
on the screen.
.PP

\fBTk_GetPixels\fR converts \fIstring\fR to the nearest even
number of pixels and stores that value at \fI*intPtr\fR.
\fBTk_GetScreenMM\fR converts \fIstring\fR to millimeters and
stores the double-precision floating-point result at \fI*doublePtr\fR.
.PP
Both procedures return \fBTCL_OK\fR under normal circumstances.
If an error occurs (e.g. \fIstring\fR contains a number followed
by a character that isn't one of the ones above) then
\fBTCL_ERROR\fR is returned and an error message is left
in \fIinterp->result\fR.
















.SH KEYWORDS
centimeters, convert, inches, millimeters, pixels, points, screen units


|




|


|


|




>

>
>
>
>

>
>
>
>
>









|
>
>
>
>

>
|
>








|
>
|
>
|
>
>
>
>
|



















>
|
|
<
<
<
|
|


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



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
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetPixels.3,v 1.1.4.2 1998/09/30 02:15:57 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetPixelsFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetPixelsFromObj, Tk_GetPixels, Tk_GetMMFromObj, Tk_GetScreenMM \- translate between strings and screen units
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
.VS 8.1
int
\fBTk_GetPixelsFromObj(\fIinterp, tkwin, objPtr, intPtr\fB)\fR
.VE
.sp
int
\fBTk_GetPixels(\fIinterp, tkwin, string, intPtr\fB)\fR
.sp
.VS 8.1
int
\fBTk_GetMMFromObj(\fIinterp, tkwin, objPtr, doublePtr\fB)\fR
.VE
.sp
int
\fBTk_GetScreenMM(\fIinterp, tkwin, string, doublePtr\fB)\fR
.SH ARGUMENTS
.AS "Tcl_Interp" *joinPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
.AP Tk_Window tkwin in
Window whose screen geometry determines the conversion between absolute
units and pixels.
.VS 8.1 br
.AP Tcl_Obj *objPtr in/out
String value specifies a distance on the screen;
internal rep will be modified to cache converted distance.
.AP char *string in
Same as \fIobjPtr\fR except specification of distance is passed as
a string.
.VE
.AP int *intPtr out
Pointer to location in which to store converted distance in pixels.
.AP double *doublePtr out
Pointer to location in which to store converted distance in millimeters.
.BE

.SH DESCRIPTION
.PP
These procedures take as argument a specification of distance on
.VS 8.1
the screen (\fIobjPtr\fR or \fIstring\fR) and compute the
.VE
corresponding distance either in integer pixels or floating-point millimeters.
In either case,
.VS 8.1
\fIobjPtr\fR or \fIstring\fR
.VE
specifies a screen distance as a
floating-point number followed by one of the following characters
that indicates units:
.TP
<none>
The number specifies a distance in pixels.
.TP
\fBc\fR
The number specifies a distance in centimeters on the screen.
.TP
\fBi\fR
The number specifies a distance in inches on the screen.
.TP
\fBm\fR
The number specifies a distance in millimeters on the screen.
.TP
\fBp\fR
The number specifies a distance in printer's points (1/72 inch)
on the screen.
.PP
.VS 8.1
\fBTk_GetPixelsFromObj\fR converts the value of \fIobjPtr\fR to the
nearest even number of pixels and stores that value at \fI*intPtr\fR.



It returns \fBTCL_OK\fR under normal circumstances.
If an error occurs (e.g. \fIobjPtr\fR contains a number followed
by a character that isn't one of the ones above) then
\fBTCL_ERROR\fR is returned and an error message is left
in \fIinterp\fR's result if \fIinterp\fR isn't NULL.
\fBTk_GetPixelsFromObj\fR caches information about the return
value in \fIobjPtr\fR, which speeds up future calls to
\fBTk_GetPixelsFromObj\fR with the same \fIobjPtr\fR.
.PP
\fBTk_GetPixels\fR is identical to \fBTk_GetPixelsFromObj\fR except
that the screen distance is specified with a string instead
of an object.  This prevents \fBTk_GetPixels\fR from caching the
return value, so \fBTk_GetAnchor\fR is less efficient than
\fBTk_GetPixelsFromObj\fR.
.PP
\fBTk_GetMMFromObj\fR and \fBTk_GetScreenMM\fR are similar to
\fBTk_GetPixelsFromObj\fR and \fBTk_GetPixels\fR (respectively) except
that they convert the screen distance to millimeters and
store a double-precision floating-point result at \fI*doublePtr\fR.
.VE

.SH KEYWORDS
centimeters, convert, inches, millimeters, pixels, points, screen units

Changes to doc/GetPixmap.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetPixmap.3 1.7 96/03/26 18:11:47
'\" 
.so man.macros
.TH Tk_GetPixmap 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetPixmap, Tk_FreePixmap \- allocate and free pixmaps
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetPixmap.3,v 1.1.4.1 1998/09/30 02:15:57 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetPixmap 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetPixmap, Tk_FreePixmap \- allocate and free pixmaps
.SH SYNOPSIS

Changes to doc/GetRelief.3.

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
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetRelief.3 1.11 96/11/17 14:54:49
'\" 
.so man.macros
.TH Tk_GetRelief 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetRelief, Tk_NameOfRelief \- translate between strings and relief values
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR





.sp
int
\fBTk_GetRelief(\fIinterp, name, reliefPtr\fB)\fR
.sp
char *
\fBTk_NameOfRelief(\fIrelief\fB)\fR
.SH ARGUMENTS
.AS "Tcl_Interp" *reliefPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.





.AP char *name in

String containing relief name (one of ``flat'', ``groove'',
``raised'', ``ridge'', ``solid'', or ``sunken'').

.AP int *reliefPtr out
Pointer to location in which to store relief value corresponding to
\fIname\fR.
.AP int relief in
Relief value (one of TK_RELIEF_FLAT, TK_RELIEF_RAISED, TK_RELIEF_SUNKEN,
TK_RELIEF_GROOVE, TK_RELIEF_SOLID, or TK_RELIEF_RIDGE).
.BE

.SH DESCRIPTION
.PP

\fBTk_GetRelief\fR places in \fI*reliefPtr\fR the relief value
corresponding to \fIname\fR.  This value will be one of
TK_RELIEF_FLAT, TK_RELIEF_RAISED, TK_RELIEF_SUNKEN,
TK_RELIEF_GROOVE, TK_RELIEF_SOLID, or TK_RELIEF_RIDGE.
Under normal circumstances the return value is TCL_OK and
\fIinterp\fR is unused.
If \fIname\fR doesn't contain one of the valid relief names
or an abbreviation of one of them, then an error message

is stored in \fIinterp->result\fR,

TCL_ERROR is returned, and \fI*reliefPtr\fR is unmodified.

.PP







\fBTk_NameOfRelief\fR is the logical inverse of \fBTk_GetRelief\fR.
Given a relief value it returns the corresponding string (``flat'',
``raised'', ``sunken'', ``groove'', ``solid'', or ``ridge'').

If \fIrelief\fR isn't a legal relief value, then ``unknown relief''
is returned.

.SH KEYWORDS
name, relief, string


|




|


|


|



>
>
>
>
>










>
>
>
>
>
|
>
|
<
>


|







>
|
|




|
|
>
|
>
|
>

>
>
>
>
>
>
>

|
<
>





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
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetRelief.3,v 1.1.4.2 1998/09/30 02:15:57 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetReliefFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetReliefFromObj, Tk_GetRelief, Tk_NameOfRelief \- translate between strings and relief values
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
.VS 8.1
int
\fBTk_GetReliefFromObj(\fIinterp, objPtr, reliefPtr\fB)\fR
.VE
.sp
int
\fBTk_GetRelief(\fIinterp, name, reliefPtr\fB)\fR
.sp
char *
\fBTk_NameOfRelief(\fIrelief\fB)\fR
.SH ARGUMENTS
.AS "Tcl_Interp" *reliefPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
.VS 8.1 br
.AP Tcl_Obj *objPtr in/out
String value contains name of relief (one of \fBflat\fR, \fBgroove\fR,
\fBraised\fR, \fBridge\fR, \fBsolid\fR, or \fBsunken\fR);
internal rep will be modified to cache corresponding relief value.
.AP char *string in
Same as \fIobjPtr\fR except description of relief is passed as
a string.

.VE
.AP int *reliefPtr out
Pointer to location in which to store relief value corresponding to
\fIobjPtr\fR or \fIname\fR.
.AP int relief in
Relief value (one of TK_RELIEF_FLAT, TK_RELIEF_RAISED, TK_RELIEF_SUNKEN,
TK_RELIEF_GROOVE, TK_RELIEF_SOLID, or TK_RELIEF_RIDGE).
.BE

.SH DESCRIPTION
.PP
.VS 8.1
\fBTk_GetReliefFromObj\fR places in \fI*reliefPtr\fR the relief value
corresponding to the value of \fIobjPtr\fR.  This value will be one of
TK_RELIEF_FLAT, TK_RELIEF_RAISED, TK_RELIEF_SUNKEN,
TK_RELIEF_GROOVE, TK_RELIEF_SOLID, or TK_RELIEF_RIDGE.
Under normal circumstances the return value is TCL_OK and
\fIinterp\fR is unused.
If \fIobjPtr\fR doesn't contain one of the valid relief names
or an abbreviation of one of them, then TCL_ERROR is returned,
\fI*reliefPtr\fR is unmodified, and an error message
is stored in \fIinterp\fR's result if \fIinterp\fR isn't NULL.
\fBTk_GetReliefFromObj\fR caches information about the return
value in \fIobjPtr\fR, which speeds up future calls to
\fBTk_GetReliefFromObj\fR with the same \fIobjPtr\fR.
.PP
\fBTk_GetRelief\fR is identical to \fBTk_GetReliefFromObj\fR except
that the description of the relief is specified with a string instead
of an object.  This prevents \fBTk_GetRelief\fR from caching the
return value, so \fBTk_GetRelief\fR is less efficient than
\fBTk_GetReliefFromObj\fR.
.VE
.PP
\fBTk_NameOfRelief\fR is the logical inverse of \fBTk_GetRelief\fR.
Given a relief value it returns the corresponding string (\fBflat\fR,

\fBraised\fR, \fBsunken\fR, \fBgroove\fR, \fBsolid\fR, or \fBridge\fR).
If \fIrelief\fR isn't a legal relief value, then ``unknown relief''
is returned.

.SH KEYWORDS
name, relief, string

Changes to doc/GetRootCrd.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetRootCrd.3 1.9 96/03/26 18:12:16
'\" 
.so man.macros
.TH Tk_GetRootCoords 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetRootCoords \- Compute root-window coordinates of window
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetRootCrd.3,v 1.1.4.1 1998/09/30 02:15:58 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetRootCoords 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetRootCoords \- Compute root-window coordinates of window
.SH SYNOPSIS

Changes to doc/GetScroll.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetScroll.3 1.7 96/03/26 18:12:29
'\" 
.so man.macros
.TH Tk_GetScrollInfo 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetScrollInfo \- parse arguments for scrolling commands
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetScroll.3,v 1.1.4.1 1998/09/30 02:15:58 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetScrollInfo 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetScrollInfo \- parse arguments for scrolling commands
.SH SYNOPSIS

Changes to doc/GetSelect.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetSelect.3 1.16 96/08/27 13:21:28
'\" 
.so man.macros
.TH Tk_GetSelection 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetSelection \- retrieve the contents of a selection
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetSelect.3,v 1.1.4.1 1998/09/30 02:15:58 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetSelection 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetSelection \- retrieve the contents of a selection
.SH SYNOPSIS

Changes to doc/GetUid.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetUid.3 1.10 96/03/26 18:12:55
'\" 
.so man.macros
.TH Tk_GetUid 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetUid, Tk_Uid \- convert from string to unique identifier
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetUid.3,v 1.1.4.1 1998/09/30 02:15:59 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetUid 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetUid, Tk_Uid \- convert from string to unique identifier
.SH SYNOPSIS

Changes to doc/GetVRoot.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetVRoot.3 1.10 96/08/27 13:21:28
'\" 
.so man.macros
.TH Tk_GetVRootGeometry 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetVRootGeometry \- Get location and size of virtual root for window
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetVRoot.3,v 1.1.4.1 1998/09/30 02:15:59 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetVRootGeometry 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetVRootGeometry \- Get location and size of virtual root for window
.SH SYNOPSIS

Changes to doc/GetVisual.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) GetVisual.3 1.9 96/03/26 18:13:20
'\" 
.so man.macros
.TH Tk_GetVisual 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetVisual \- translate from string to visual
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: GetVisual.3,v 1.1.4.1 1998/09/30 02:15:59 stanton Exp $
'\" 
.so man.macros
.TH Tk_GetVisual 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_GetVisual \- translate from string to visual
.SH SYNOPSIS

Changes to doc/HandleEvent.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) HandleEvent.3 1.6 96/03/26 18:13:34
'\" 
.so man.macros
.TH Tk_HandleEvent 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_HandleEvent \- invoke event handlers for window system events
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: HandleEvent.3,v 1.1.4.1 1998/09/30 02:16:00 stanton Exp $
'\" 
.so man.macros
.TH Tk_HandleEvent 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_HandleEvent \- invoke event handlers for window system events
.SH SYNOPSIS

Changes to doc/IdToWindow.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) IdToWindow.3 1.4 96/03/26 18:14:08
'\" 
.so man.macros
.TH Tk_IdToWindow 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_IdToWindow \- Find Tk's window information for an X window
.SH SYNOPSIS






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: IdToWindow.3,v 1.1.4.1 1998/09/30 02:16:00 stanton Exp $
'\" 
.so man.macros
.TH Tk_IdToWindow 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_IdToWindow \- Find Tk's window information for an X window
.SH SYNOPSIS

Changes to doc/ImgChanged.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) ImgChanged.3 1.6 96/03/26 18:14:18
'\" 
.so man.macros
.TH Tk_ImageChanged 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ImageChanged \- notify widgets that image needs to be redrawn
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: ImgChanged.3,v 1.1.4.1 1998/09/30 02:16:01 stanton Exp $
'\" 
.so man.macros
.TH Tk_ImageChanged 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ImageChanged \- notify widgets that image needs to be redrawn
.SH SYNOPSIS

Changes to doc/InternAtom.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) InternAtom.3 1.8 96/03/26 18:14:31
'\" 
.so man.macros
.TH Tk_InternAtom 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_InternAtom, Tk_GetAtomName \- manage cache of X atoms
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: InternAtom.3,v 1.1.4.1 1998/09/30 02:16:01 stanton Exp $
'\" 
.so man.macros
.TH Tk_InternAtom 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_InternAtom, Tk_GetAtomName \- manage cache of X atoms
.SH SYNOPSIS

Changes to doc/MainLoop.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) MainLoop.3 1.3 96/03/26 18:15:01
'\" 
.so man.macros
.TH Tk_MainLoop 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_MainLoop \- loop for events until all windows are deleted
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: MainLoop.3,v 1.1.4.1 1998/09/30 02:16:01 stanton Exp $
'\" 
.so man.macros
.TH Tk_MainLoop 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_MainLoop \- loop for events until all windows are deleted
.SH SYNOPSIS

Changes to doc/MainWin.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) MainWin.3 1.5 96/03/26 18:15:15
'\" 
.so man.macros
.TH Tk_MainWindow 3 7.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_MainWindow \- find the main window for an application
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: MainWin.3,v 1.1.4.1 1998/09/30 02:16:02 stanton Exp $
'\" 
.so man.macros
.TH Tk_MainWindow 3 7.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_MainWindow \- find the main window for an application
.SH SYNOPSIS

Changes to doc/MaintGeom.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) MaintGeom.3 1.7 96/03/26 18:15:30
'\" 
.so man.macros
.TH Tk_MaintainGeometry 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_MaintainGeometry, Tk_UnmaintainGeometry \- maintain geometry of one window relative to another
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: MaintGeom.3,v 1.1.4.1 1998/09/30 02:16:02 stanton Exp $
'\" 
.so man.macros
.TH Tk_MaintainGeometry 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_MaintainGeometry, Tk_UnmaintainGeometry \- maintain geometry of one window relative to another
.SH SYNOPSIS

Changes to doc/ManageGeom.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) ManageGeom.3 1.18 96/08/27 13:21:30
'\" 
.so man.macros
.TH Tk_ManageGeometry 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ManageGeometry \- arrange to handle geometry requests for a window
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: ManageGeom.3,v 1.1.4.1 1998/09/30 02:16:03 stanton Exp $
'\" 
.so man.macros
.TH Tk_ManageGeometry 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ManageGeometry \- arrange to handle geometry requests for a window
.SH SYNOPSIS

Changes to doc/MapWindow.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) MapWindow.3 1.12 97/01/29 08:50:08
'\" 
.so man.macros
.TH Tk_MapWindow 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_MapWindow, Tk_UnmapWindow \- map or unmap a window
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: MapWindow.3,v 1.1.4.1 1998/09/30 02:16:03 stanton Exp $
'\" 
.so man.macros
.TH Tk_MapWindow 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_MapWindow, Tk_UnmapWindow \- map or unmap a window
.SH SYNOPSIS

Changes to doc/MeasureChar.3.

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
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) MeasureChar.3 1.5 97/06/10 17:33:36
'\" 
.so man.macros
.TH Tk_MeasureChars 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_MeasureChars, Tk_TextWidth, Tk_DrawChars, Tk_UnderlineChars \- routines to measure and display simple single-line strings.
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
int
\fBTk_MeasureChars(\fItkfont, string, maxChars, maxPixels, flags, lengthPtr\fB)\fR
.sp
int
\fBTk_TextWidth(\fItkfont, string, numChars\fB)\fR
.sp
void
\fBTk_DrawChars(\fIdisplay, drawable, gc, tkfont, string, numChars, x, y\fB)\fR
.sp
void
\fBTk_UnderlineChars(\fIdisplay, drawable, gc, tkfont, string, x, y, firstChar, lastChar\fB)\fR
.sp
.SH ARGUMENTS
.AS "const char" firstChar
.AP Tk_Font tkfont in
Token for font in which text is to be drawn or measured.  Must have been
returned by a previous call to \fBTk_GetFont\fR.
.AP "const char" *string in
Text to be measured or displayed.  Need not be null terminated.  Any
non-printing meta-characters in the string (such as tabs, newlines, and
other control characters) will be measured or displayed in a
platform-dependent manner.  

.AP int maxChars in
The maximum number of characters to consider when measuring \fIstring\fR.
Must be greater than or equal to 0.

.AP int maxPixels in
If \fImaxPixels\fR is greater than 0, it specifies the longest permissible
line length in pixels.  Characters from \fIstring\fR are processed only
until this many pixels have been covered.  If \fImaxPixels\fR is <= 0, then
the line length is unbounded and the \fIflags\fR argument is ignored.
.AP int flags in
Various flag bits OR-ed together: TK_PARTIAL_OK means include a character
as long as any part of it fits in the length given by \fImaxPixels\fR;
otherwise, a character must fit completely to be considered.
TK_WHOLE_WORDS means stop on a word boundary, if possible.  If
TK_AT_LEAST_ONE is set, it means return at least one character even if no
characters could fit in the length given by \fImaxPixels\fR.  If
TK_AT_LEAST_ONE is set and TK_WHOLE_WORDS is also set, it means that if
not even one word fits on the line, return the first few letters of the
word that did fit; if not even one letter of the word fit, then the first
letter will still be returned.
.AP int *lengthPtr out
Filled with the number of pixels occupied by the number of characters
returned as the result of \fBTk_MeasureChars\fR.
.AP int numChars in
The total number of characters to measure or draw from \fIstring\fR.  Must
be greater than or equal to 0.
.AP Display *display in
Display on which to draw.
.AP Drawable drawable in
Window or pixmap in which to draw.
.AP GC gc in
Graphics context for drawing characters.  The font selected into this GC 
must be the same as the \fItkfont\fR.
.AP int "x, y" in
Coordinates at which to place the left edge of the baseline when displaying
\fIstring\fR.  

.AP int firstChar in
The index of the first character to underline in the \fIstring\fR.  
Underlining begins at the left edge of this character.
.AP int lastChar in
The index of the last character up to which the underline will 
be drawn.  The character specified by \fIlastChar\fR will not itself be
underlined.

.BE

.SH DESCRIPTION
.PP
These routines are for measuring and displaying simple single-font,
single-line, strings.  To measure and display single-font, multi-line,
justified text, refer to the documentation for \fBTk_ComputeTextLayout\fR.
There is no programming interface in the core of Tk that supports
multi-font, multi-line text; support for that behavior must be built on
top of simpler layers.






.PP
A glyph is the displayable picture of a letter, number, or some other
symbol.  Not all character codes in a given font have a glyph.
Characters such as tabs, newlines/returns, and control characters that
have no glyph are measured and displayed by these procedures in a
platform-dependent manner; under X, they are replaced with backslashed
escape sequences, while under Windows and Macintosh hollow or solid boxes
may be substituted.  Refer to the documentation for
\fBTk_ComputeTextLayout\fR for a programming interface that supports the
platform-independent expansion of tab characters into columns and
newlines/returns into multi-line text.  
.PP
\fBTk_MeasureChars\fR is used both to compute the length of a given
string and to compute how many characters from a string fit in a given
amount of space.  The return value is the number of characters from
\fIstring\fR that fit in the space specified by \fImaxPixels\fR subject to
the conditions described by \fIflags\fR.  If all characters fit, the return
value will be \fImaxChars\fR.  \fI*lengthPtr\fR is filled with the computed
width, in pixels, of the portion of the string that was measured.  For
example, if the return value is 5, then \fI*lengthPtr\fR is filled with the
distance between the left edge of \fIstring\fR[0] and the right edge of
\fIstring\fR[4]. 
.PP
\fBTk_TextWidth\fR is a wrapper function that provides a simpler interface
to the \fBTk_MeasureChars\fR function.  The return value is how much






|


|








|


|


|


|











>
|
|
|
>



















<
<
<










>
|
|
|
|
|
|
|
>









|
>
>
>
>
>
>














|


|







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
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: MeasureChar.3,v 1.1.4.3 1999/03/30 04:12:54 stanton Exp $
'\" 
.so man.macros
.TH Tk_MeasureChars 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_MeasureChars, Tk_TextWidth, Tk_DrawChars, Tk_UnderlineChars \- routines to measure and display simple single-line strings.
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
int
\fBTk_MeasureChars(\fItkfont, string, numBytes, maxPixels, flags, lengthPtr\fB)\fR
.sp
int
\fBTk_TextWidth(\fItkfont, string, numBytes\fB)\fR
.sp
void
\fBTk_DrawChars(\fIdisplay, drawable, gc, tkfont, string, numBytes, x, y\fB)\fR
.sp
void
\fBTk_UnderlineChars(\fIdisplay, drawable, gc, tkfont, string, x, y, firstByte, lastByte\fB)\fR
.sp
.SH ARGUMENTS
.AS "const char" firstChar
.AP Tk_Font tkfont in
Token for font in which text is to be drawn or measured.  Must have been
returned by a previous call to \fBTk_GetFont\fR.
.AP "const char" *string in
Text to be measured or displayed.  Need not be null terminated.  Any
non-printing meta-characters in the string (such as tabs, newlines, and
other control characters) will be measured or displayed in a
platform-dependent manner.  
.VS 8.1
.AP int numBytes in
The maximum number of bytes to consider when measuring or drawing
\fIstring\fR.  Must be greater than or equal to 0.
.VE 8.1
.AP int maxPixels in
If \fImaxPixels\fR is greater than 0, it specifies the longest permissible
line length in pixels.  Characters from \fIstring\fR are processed only
until this many pixels have been covered.  If \fImaxPixels\fR is <= 0, then
the line length is unbounded and the \fIflags\fR argument is ignored.
.AP int flags in
Various flag bits OR-ed together: TK_PARTIAL_OK means include a character
as long as any part of it fits in the length given by \fImaxPixels\fR;
otherwise, a character must fit completely to be considered.
TK_WHOLE_WORDS means stop on a word boundary, if possible.  If
TK_AT_LEAST_ONE is set, it means return at least one character even if no
characters could fit in the length given by \fImaxPixels\fR.  If
TK_AT_LEAST_ONE is set and TK_WHOLE_WORDS is also set, it means that if
not even one word fits on the line, return the first few letters of the
word that did fit; if not even one letter of the word fit, then the first
letter will still be returned.
.AP int *lengthPtr out
Filled with the number of pixels occupied by the number of characters
returned as the result of \fBTk_MeasureChars\fR.



.AP Display *display in
Display on which to draw.
.AP Drawable drawable in
Window or pixmap in which to draw.
.AP GC gc in
Graphics context for drawing characters.  The font selected into this GC 
must be the same as the \fItkfont\fR.
.AP int "x, y" in
Coordinates at which to place the left edge of the baseline when displaying
\fIstring\fR.  
.VS 8.1
.AP int firstByte in
The index of the first byte of the first character to underline in the
\fIstring\fR.  Underlining begins at the left edge of this character.
.AP int lastByte in
The index of the first byte of the last character up to which the
underline will be drawn.  The character specified by \fIlastByte\fR
will not itself be underlined.
.VE 8.1
.BE

.SH DESCRIPTION
.PP
These routines are for measuring and displaying simple single-font,
single-line, strings.  To measure and display single-font, multi-line,
justified text, refer to the documentation for \fBTk_ComputeTextLayout\fR.
There is no programming interface in the core of Tk that supports
multi-font, multi-line text; support for that behavior must be built on
top of simpler layers.  
.VS 8.1
Note that the interfaces described here are
byte-oriented not character-oriented, so index values coming from Tcl
scripts need to be converted to byte offsets using the
\fBTcl_UtfAtIndex\fR and related routines.
.VE 8.1
.PP
A glyph is the displayable picture of a letter, number, or some other
symbol.  Not all character codes in a given font have a glyph.
Characters such as tabs, newlines/returns, and control characters that
have no glyph are measured and displayed by these procedures in a
platform-dependent manner; under X, they are replaced with backslashed
escape sequences, while under Windows and Macintosh hollow or solid boxes
may be substituted.  Refer to the documentation for
\fBTk_ComputeTextLayout\fR for a programming interface that supports the
platform-independent expansion of tab characters into columns and
newlines/returns into multi-line text.  
.PP
\fBTk_MeasureChars\fR is used both to compute the length of a given
string and to compute how many characters from a string fit in a given
amount of space.  The return value is the number of bytes from
\fIstring\fR that fit in the space specified by \fImaxPixels\fR subject to
the conditions described by \fIflags\fR.  If all characters fit, the return
value will be \fInumBytes\fR.  \fI*lengthPtr\fR is filled with the computed
width, in pixels, of the portion of the string that was measured.  For
example, if the return value is 5, then \fI*lengthPtr\fR is filled with the
distance between the left edge of \fIstring\fR[0] and the right edge of
\fIstring\fR[4]. 
.PP
\fBTk_TextWidth\fR is a wrapper function that provides a simpler interface
to the \fBTk_MeasureChars\fR function.  The return value is how much

Changes to doc/MoveToplev.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) MoveToplev.3 1.8 96/03/26 18:16:11
'\" 
.so man.macros
.TH Tk_MoveToplevelWindow 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_MoveToplevelWindow \- Adjust the position of a top-level window
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: MoveToplev.3,v 1.1.4.1 1998/09/30 02:16:04 stanton Exp $
'\" 
.so man.macros
.TH Tk_MoveToplevelWindow 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_MoveToplevelWindow \- Adjust the position of a top-level window
.SH SYNOPSIS

Changes to doc/Name.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) Name.3 1.14 97/01/29 08:50:09
'\" 
.so man.macros
.TH Tk_Name 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_Name, Tk_PathName, Tk_NameToWindow \- convert between names and window tokens
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: Name.3,v 1.1.4.1 1998/09/30 02:16:04 stanton Exp $
'\" 
.so man.macros
.TH Tk_Name 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_Name, Tk_PathName, Tk_NameToWindow \- convert between names and window tokens
.SH SYNOPSIS

Changes to doc/NameOfImg.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) NameOfImg.3 1.4 96/03/26 18:16:37
'\" 
.so man.macros
.TH Tk_NameOfImage 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_NameOfImage \- Return name of image.
.SH SYNOPSIS






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: NameOfImg.3,v 1.1.4.1 1998/09/30 02:16:04 stanton Exp $
'\" 
.so man.macros
.TH Tk_NameOfImage 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_NameOfImage \- Return name of image.
.SH SYNOPSIS

Changes to doc/OwnSelect.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) OwnSelect.3 1.16 96/08/27 13:21:31
'\" 
.so man.macros
.TH Tk_OwnSelection 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_OwnSelection \- make a window the owner of the primary selection
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: OwnSelect.3,v 1.1.4.1 1998/09/30 02:16:05 stanton Exp $
'\" 
.so man.macros
.TH Tk_OwnSelection 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_OwnSelection \- make a window the owner of the primary selection
.SH SYNOPSIS

Changes to doc/ParseArgv.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) ParseArgv.3 1.17 97/10/31 12:58:44
'\" 
.so man.macros
.TH Tk_ParseArgv 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ParseArgv \- process command-line options
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: ParseArgv.3,v 1.1.4.1 1998/09/30 02:16:05 stanton Exp $
'\" 
.so man.macros
.TH Tk_ParseArgv 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ParseArgv \- process command-line options
.SH SYNOPSIS

Changes to doc/QWinEvent.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) QWinEvent.3 1.4 96/03/26 18:17:16
'\" 
.so man.macros
.TH Tk_QueueWindowEvent 3 7.5 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_QueueWindowEvent \- Add a window event to the Tcl event queue
.SH SYNOPSIS






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: QWinEvent.3,v 1.1.4.1 1998/09/30 02:16:05 stanton Exp $
'\" 
.so man.macros
.TH Tk_QueueWindowEvent 3 7.5 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_QueueWindowEvent \- Add a window event to the Tcl event queue
.SH SYNOPSIS

Changes to doc/Restack.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) Restack.3 1.5 96/03/26 18:17:32
'\" 
.so man.macros
.TH Tk_RestackWindow 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_RestackWindow \- Change a window's position in the stacking order
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: Restack.3,v 1.1.4.1 1998/09/30 02:16:06 stanton Exp $
'\" 
.so man.macros
.TH Tk_RestackWindow 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_RestackWindow \- Change a window's position in the stacking order
.SH SYNOPSIS

Changes to doc/RestrictEv.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) RestrictEv.3 1.13 96/08/27 13:21:55
'\" 
.so man.macros
.TH Tk_RestrictEvents 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_RestrictEvents \- filter and selectively delay X events
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: RestrictEv.3,v 1.1.4.1 1998/09/30 02:16:06 stanton Exp $
'\" 
.so man.macros
.TH Tk_RestrictEvents 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_RestrictEvents \- filter and selectively delay X events
.SH SYNOPSIS

Changes to doc/SetAppName.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) SetAppName.3 1.13 97/06/10 17:33:48
'\" 
.so man.macros
.TH Tk_SetAppName 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_SetAppName \- Set the name of an application for ``send'' commands
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: SetAppName.3,v 1.1.4.1 1998/09/30 02:16:07 stanton Exp $
'\" 
.so man.macros
.TH Tk_SetAppName 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_SetAppName \- Set the name of an application for ``send'' commands
.SH SYNOPSIS

Changes to doc/SetClass.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) SetClass.3 1.12 96/03/26 18:18:10
'\" 
.so man.macros
.TH Tk_SetClass 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_SetClass, Tk_Class \- set or retrieve a window's class
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: SetClass.3,v 1.1.4.1 1998/09/30 02:16:07 stanton Exp $
'\" 
.so man.macros
.TH Tk_SetClass 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_SetClass, Tk_Class \- set or retrieve a window's class
.SH SYNOPSIS

Changes to doc/SetGrid.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) SetGrid.3 1.11 96/08/27 13:21:33
'\" 
.so man.macros
.TH Tk_SetGrid 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_SetGrid, Tk_UnsetGrid \- control the grid for interactive resizing
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: SetGrid.3,v 1.1.4.1 1998/09/30 02:16:07 stanton Exp $
'\" 
.so man.macros
.TH Tk_SetGrid 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_SetGrid, Tk_UnsetGrid \- control the grid for interactive resizing
.SH SYNOPSIS

Added doc/SetOptions.3.













































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
'\"
'\" Copyright (c) 1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: SetOptions.3,v 1.1.2.2 1998/09/30 02:16:08 stanton Exp $
'\" 
.so man.macros
.TH Tk_SetOptions 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreateOptionTable, Tk_DeleteOptionTable, Tk_InitOptions, Tk_SetOptions, Tk_FreeSavedOptions, Tk_RestoreSavedOptions, Tk_GetOptionValue,  Tk_GetOptionInfo, Tk_FreeConfigOptions, Tk_Offset \- process configuration options
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
Tk_OptionTable
\fBTk_CreateOptionTable(\fIinterp, templatePtr\fB)\fR
.sp
\fBTk_DeleteOptionTable(\fIoptionTable\fB)\fR
.sp
int
\fBTk_InitOptions(\fIinterp, recordPtr, optionTable, tkwin\fB)\fR
.sp
int
\fBTk_SetOptions(\fIinterp, recordPtr, optionTable, objc, objv, tkwin, savePtr, maskPtr\fB)\fR
.sp
\fBTk_FreeSavedOptions(\fIsavedPtr\fB)\fR
.sp
\fBTk_RestoreSavedOptions(\fIsavedPtr\fB)\fR
.sp
Tcl_Obj *
\fBTk_GetOptionValue(\fIinterp, recordPtr, optionTable, namePtr, tkwin\fB)\fR
.sp
Tcl_Obj *
\fBTk_GetOptionInfo(\fIinterp, recordPtr, optionTable, namePtr, tkwin\fB)\fR
.sp
\fBTk_FreeConfigOptions(\fIrecordPtr, optionTable, tkwin\fB)\fR
.sp
int
\fBTk_Offset(\fItype, field\fB)\fR
.SH ARGUMENTS
.AS Tk_SavedOptions "*CONST objv[]" in/out
.AP Tcl_Interp *interp in
A Tcl interpreter.  Most procedures use this only for returning error
messages; if it is NULL then no error messages are returned.  For
\fBTk_CreateOptionTable\fR the value cannot be NULL; it gives the
interpreter in which the option table will be used.
.AP Tk_OptionSpec *templatePtr in
Points to an array of static information that describes the configuration
options that are supported.  Used to build a Tk_OptionTable.  The information
pointed to by this argument must exist for the lifetime of the Tk_OptionTable.
.AP Tk_OptionTable optionTable in
Token for an option table.  Must have been returned by a previous call
to \fBTk_CreateOptionTable\fR.
.AP char *recordPtr in/out
Points to structure in which values of configuration options are stored;
fields of this record are modified by procedures such as \fBTk_SetOptions\fR
and read by procedures such as \fBTk_GetOptionValue\fR.
.AP Tk_Window tkwin in
For options such as TK_OPTION_COLOR, this argument indicates
the window in which the option will be used.  If \fIoptionTable\fR uses
no window-dependent options, then a NULL value may be supplied for
this argument.
.AP int objc in
Number of values in \fIobjv\fR.
.AP Tcl_Obj "*CONST objv[]" in
Command-line arguments for setting configuring options.
.AP Tk_SavedOptions *savePtr out
If not NULL, the structure pointed to by this argument is filled
in with the old values of any options that were modified and old
values are restored automatically if an error occurs in \fBTk_SetOptions\fR.
.AP int *maskPtr out
If not NULL, the word pointed to by \fImaskPtr\fR is filled in with the
bit-wise OR of the \fItypeMask\fR fields for the options that
were modified.
.AP Tk_SavedOptions *savedPtr in/out
Points to a structure previously filled in by \fBTk_SetOptions\fR with
old values of modified options.
.AP Tcl_Obj *namePtr in
The value of this object is the name of a particular option.  If NULL
is passed to \fBTk_GetOptionInfo\fR then information is returned for
all options.  Must not be NULL when \fBTk_GetOptionValue\fR is called.
.AP "type name" type in
The name of the type of a record.
.AP "field name" field in
The name of a field in records of type \fItype\fR.
.BE
.SH DESCRIPTION
.PP
These procedures handle most of the details of parsing configuration
options such as those for Tk widgets.  Given a description of what
options are supported, these procedures handle all the details of
parsing options and storing their values into a C structure associated
with the widget or object. The procedures were designed primarily for
widgets in Tk, but they can also be used for other kinds of objects that
have configuration options.  In the rest of this manual page ``widget'' will
be used to refer to the object whose options are being managed; in
practice the object may not actually be a widget.  The term ``widget
record'' is used to refer to the C-level structure in
which information about a particular widget or object is stored.
.PP
Note: the easiest way to learn how to use these procedures is to
look at a working example.  In Tk, the simplest example is the code
that implements the button family of widgets, which is an \fBtkButton.c\fR.
Other examples are in \fBtkSquare.c\fR and \fBtkMenu.c\fR.
.PP
In order to use these procedures, the code that implements the widget
must contain a static array of Tk_OptionSpec structures. This is a
template that describes the various options supported by that class of
widget; there is a separate template for each kind of widget.  The
template contains information such as the name of each option, its type,
its default value, and where the value of the option is stored in the
widget record.  See TEMPLATES below for more detail.
.PP
In order to process configuration options efficiently, the static
template must be augmented with additional information that is available
only at runtime.  The procedure \fBTk_CreateOptionTable\fR creates this
dynamic information from the template and returns a Tk_OptionTable token
that describes both the static and dynamic information.  All of the
other procedures, such as \fBTk_SetOptions\fR, take a Tk_OptionTable
token as argument.  Typically, \fBTk_CreateOptionTable\fR is called the
first time that a widget of a particular class is created and the
resulting Tk_OptionTable is used in the future for all widgets of that
class.  A Tk_OptionTable may be used only in a single interpreter, given
by the \fIinterp\fR argument to \fBTk_CreateOptionTable\fR.  When an
option table is no longer needed \fBTk_DeleteOptionTable\fR should be
called to free all of its resources.  All of the option tables
for a Tcl interpreter are freed automatically if the interpreter is deleted.
.PP
\fBTk_InitOptions\fR is invoked when a new widget is created to set
the default values for all of the widget's configuration options.
\fBTk_InitOptions\fR is passed a token for an option table (\fIoptionTable\fR)
and a pointer to a widget record (\fIrecordPtr\fR), which is the C
structure that holds information about this widget. \fBTk_InitOptions\fR
uses the information in the option table to
choose an appropriate default for each option, then it stores the default
value directly into the widget record, overwriting any information that
was already present in the widget record.  \fBTk_InitOptions\fR normally
returns TCL_OK.  If an error occurred while setting the default values
(e.g., because a default value was erroneous) then TCL_ERROR is returned
and an error message is left in \fIinterp\fR's result if \fIinterp\fR
isn't NULL.
.PP
\fBTk_SetOptions\fR is invoked to modify configuration options based
on information specified in a Tcl command.  The command might be one that
creates a new widget, or a command that modifies options on an existing
widget.  The \fIobjc\fR and \fIobjv\fR arguments describe the
values of the arguments from the Tcl command.  \fIObjv\fR must contain
an even number of objects: the first object of each pair gives the name of
an option and the second object gives the new value for that option.
\fBTk_SetOptions\fR looks up each name in \fIoptionTable\fR, checks that
the new value of the option conforms to the type in \fIoptionTable\fR,
and stores the value of the option into the widget record given by
\fIrecordPtr\fR.  \fBTk_SetOptions\fR normally returns TCL_OK.  If
an error occurred (such as an unknown option name or an illegal option
value) then TCL_ERROR is returned and an error message is left in
\fIinterp\fR's result if \fIinterp\fR isn't NULL.
.PP
\fBTk_SetOptions\fR has two additional features.  First, if the
\fImaskPtr\fR argument isn't NULL then it points to an integer
value that is filled in with information about the options that were
modified.  For each option in the template passed to
\fBTk_CreateOptionTable\fR there is a \fItypeMask\fR field.  The
bits of this field are defined by the code that implements the widget;
for example, each bit might correspond to a particular configuration option.
Alternatively, bits might be used functionally.  For example, one bit might
be used for redisplay: all options that affect the widget's display, such
that changing the option requires the widget to be redisplayed, might have
that bit set.  Another bit might indicate that the geometry of the widget
must be recomputed, and so on.  \fBTk_SetOptions\fR OR's together the
\fItypeMask\fR fields from all the options that were modified and returns
this value at *\fImaskPtr\fR; the caller can then use this information
to optimize itself so that, for example, it doesn't redisplay the widget
if the modified options don't affect the widget's appearance.
.PP
The second additional feature of \fBTk_SetOptions\fR has to do with error
recovery.  If an error occurs while processing configuration options, this
feature makes it possible to restore all the configuration options to their
previous values.  Errors can occur either while processing options in
\fBTk_SetOptions\fR or later in the caller.  In many cases the caller does
additional processing after \fBTk_SetOptions\fR returns; for example, it
might use an option value to set a trace on a variable and may detect
an error if the variable is an array instead of a scalar.  Error recovery
is enabled by passing in a non-NULL value for the \fIsavePtr\fR argument
to \fBTk_SetOptions\fR; this should be a pointer to an uninitialized
Tk_SavedOptions structure on the caller's stack.  \fBTk_SetOptions\fR
overwrites the structure pointed to by \fIsavePtr\fR with information
about the old values of any options modified by the procedure.
If \fBTk_SetOptions\fR returns successfully, the
caller uses the structure in one of two ways.  If the caller completes
its processing of the new options without any errors, then it must pass
the structure to \fBTk_FreeSavedOptions\fR so that the old values can be
freed.  If the caller detects an error in its processing of the new
options, then it should pass the structure to \fBTk_RestoreSavedOptions\fR,
which will copy the old values back into the widget record and free
the new values.
If \fBTk_SetOptions\fR detects an error then it automatically restores
any options that had already been modified and leaves *\fIsavePtr\fR in
an empty state: the caller need not call either \fBTk_FreeSavedOptions\fR or
\fBTk_RestoreSavedOptions\fR.
If the \fIsavePtr\fR argument to \fBTk_SetOptions\fR is NULL then
\fBTk_SetOptions\fR frees each old option value immediately when it sets a new
value for the option.  In this case, if an error occurs in the third
option, the old values for the first two options cannot be restored.
.PP
\fBTk_GetOptionValue\fR returns the current value of a configuration option
for a particular widget.  The \fInamePtr\fR argument contains the name of
an option; \fBTk_GetOptionValue\fR uses \fIoptionTable\fR
to lookup the option and extract its value from the widget record
pointed to by \fIrecordPtr\fR, then it returns an object containing
that value.  If an error occurs (e.g., because \fInamePtr\fR contains an
unknown option name) then NULL is returned and an error message is left
in \fIinterp\fR's result unless \fIinterp\fR is NULL.
.PP
\fBTk_GetOptionInfo\fR returns information about configuration options in
a form suitable for \fBconfigure\fR widget commands.  If the \fInamePtr\fR
argument is not NULL, it points to an object that gives the name of a
configuration option; \fBTk_GetOptionInfo\fR returns an object containing
a list with five elements, which are the name of the option, the name and
class used for the option in the option database, the default value for
the option, and the current value for the option.  If the \fInamePtr\fR
argument is NULL, then \fBTk_GetOptionInfo\fR returns information about
all options in the form of a list of lists; each sublist describes one
option.  Synonym options are handled differently depending on whether
\fInamePtr\fR is NULL: if \fInamePtr\fR is NULL then the sublist for
each synonym option has only two elements, which are the name of the
option and the name of the other option that it refers to; if \fInamePtr\fR
is non-NULL and names a synonym option then the object returned
is the five-element list
for the other option that the synonym refers to.  If an error occurs
(e.g., because \fInamePtr\fR contains an unknown option name) then NULL
is returned and an error message is left in \fIinterp\fR's result unless
\fIinterp\fR is NULL.
.PP
\fBTk_FreeConfigOptions\fR must be invoked when a widget is deleted.
It frees all of the resources associated with any of the configuration
options defined in \fIrecordPtr\fR by \fIoptionTable\fR.
.PP
The \fBTk_Offset\fR macro is provided as a safe way of generating the
\fIobjOffset\fR and \fIinternalOffset\fR values for entries in
Tk_OptionSpec structures.  It takes two arguments: the name of a type
of record, and the name of a field in that record. It returns the byte
offset of the named field in records of the given type.

.SH "TEMPLATES"
.PP
The array of Tk_OptionSpec structures passed to \fBTk_CreateOptionTable\fR
via its \fItemplatePtr\fR argument describes the configuration options
supported by a particular class of widgets.  Each structure specifies
one configuration option and has the following fields:
.CS
typedef struct {
	Tk_OptionType \fItype\fR;
	char *\fIoptionName\fR;
	char *\fIdbName\fR;
	char *\fIdbClass\fR;
	char *\fIdefValue\fR;
	int \fIobjOffset\fR;
	int \fIinternalOffset\fR;
	int \fIflags\fR;
	ClientData \fIclientData\fR;
	int \fItypeMask\fR;
} Tk_OptionSpec;
.CE
The \fItype\fR field indicates what kind of configuration option this is
(e.g. TK_OPTION_COLOR for a color value, or TK_OPTION_INT for
an integer value).  \fIType\fR determines how the
value of the option is parsed (more on this below).
The \fIoptionName\fR field is a string such as \fB\-font\fR or \fB\-bg\fR;
it is the name used for the option in Tcl commands and passed to
procedures via the \fIobjc\fR or \fInamePtr\fR arguments.
The \fIdbName\fR and \fIdbClass\fR fields are used by \fBTk_InitOptions\fR
to look up a default value for this option in the option database; if
\fIdbName\fR is NULL then the option database is not used by
\fBTk_InitOptions\fR for this option.  The \fIdefValue\fR field
specifies a default value for this configuration option if no
value is specified in the option database.  The \fIobjOffset\fR and
\fIinternalOffset\fR fields indicate where to store the value of this
option in widget records (more on this below); values for the \fIobjOffset\fR
and \fIinternalOffset\fR fields should always be generated with the
\fBTk_Offset\fR macro.
The \fIflags\fR field contains additional information
to control the processing of this configuration option (see below
for details).
\fIClientData\fR provides additional type-specific data needed
by certain types.  For instance, for TK_OPTION_COLOR types,
\fIclientData\fR is a string giving the default value to use on
monochrome displays.  See the descriptions of the different types
below for details.
The last field, \fItypeMask\fR, is used by \fBTk_SetOptions\fR to
return information about which options were modified; see the description
of \fBTk_SetOptions\fR above for details.
.PP
When \fBTk_InitOptions\fR and \fBTk_SetOptions\fR store the value of an
option into the widget record, they can do it in either of two ways.
If the \fIobjOffset\fR field of the Tk_OptionSpec is greater than
or equal to zero, then the value of the option is stored as a
(Tcl_Obj *) at the location in the widget record given by \fIobjOffset\fR.
If the \fIinternalOffset\fR field of the Tk_OptionSpec is
greater than or equal to zero, then the value of the option is stored
in a type-specific internal form at the location in the widget record
given by \fIinternalOffset\fR.  For example, if the option's type is
TK_OPTION_INT then the internal form is an integer.  If the
\fIobjOffset\fR or \fIinternalOffset\fR field is negative then the
value is not stored in that form.  At least one of the offsets must be
greater than or equal to zero.
.PP
The \fIflags\fR field consists of one or more bits ORed together.  At
present only a single flag is supported: TK_OPTION_NULL_OK.  If
this bit is set for an option then an empty string will be accepted as
the value for the option and the resulting internal form will be a
NULL pointer or \fBNone\fR, depending on the type of the option.
If the flag is not set then empty strings will result
in errors.
TK_OPTION_NULL_OK is typically used to allow a
feature to be turned off entirely, e.g. set a cursor value to
\fBNone\fR so that a window simply inherits its parent's cursor.
Not all option types support the TK_OPTION_NULL_OK
flag; for those that do, there is an explicit indication of that fact
in the descriptions below.
.PP
The \fItype\fR field of each Tk_OptionSpec structure determines
how to parse the value of that configuration option. The
legal value for \fItype\fR, and the corresponding actions, are
described below.  If the type requires a \fItkwin\fR value to be
passed into procedures like \fBTk_SetOptions\fR, or if it uses
the \fIclientData\fR field of the Tk_OptionSpec, then it is indicated
explicitly; if not mentioned, the type requires neither \fItkwin\fR
nor \fIclientData\fR.
.TP
\fBTK_OPTION_ANCHOR\fR
The value must be a standard anchor position such as \fBne\fR or
\fBcenter\fR.  The internal form is a Tk_Anchor value like the ones
returned by \fBTk_GetAnchorFromObj\fR.
.TP
\fBTK_OPTION_BITMAP\fR
The value must be a standard Tk bitmap name. The internal form is a
Pixmap token like the ones returned by \fBTk_AllocBitmapFromObj\fR.
This option type requires \fItkwin\fR to be supplied to procedures
such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag.
.TP
\fBTK_OPTION_BOOLEAN\fR
The value must be a standard boolean value such as \fBtrue\fR or
\fBno\fR.  The internal form is an integer with value 0 or 1.
.TP
\fBTK_OPTION_BORDER\fR
The value must be a standard color name such as \fBred\fR or \fB#ff8080\fR.
The internal form is a Tk_3DBorder token like the ones returned
by \fBTk_Alloc3DBorderFromObj\fR.
This option type requires \fItkwin\fR to be supplied to procedures
such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag.
.TP
\fBTK_OPTION_COLOR\fR
The value must be a standard color name such as \fBred\fR or \fB#ff8080\fR.
The internal form is an (XColor *) token like the ones returned by
\fBTk_AllocColorFromObj\fR.
This option type requires \fItkwin\fR to be supplied to procedures
such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag.
.TP
\fBTK_OPTION_CURSOR\fR
The value must be a standard cursor name such as \fBcross\fR or \fB@foo\fR.
The internal form is a Tk_Cursor token like the ones returned by
\fBTk_AllocCursorFromObj\fR.
This option type requires \fItkwin\fR to be supplied to procedures
such as \fBTk_SetOptions\fR, and when the option is set the cursor
for the window is changed by calling \fBXDefineCursor\fR.  This
option type also supports the TK_OPTION_NULL_OK flag.
.TP
\fBTK_OPTION_DOUBLE\fR
The string value must be a floating-point number in
the format accepted by \fBstrtol\fR.  The internal form is a C
\fBdouble\fR value.
.TP
\fBTK_OPTION_END\fR
Marks the end of the template.  There must be a Tk_OptionSpec structure
with \fItype\fR TK_OPTION_END at the end of each template.  If the
\fIclientData\fR field of this structure isn't NULL, then it points to
an additional array of Tk_OptionSpec's, which is itself terminated by
another TK_OPTION_END entry.  Templates may be chained arbitrarily
deeply.  This feature allows common options to be shared by several
widget classes.
.TP
\fBTK_OPTION_FONT\fR
The value must be a standard font name such as \fBTimes 16\fR.
The internal form is a Tk_Font handle like the ones returned by
\fBTk_AllocFontFromObj\fR.
This option type requires \fItkwin\fR to be supplied to procedures
such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag.
.TP
\fBTK_OPTION_INT\fR
The string value must be an integer in the format accepted by
\fBstrtol\fR (e.g. \fB0\fR and \fB0x\fR prefixes may be used to
specify octal or hexadecimal numbers, respectively).  The internal
form is a C \fBint\fR value.
.TP
\fBTK_OPTION_JUSTIFY\fR
The value must be a standard justification value such as \fBleft\fR.
The internal form is a Tk_Justify like the values returned by
\fBTk_GetJustifyFromObj\fR.
.TP
\fBTK_OPTION_PIXELS\fR
The value must specify a screen distance such as \fB2i\fR or \fB6.4\fR.
The internal form is an integer value giving a
distance in pixels, like the values returned by
\fBTk_GetPixelsFromObj\fR.  Note: if the \fIobjOffset\fR field isn't
used then information about the original value of this option will be lost.
See \fBOBJOFFSET VS. INTERNALOFFSET\fR below for details.
.TP
\fBTK_OPTION_RELIEF\fR
The value must be standard relief such as \fBraised\fR.
The internal form is an integer relief value such as
TK_RELIEF_RAISED.
.TP
\fBTK_OPTION_STRING\fR
The value may be any string.  The internal form is a (char *) pointer
that points to a dynamically allocated copy of the value.
This option type supports the TK_OPTION_NULL_OK flag.
.TP
\fBTK_OPTION_STRING_TABLE\fR
For this type, \fIclientData\fR is a pointer to an array of strings
suitable for passing to \fBTcl_GetIndexFromObj\fR.  The value must
be one of the strings in the table, or a unique abbreviation of
one of the strings.  The internal form is an integer giving the index
into the table of the matching string, like the return value
from \fBTcl_GetStringFromObj\fR. 
.TP
\fBTK_OPTION_SYNONYM\fR
This type is used to provide alternative names for an option (for
example, \fB\-bg\fR is often used as a synonym for \fB\-background\fR).
The \fBclientData\fR field is a (char *) pointer that gives
the name of another option in the same table.  Whenever the
synonym option is used, the information from the other option
will be used instead.
.TP
\fBTK_OPTION_WINDOW\fR
The value must be a window path name.  The internal form is a
\fBTk_Window\fR token for the window.
This option type requires \fItkwin\fR to be supplied to procedures
such as \fBTk_SetOptions\fR (in order to identify the application),
and it supports the TK_OPTION_NULL_OK flag.

.SH "STORAGE MANAGEMENT ISSUES"
.PP
If a field of a widget record has its offset stored in the \fIobjOffset\fR
or \fIinternalOffset\fR field of a Tk_OptionSpec structure then the
procedures described here will handle all of the storage allocation and
resource management issues associated with the field.  When the value
of an option is changed, \fBTk_SetOptions\fR (or \fBTk_FreeSavedOptions\fR
will automatically free any resources associated with the old value, such as
Tk_Fonts for TK_OPTION_FONT options or dynamically allocated memory for
TK_OPTION_STRING options.  For an option stored as an object using the
\fIobjOffset\fR field of a Tk_OptionSpec, the widget record shares the
object pointed to by the \fIobjv\fR value from the call to
\fBTk_SetOptions\fR.  The reference count for this object is incremented
when a pointer to it is stored in the widget record and decremented when
the option is modified.  When the widget is deleted
\fBTk_FreeConfigOptions\fR should be invoked; it will free the resources
associated with all options and decrement reference counts for any
objects.
.PP
However, the widget code is responsible for storing NULL or \fBNone\fR in
all pointer and token fields before invoking \fBTk_InitOptions\fR.
This is needed to allow proper cleanup in the rare case where
an error occurs in \fBTk_InitOptions\fR.

.SH "OBJOFFSET VS. INTERNALOFFSET"
.PP
In most cases it is simplest to use the \fIinternalOffset\fR field of
a Tk_OptionSpec structure and not the \fIobjOffset\fR field.  This
makes the internal form of the value immediately available to the
widget code so the value doesn't have to be extracted from an object
each time it is used.  However, there are two cases where the
\fIobjOffset\fR field is useful.  The first case is for
TK_OPTION_PIXELS options.  In this case, the internal form is
an integer pixel value that is valid only for a particular screen.
If the value of the option is retrieved, it will be returned as a simple
number.  For example, after the command \fB.b configure \-borderwidth 2m\fR,
the command \fB.b configure \-borderwidth\fR might return 7, which is the
integer pixel value corresponding to \fB2m\fR.  Unfortunately, this loses
the original screen-independent value.  Thus for TK_OPTION_PIXELS options
it is better to use the \fIobjOffset\fR field.  In this case the original
value of the option is retained in the object and can be returned when
the option is retrieved.  In most cases it is convenient to use the
\fIinternalOffset\fR field field as well, so that the integer value is
immediately available for use in the widget code (alternatively,
\fBTk_GetPixelsFromObj\fR can be used to extract the integer value from
the object whenever it is needed).  Note: the problem of losing information
on retrievals exists only for TK_OPTION_PIXELS options.
.PP
The second reason to use the \fIobjOffset\fR field is in order to
implement new types of options not supported by these procedures.
To implement a new type of option, use TK_OPTION_STRING as
the type in the Tk_OptionSpec structure and set the \fIobjOffset\fR field
but not the \fIinternalOffset\fR field.  Then, after calling
\fBTk_SetOptions\fR, convert the object to internal form yourself.

.SH KEYWORDS
anchor, bitmap, boolean, border, color, configuration option,
cursor, double, font, integer, justify,
pixels, relief, screen distance, synonym

Changes to doc/SetVisual.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) SetVisual.3 1.10 96/03/26 18:18:39
'\" 
.so man.macros
.TH Tk_SetWindowVisual 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_SetWindowVisual \- change visual characteristics of window
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: SetVisual.3,v 1.1.4.1 1998/09/30 02:16:08 stanton Exp $
'\" 
.so man.macros
.TH Tk_SetWindowVisual 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_SetWindowVisual \- change visual characteristics of window
.SH SYNOPSIS

Changes to doc/StrictMotif.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) StrictMotif.3 1.4 96/03/26 18:18:52
'\" 
.so man.macros
.TH Tk_StrictMotif 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_StrictMotif \- Return value of tk_strictMotif variable
.SH SYNOPSIS






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: StrictMotif.3,v 1.1.4.1 1998/09/30 02:16:08 stanton Exp $
'\" 
.so man.macros
.TH Tk_StrictMotif 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_StrictMotif \- Return value of tk_strictMotif variable
.SH SYNOPSIS

Changes to doc/TextLayout.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) TextLayout.3 1.6 96/12/16 16:48:12
'\" 
.so man.macros
.TH Tk_ComputeTextLayout 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ComputeTextLayout, Tk_FreeTextLayout, Tk_DrawTextLayout, Tk_UnderlineTextLayout, Tk_PointToChar, Tk_CharBbox, Tk_DistanceToTextLayout, Tk_IntersectTextLayout, Tk_TextLayoutToPostscript \- routines to measure and display single-font, multi-line, justified text.
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp






|


|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: TextLayout.3,v 1.1.4.2 1999/03/30 04:12:54 stanton Exp $
'\" 
.so man.macros
.TH Tk_ComputeTextLayout 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_ComputeTextLayout, Tk_FreeTextLayout, Tk_DrawTextLayout, Tk_UnderlineTextLayout, Tk_PointToChar, Tk_CharBbox, Tk_DistanceToTextLayout, Tk_IntersectTextLayout, Tk_TextLayoutToPostscript \- routines to measure and display single-font, multi-line, justified text.
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
51
52
53
54
55
56
57

58


59
60
61
62
63
64
65
.AP "const char" *string in
Potentially multi-line string whose dimensions are to be computed and
stored in the text layout.  The \fIstring\fR must remain valid for the
lifetime of the text layout.  
.AP int numChars in
The number of characters to consider from \fIstring\fR.  If
\fInumChars\fR is less than 0, then assumes \fIstring\fR is null

terminated and uses \fBstrlen(\fIstring\fB)\fR.


.AP int wrapLength in
Longest permissible line length, in pixels.  Lines in \fIstring\fR will
automatically be broken at word boundaries and wrapped when they reach
this length.  If \fIwrapLength\fR is too small for even a single
character to fit on a line, it will be expanded to allow one character to
fit on each line.  If \fIwrapLength\fR is <= 0, there is no automatic
wrapping; lines will get as long as they need to be and only wrap if a







>
|
>
>







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
.AP "const char" *string in
Potentially multi-line string whose dimensions are to be computed and
stored in the text layout.  The \fIstring\fR must remain valid for the
lifetime of the text layout.  
.AP int numChars in
The number of characters to consider from \fIstring\fR.  If
\fInumChars\fR is less than 0, then assumes \fIstring\fR is null
.VS 8.1
terminated and uses \fBTcl_NumUtfChars\fR to determine the length of
\fIstring\fR.
.VE
.AP int wrapLength in
Longest permissible line length, in pixels.  Lines in \fIstring\fR will
automatically be broken at word boundaries and wrapped when they reach
this length.  If \fIwrapLength\fR is too small for even a single
character to fit on a line, it will be expanded to allow one character to
fit on each line.  If \fIwrapLength\fR is <= 0, there is no automatic
wrapping; lines will get as long as they need to be and only wrap if a
129
130
131
132
133
134
135
136







137
138
139
140
141
142
143
.SH DESCRIPTION
.PP
These routines are for measuring and displaying single-font, multi-line,
justified text.  To measure and display simple single-font, single-line
strings, refer to the documentation for \fBTk_MeasureChars\fR.  There is
no programming interface in the core of Tk that supports multi-font,
multi-line text; support for that behavior must be built on top of
simpler layers.







.PP
The routines described here are built on top of the programming interface
described in the \fBTk_MeasureChars\fR documentation.  Tab characters and
newline/return characters may be treated specially by these procedures,
but all other characters are passed through to the lower level.
.PP
\fBTk_ComputeTextLayout\fR computes the layout information needed to







|
>
>
>
>
>
>
>







132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
.SH DESCRIPTION
.PP
These routines are for measuring and displaying single-font, multi-line,
justified text.  To measure and display simple single-font, single-line
strings, refer to the documentation for \fBTk_MeasureChars\fR.  There is
no programming interface in the core of Tk that supports multi-font,
multi-line text; support for that behavior must be built on top of
simpler layers.  
.VS 8.1
Note that unlike the lower level text display routines, the functions
described here all operate on character-oriented lengths and indices
rather than byte-oriented values.  See the description of
\fBTcl_UtfAtIndex\fR for more details on converting between character
and byte offsets.
.VE 8.1
.PP
The routines described here are built on top of the programming interface
described in the \fBTk_MeasureChars\fR documentation.  Tab characters and
newline/return characters may be treated specially by these procedures,
but all other characters are passed through to the lower level.
.PP
\fBTk_ComputeTextLayout\fR computes the layout information needed to

Changes to doc/Tk_Init.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) Tk_Init.3 1.3 96/03/26 18:19:08
'\" 
.so man.macros
.TH Tk_Init 3 4.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_Init \- add Tk to an interpreter and make a new Tk application.
.SH SYNOPSIS






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: Tk_Init.3,v 1.1.4.1 1998/09/30 02:16:09 stanton Exp $
'\" 
.so man.macros
.TH Tk_Init 3 4.1 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_Init \- add Tk to an interpreter and make a new Tk application.
.SH SYNOPSIS

Changes to doc/Tk_Main.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) Tk_Main.3 1.7 96/03/26 18:19:21
'\" 
.so man.macros
.TH Tk_Main 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_Main \- main program for Tk-based applications
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: Tk_Main.3,v 1.1.4.1 1998/09/30 02:16:10 stanton Exp $
'\" 
.so man.macros
.TH Tk_Main 3 4.0 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_Main \- main program for Tk-based applications
.SH SYNOPSIS

Changes to doc/WindowId.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) WindowId.3 1.16 97/01/29 08:50:10
'\" 
.so man.macros
.TH Tk_WindowId 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_WindowId, Tk_Parent, Tk_Display, Tk_DisplayName, Tk_ScreenNumber, Tk_Screen, Tk_X, Tk_Y, Tk_Width, Tk_Height, Tk_Changes, Tk_Attributes, Tk_IsMapped, Tk_IsTopLevel, Tk_ReqWidth, Tk_ReqHeight, Tk_InternalBorderWidth, Tk_Visual, Tk_Depth, Tk_Colormap  \- retrieve information from Tk's local data structure
.SH SYNOPSIS







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: WindowId.3,v 1.1.4.1 1998/09/30 02:16:10 stanton Exp $
'\" 
.so man.macros
.TH Tk_WindowId 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_WindowId, Tk_Parent, Tk_Display, Tk_DisplayName, Tk_ScreenNumber, Tk_Screen, Tk_X, Tk_Y, Tk_Width, Tk_Height, Tk_Changes, Tk_Attributes, Tk_IsMapped, Tk_IsTopLevel, Tk_ReqWidth, Tk_ReqHeight, Tk_InternalBorderWidth, Tk_Visual, Tk_Depth, Tk_Colormap  \- retrieve information from Tk's local data structure
.SH SYNOPSIS

Changes to doc/bell.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) bell.n 1.8 96/03/26 18:19:55
'\" 
.so man.macros
.TH bell n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
bell \- Ring a display's bell







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: bell.n,v 1.1.4.1 1998/09/30 02:16:10 stanton Exp $
'\" 
.so man.macros
.TH bell n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
bell \- Ring a display's bell

Changes to doc/bind.n.

1
2
3

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.

'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) bind.n 1.41 96/10/03 18:27:05
'\" 
.so man.macros
.TH bind n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
bind \- Arrange for X events to invoke Tcl scripts
.SH SYNOPSIS
\fBbind\fI tag\fR
.sp



>




|


|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 1998 by Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: bind.n,v 1.1.4.2 1998/11/25 21:16:29 stanton Exp $
'\" 
.so man.macros
.TH bind n 8.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
bind \- Arrange for X events to invoke Tcl scripts
.SH SYNOPSIS
\fBbind\fI tag\fR
.sp
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
For example, \fB<Double-Button-1>\fR
is equivalent to \fB<Button-1><Button-1>\fR with the extra
time and space requirement.

.SH "EVENT TYPES"
.PP
The \fItype\fR field may be any of the standard X event types, with a


few extra abbreviations.  Below is a list of all the valid types;
where two names appear together, they are synonyms.
.DS C
.ta 5c 10c

\fBButtonPress, Button	Expose	Map

ButtonRelease	FocusIn	Motion

Circulate	FocusOut	Property	
Colormap	Gravity	Reparent
Configure	KeyPress, Key	Unmap
Destroy	KeyRelease	Visibility










Enter	Leave	Activate
Deactivate\fR
























.DE
.PP
The last part of a long event specification is \fIdetail\fR.  In the
case of a \fBButtonPress\fR or \fBButtonRelease\fR event, it is the
number of a button (1-5).  If a button number is given, then only an
event on that particular button will match;  if no button number is
given, then an event on any button will match.  Note:  giving a
specific button number is different than specifying a button modifier;







>
>
|
|


>
|
>
|
>
|


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







155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
For example, \fB<Double-Button-1>\fR
is equivalent to \fB<Button-1><Button-1>\fR with the extra
time and space requirement.

.SH "EVENT TYPES"
.PP
The \fItype\fR field may be any of the standard X event types, with a
few extra abbreviations.  The \fItype\fR field will also accept a
couple non-standard X event types that were added to better support
the Macintosh and Windows platforms.  Below is a list of all the valid
types; where two names appear together, they are synonyms.
.DS C
.ta 5c 10c
\fBActivate	Enter	Map
ButtonPress, Button	Expose	Motion
.VS
ButtonRelease	FocusIn	MouseWheel	
.VE
Circulate	FocusOut	Property
Colormap	Gravity	Reparent
Configure	KeyPress, Key	Unmap
Deactivate	KeyRelease	Visibility
Destroy	Leave\fR
.DE
.PP
.VS
Most of the above events have the same fields and behaviors as events
in the X Windowing system.  You can find more detailed descriptions of
these events in any X window programming book.  A couple of the events
are extensions to the X event system to support features unique to the
Macintosh and Windows platforms.  We provide a little more detail on
these events here.  These include:
.IP \fBActivate\fR 5
.IP \fBDeactivate\fR 5
These two events are sent to every sub-window of a toplevel when they
change state.  In addition to the focus Window, the Macintosh platform
and Windows platforms have a notion of an active window (which often
has but is not required to have the focus).  On the Macintosh, widgets
in the active window have a different appearance than widgets in
deactive windows.  The \fBActivate\fR event is sent to all the
sub-windows in a toplevel when it changes from being deactive to
active.  Likewise, the \fBDeactive\fR event is sent when the window's
state changes from active to deactive.  There are no useful percent
substitutions you would make when binding to these events.
.IP \fBMouseWheel\fR 5
Some mice on the Windows platform support a mouse wheel which is used
for scrolling documents without using the scrollbars.  By rolling the
wheel, the system will generate \fBMouseWheel\fR events that the
application can use to scroll.  Like \fBKey\fR events the event is
always routed to the window that currently has focus. When the event
is received you can use the \fB%D\fR substitution to get the
\fIdelta\fR field for the event which is a integer value of motion
that the mouse wheel has moved.  The smallest value for which the
system will report is defined by the OS.  On Windows 95 & 98 machines
this value is at least 120 before it is reported.  However, higher
resolution devices may be available in the future.  The sign of the
value determines which direction your widget should scroll.  Positive
values should scroll up and negative values should scroll down.
.VE
.PP
The last part of a long event specification is \fIdetail\fR.  In the
case of a \fBButtonPress\fR or \fBButtonRelease\fR event, it is the
number of a button (1-5).  If a button number is given, then only an
event on that particular button will match;  if no button number is
given, then an event on any button will match.  Note:  giving a
specific button number is different than specifying a button modifier;
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
For events other than these, the substituted string is undefined.
.RE
.IP \fB%f\fR 5
The \fIfocus\fR field from the event (\fB0\fR or \fB1\fR).  Valid only
for \fBEnter\fR and \fBLeave\fR events.
.IP \fB%h\fR 5
.VS
The \fIheight\fR field from the event.  Valid only for \fBConfigure\fR and
\fBExpose\fR events.
.VE
.IP \fB%k\fR 5
The \fIkeycode\fR field from the event.  Valid only for \fBKeyPress\fR
and \fBKeyRelease\fR events.
.IP \fB%m\fR 5
The \fImode\fR field from the event.  The substituted string is one of







|







294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
For events other than these, the substituted string is undefined.
.RE
.IP \fB%f\fR 5
The \fIfocus\fR field from the event (\fB0\fR or \fB1\fR).  Valid only
for \fBEnter\fR and \fBLeave\fR events.
.IP \fB%h\fR 5
.VS
The \fIheight\fR field from the event.  Valid for the \fBConfigure\fR and
\fBExpose\fR events.
.VE
.IP \fB%k\fR 5
The \fIkeycode\fR field from the event.  Valid only for \fBKeyPress\fR
and \fBKeyRelease\fR events.
.IP \fB%m\fR 5
The \fImode\fR field from the event.  The substituted string is one of
304
305
306
307
308
309
310









311
312
313
314
315
316
317
the empty string if the event doesn't correspond to an ASCII character
(e.g. the shift key was pressed).  \fBXLookupString\fR does all the
work of translating from the event to an ASCII character.
Valid only for \fBKeyPress\fR and \fBKeyRelease\fR events.
.IP \fB%B\fR 5
The \fIborder_width\fR field from the event.  Valid only for
\fBConfigure\fR events.









.IP \fB%E\fR 5
The \fIsend_event\fR field from the event.  Valid for all event types.
.IP \fB%K\fR 5
The keysym corresponding to the event, substituted as a textual
string.  Valid only for \fBKeyPress\fR and \fBKeyRelease\fR events.
.IP \fB%N\fR 5
The keysym corresponding to the event, substituted as a decimal







>
>
>
>
>
>
>
>
>







344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
the empty string if the event doesn't correspond to an ASCII character
(e.g. the shift key was pressed).  \fBXLookupString\fR does all the
work of translating from the event to an ASCII character.
Valid only for \fBKeyPress\fR and \fBKeyRelease\fR events.
.IP \fB%B\fR 5
The \fIborder_width\fR field from the event.  Valid only for
\fBConfigure\fR events.
.VS
.IP \fB%D\fR 5
This reports the \fIdelta\fR value of a \fBMouseWheel\fR event.  The
\fIdelta\fR value represents the rotation units the mouse wheel has
been moved.  On Windows 95 & 98 systems the smallest value for the
delta is 120.  Future systems may support higher resolution values for
the delta.  The sign of the value represents the direction the mouse
wheel was scrolled.
.VE
.IP \fB%E\fR 5
The \fIsend_event\fR field from the event.  Valid for all event types.
.IP \fB%K\fR 5
The keysym corresponding to the event, substituted as a textual
string.  Valid only for \fBKeyPress\fR and \fBKeyRelease\fR events.
.IP \fB%N\fR 5
The keysym corresponding to the event, substituted as a decimal

Changes to doc/bindtags.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) bindtags.n 1.9 96/11/30 14:54:49
'\" 
.so man.macros
.TH bindtags n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
bindtags \- Determine which bindings apply to a window, and order of evaluation







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: bindtags.n,v 1.1.4.1 1998/09/30 02:16:11 stanton Exp $
'\" 
.so man.macros
.TH bindtags n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
bindtags \- Determine which bindings apply to a window, and order of evaluation

Changes to doc/bitmap.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) bitmap.n 1.10 96/03/29 14:48:41
'\" 
.so man.macros
.TH bitmap n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
bitmap \- Images that display two colors







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: bitmap.n,v 1.1.4.1 1998/09/30 02:16:11 stanton Exp $
'\" 
.so man.macros
.TH bitmap n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
bitmap \- Images that display two colors

Changes to doc/button.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) button.n 1.40 97/10/31 12:58:48
'\" 
.so man.macros
.TH button n 4.4 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
button \- Create and manipulate button widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: button.n,v 1.1.4.1 1998/09/30 02:16:12 stanton Exp $
'\" 
.so man.macros
.TH button n 4.4 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
button \- Create and manipulate button widgets

Changes to doc/canvas.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) canvas.n 1.58 97/10/31 12:58:45
'\"
.so man.macros
.TH canvas n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
canvas \- Create and manipulate canvas widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: canvas.n,v 1.1.4.2 1998/11/25 21:16:29 stanton Exp $
'\"
.so man.macros
.TH canvas n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
canvas \- Create and manipulate canvas widgets
1442
1443
1444
1445
1446
1447
1448

1449
1450
1451
1452
1453
1454
1455
the top center point of the rectangular region occupied by the
text will be at the positioning point.
This option defaults to \fBcenter\fR.
.TP
\fB\-fill \fIcolor\fR
\fIColor\fR specifies a color to use for filling the text characters;
it may have any of the forms accepted by \fBTk_GetColor\fR.

If this option isn't specified then it defaults to \fBblack\fR.
.TP
\fB\-font \fIfontName\fR
Specifies the font to use for the text item.
\fIFontName\fR may be any string acceptable to \fBTk_GetFontStruct\fR.
If this option isn't specified, it defaults to a system-dependent
font.







>







1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
the top center point of the rectangular region occupied by the
text will be at the positioning point.
This option defaults to \fBcenter\fR.
.TP
\fB\-fill \fIcolor\fR
\fIColor\fR specifies a color to use for filling the text characters;
it may have any of the forms accepted by \fBTk_GetColor\fR.
If \fIcolor\fR is an empty string then the text will be transparent.
If this option isn't specified then it defaults to \fBblack\fR.
.TP
\fB\-font \fIfontName\fR
Specifies the font to use for the text item.
\fIFontName\fR may be any string acceptable to \fBTk_GetFontStruct\fR.
If this option isn't specified, it defaults to a system-dependent
font.

Changes to doc/checkbutton.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) checkbutton.n 1.40 96/11/20 12:51:21
'\" 
.so man.macros
.TH checkbutton n 4.4 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
checkbutton \- Create and manipulate checkbutton widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: checkbutton.n,v 1.1.4.1 1998/09/30 02:16:13 stanton Exp $
'\" 
.so man.macros
.TH checkbutton n 4.4 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
checkbutton \- Create and manipulate checkbutton widgets

Changes to doc/chooseColor.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) chooseColor.n 1.4 96/09/19 17:01:44
'\" 
.so man.macros
.TH tk_chooseColor n 4.2 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_chooseColor \- pops up a dialog box for the user to select a color.






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: chooseColor.n,v 1.1.4.1 1998/09/30 02:16:13 stanton Exp $
'\" 
.so man.macros
.TH tk_chooseColor n 4.2 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_chooseColor \- pops up a dialog box for the user to select a color.

Changes to doc/clipboard.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) clipboard.n 1.9 96/03/26 18:21:12
'\" 
.so man.macros
.TH clipboard n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
clipboard \- Manipulate Tk clipboard







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: clipboard.n,v 1.1.4.1 1998/09/30 02:16:14 stanton Exp $
'\" 
.so man.macros
.TH clipboard n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
clipboard \- Manipulate Tk clipboard

Changes to doc/destroy.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) destroy.n 1.14 96/12/12 17:54:59
'\" 
.so man.macros
.TH destroy n "" Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
destroy \- Destroy one or more windows







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: destroy.n,v 1.1.4.1 1998/09/30 02:16:15 stanton Exp $
'\" 
.so man.macros
.TH destroy n "" Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
destroy \- Destroy one or more windows

Changes to doc/dialog.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) dialog.n 1.9 96/09/06 09:20:58
'\" 
.so man.macros
.TH tk_dialog n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_dialog \- Create modal dialog and wait for response







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: dialog.n,v 1.1.4.1 1998/09/30 02:16:15 stanton Exp $
'\" 
.so man.macros
.TH tk_dialog n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_dialog \- Create modal dialog and wait for response

Changes to doc/entry.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) entry.n 1.41 97/10/31 12:58:44
'\" 
.so man.macros
.TH entry n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
entry \- Create and manipulate entry widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: entry.n,v 1.1.4.1 1998/09/30 02:16:16 stanton Exp $
'\" 
.so man.macros
.TH entry n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
entry \- Create and manipulate entry widgets

Changes to doc/event.n.

1
2

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.

'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) event.n 1.6 97/10/31 12:58:54
'\" 
.so man.macros
.TH event n 4.4 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
event \- Miscellaneous event facilities: define virtual events and generate events
.SH SYNOPSIS
\fBevent\fI option \fR?\fIarg arg ...\fR?
.BE


>




|


|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\" Copyright (c) 1998 by Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: event.n,v 1.1.4.2 1998/11/25 21:16:29 stanton Exp $
'\" 
.so man.macros
.TH event n 8.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
event \- Miscellaneous event facilities: define virtual events and generate events
.SH SYNOPSIS
\fBevent\fI option \fR?\fIarg arg ...\fR?
.BE
100
101
102
103
104
105
106













107
108
109
110
111
112
113
any button  number provided in the base \fIevent\fR argument.
Corresponds to the \fB%b\fR substitution for binding scripts.
.TP
\fB\-count\fI number\fR
\fINumber\fR must be an integer;  it specifies the \fIcount\fR field
for the event.  Valid for \fBExpose\fR events.
Corresponds to the \fB%c\fR substitution for binding scripts.













.TP
\fB\-detail\fI detail\fR
\fIDetail\fR specifies the \fIdetail\fR field for the event
and must be one of the following:
.RS
.DS
.ta 6c







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







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
any button  number provided in the base \fIevent\fR argument.
Corresponds to the \fB%b\fR substitution for binding scripts.
.TP
\fB\-count\fI number\fR
\fINumber\fR must be an integer;  it specifies the \fIcount\fR field
for the event.  Valid for \fBExpose\fR events.
Corresponds to the \fB%c\fR substitution for binding scripts.
.TP
\fB\-delta\fI number\fR
.VS
\fINumber\fR must be an integer;  it specifies the \fIdelta\fR field
for the \fBMouseWheel\fR event.  The \fIdelta\fR refers to the
direction and magnitude the mouse wheel was rotated.  Note the value
is not a screen distance but are units of motion in the mouse wheel.
Typically these values are multiples of 120.  For example, 120 should
scroll the text widget up 4 lines and -240 would scroll the text
widget down 8 lines.  Of course, other widgets may define different
behaviors for mouse wheel motion.  This field corresponds to the
\fB%D\fR substitution for binding scripts.
.VE
.TP
\fB\-detail\fI detail\fR
\fIDetail\fR specifies the \fIdetail\fR field for the event
and must be one of the following:
.RS
.DS
.ta 6c

Changes to doc/focus.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) focus.n 1.22 96/08/27 13:21:42
'\" 
.so man.macros
.TH focus n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
focus \- Manage the input focus







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: focus.n,v 1.1.4.1 1998/09/30 02:16:17 stanton Exp $
'\" 
.so man.macros
.TH focus n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
focus \- Manage the input focus

Changes to doc/focusNext.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) focusNext.n 1.10 96/03/26 18:22:23
'\" 
.so man.macros
.TH tk_focusNext n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_focusNext, tk_focusPrev, tk_focusFollowsMouse \- Utility procedures for managing the input focus.







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: focusNext.n,v 1.1.4.1 1998/09/30 02:16:17 stanton Exp $
'\" 
.so man.macros
.TH tk_focusNext n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_focusNext, tk_focusPrev, tk_focusFollowsMouse \- Utility procedures for managing the input focus.

Changes to doc/font.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) font.n 1.10 97/08/22 18:52:18
'\" 
.so man.macros
.TH font n 8.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
font \- Create and inspect fonts.






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: font.n,v 1.1.4.1 1998/09/30 02:16:18 stanton Exp $
'\" 
.so man.macros
.TH font n 8.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
font \- Create and inspect fonts.

Changes to doc/frame.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\"
'\" SCCS: @(#) frame.n 1.30 97/10/31 12:58:48
'\" 
.so man.macros
.TH frame n 8.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
frame \- Create and manipulate frame widgets








|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\"
'\" RCS: @(#) $Id: frame.n,v 1.1.4.1 1998/09/30 02:16:18 stanton Exp $
'\" 
.so man.macros
.TH frame n 8.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
frame \- Create and manipulate frame widgets

Changes to doc/getOpenFile.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) getOpenFile.n 1.8 96/12/08 21:14:31
'\" 
.so man.macros
.TH tk_getOpenFile n 4.2 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_getOpenFile, tk_getSaveFile \- pop up a dialog box for the user to select a file to open or save.






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: getOpenFile.n,v 1.1.4.1 1998/09/30 02:16:18 stanton Exp $
'\" 
.so man.macros
.TH tk_getOpenFile n 4.2 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_getOpenFile, tk_getSaveFile \- pop up a dialog box for the user to select a file to open or save.
55
56
57
58
59
60
61
62


63
64
65
66
67
68
69
70
71
72
particular platform then all files are listed regardless of their
types. See the section SPECIFYING FILE PATTERNS below for a
discussion on the contents of \fIfilePatternList\fR.
.TP
\fB\-initialdir\fR \fIdirectory\fR
Specifies that the files in \fIdirectory\fR should be displayed
when the dialog pops up. If this parameter is not specified, then
the files in the current working directory are displayed.  This


option may not always work on the Macintosh.  This is not a bug.
Rather, the \fIGeneral Controls\fR control panel on the Mac allows the
end user to override the application default directory.
.TP
\fB\-initialfile\fR \fIfilename\fR
Specifies a filename to be displayed in the dialog when it pops
up. This option is ignored by the \fBtk_getOpenFile\fR command.
.TP
\fB\-parent\fR \fIwindow\fR
Makes \fIwindow\fR the logical parent of the file dialog. The file







|
>
>
|
|
|







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
particular platform then all files are listed regardless of their
types. See the section SPECIFYING FILE PATTERNS below for a
discussion on the contents of \fIfilePatternList\fR.
.TP
\fB\-initialdir\fR \fIdirectory\fR
Specifies that the files in \fIdirectory\fR should be displayed
when the dialog pops up. If this parameter is not specified, then
the files in the current working directory are displayed. If the
parameter specifies a relative path, the return value will convert the
relative path to an absolute path.  This option may not always work on
the Macintosh.  This is not a bug. Rather, the \fIGeneral Controls\fR
control panel on the Mac allows the end user to override the
application default directory.
.TP
\fB\-initialfile\fR \fIfilename\fR
Specifies a filename to be displayed in the dialog when it pops
up. This option is ignored by the \fBtk_getOpenFile\fR command.
.TP
\fB\-parent\fR \fIwindow\fR
Makes \fIwindow\fR the logical parent of the file dialog. The file

Changes to doc/grab.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) grab.n 1.15 96/03/26 18:22:48
'\" 
.so man.macros
.TH grab n "" Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
grab \- Confine pointer and keyboard events to a window sub-tree







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: grab.n,v 1.1.4.1 1998/09/30 02:16:19 stanton Exp $
'\" 
.so man.macros
.TH grab n "" Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
grab \- Confine pointer and keyboard events to a window sub-tree

Changes to doc/grid.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) grid.n 1.15 96/12/13 16:46:35
'\" 
.so man.macros
.TH grid n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
grid \- Geometry manager that arranges widgets in a grid






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: grid.n,v 1.1.4.1 1998/09/30 02:16:19 stanton Exp $
'\" 
.so man.macros
.TH grid n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
grid \- Geometry manager that arranges widgets in a grid

Changes to doc/image.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) image.n 1.10 96/03/26 18:23:05
'\" 
.so man.macros
.TH image n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
image \- Create and manipulate images







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: image.n,v 1.1.4.1 1998/09/30 02:16:20 stanton Exp $
'\" 
.so man.macros
.TH image n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
image \- Create and manipulate images

Changes to doc/label.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) label.n 1.30 97/10/31 12:58:49
'\" 
.so man.macros
.TH label n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
label \- Create and manipulate label widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: label.n,v 1.1.4.1 1998/09/30 02:16:20 stanton Exp $
'\" 
.so man.macros
.TH label n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
label \- Create and manipulate label widgets

Changes to doc/listbox.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) listbox.n 1.38 97/10/31 12:58:47
'\" 
.so man.macros
.TH listbox n 8.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
listbox \- Create and manipulate listbox widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: listbox.n,v 1.1.4.1 1998/09/30 02:16:20 stanton Exp $
'\" 
.so man.macros
.TH listbox n 8.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
listbox \- Create and manipulate listbox widgets

Changes to doc/loadTk.n.

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
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) loadTk.n 1.5 97/08/18 17:44:43
'\" 
.so man.macros
.TH "Safe Tk" n 8.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
loadTk \- Load Tk into a safe interpreter.
.SH SYNOPSIS
\fB::safe::loadTk \fIslave\fR ?\fB\-use\fR \fIwindowId\fR?
.BE

Safe Tk is based on Safe Tcl, which provides a mechanism 
that allows restricted and mediated
access to auto-loading and packages for safe interpreters.
Safe Tk adds the ability to configure the interpreter
for safe Tk operations and load Tk into safe 
interpreters.

.SH DESCRIPTION
.PP
The \fB::safe::loadTk\fR command initializes the required data structures
in the named safe interpreter and then loads Tk into it.
The command returns the name of the safe interpreter.
If \fB\-use\fR is specified, the window identified by the specified system
dependent identifier \fIwindowId\fR is used to contain the \fB``.''\fR
window of the safe interpreter; it can be any valid id, eventually 
referencing a window belonging to another application.




Otherwise, a new toplevel window is created for the \fB``.''\fR window of
the safe interpreter.


See the \fBSECURITY ISSUES\fR section below for implementation details.

.SH SECURITY ISSUES
.PP
Please read the \fBsafe\fR manual page for Tcl to learn about the basic
security considerations for Safe Tcl.
.PP
Information in the safe interpreter should never be trusted for security
purposes.
However, because Tk initialization of the safe interpreter do use 
local information, it is unsafe if the safe interpreter 
could have gained control before Tk is loaded.
This will be fixed in an upcoming release, by making Tk initialization in a
safe interpreter use only information found in the interpreter's master
instead of relying on the (un)safe interpreter state.
.PP
You should therefore use \fBsafe::loadTk $slave\fR as soon as possible
after \fBsafe::interpCreate\fR and before any code is evaluated in the safe
interpreter.
The preferred sequence is:
.CS
set slave [::safe::loadTk [::safe::interpCreate]]
.CE
If you want to prevent safe interpreters from loading Tk entirely, you
should create the interpreter as follows:
.CS
::safe::interpCreate \-nostatics \-accesspath \fI{directories...}\fR
.CE
and you must also insure that the virtual access path \fIdirectories\fR for
the interpreter does not contain a dynamically loadable version of Tk.
.PP

\fB::safe::loadTk\fR adds the value of \fBtk_library\fR taken from the master
interpreter to the virtual access path of the safe interpreter so that
auto-loading will work in the safe interpreter.
It also sets \fBenv(DISPLAY)\fR in the safe interpreter to the value of
\fBenv(DISPLAY)\fR in the master interpreter, if it exists.
Finally, it sets the slave's Tcl variable \fBargv\fR to \fB\-use\fR 
\fIwindowId\fR in the safe interpreter.

When \fB\-use\fR is not used, the new toplevel created is specially
decorated so the user is always aware that the user interface presented comes
from a potentially unsafe code and can easily delete the corresponding
interpreter.




.SH "SEE ALSO"
safe(n), interp(n), library(n), load(n), package(n), source(n), unknown(n)
 
.SH KEYWORDS
alias, auto\-loading, auto_mkindex, load, master interpreter, safe
interpreter, slave interpreter, source






|








|

















|
>
>
>
>
|
|
>
>







|
<
|
|
<
<
<
<

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

>
|
<
|
|
|
|
|
|




>
>
>







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
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: loadTk.n,v 1.1.4.2 1998/09/30 02:16:21 stanton Exp $
'\" 
.so man.macros
.TH "Safe Tk" n 8.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
loadTk \- Load Tk into a safe interpreter.
.SH SYNOPSIS
\fB::safe::loadTk \fIslave\fR ?\fB\-use\fR \fIwindowId\fR? ?\fB\-display\fR \fIdisplayName\fR? 
.BE

Safe Tk is based on Safe Tcl, which provides a mechanism 
that allows restricted and mediated
access to auto-loading and packages for safe interpreters.
Safe Tk adds the ability to configure the interpreter
for safe Tk operations and load Tk into safe 
interpreters.

.SH DESCRIPTION
.PP
The \fB::safe::loadTk\fR command initializes the required data structures
in the named safe interpreter and then loads Tk into it.
The command returns the name of the safe interpreter.
If \fB\-use\fR is specified, the window identified by the specified system
dependent identifier \fIwindowId\fR is used to contain the \fB``.''\fR
window of the safe interpreter; it can be any valid id, eventually 
referencing a window belonging to another application. As a convenience,
if the window you plan to use is a Tk Window of the application you
can use the window name (eg: \fB.x.y\fR) instead of its window Id 
(\fB[winfo id .x.y]\fR).
When \fB\-use\fR is not specified,
a new toplevel window is created for the \fB``.''\fR window of
the safe interpreter. On X11 if you want the embedded window
to use another display than the default one, specify it with
\fB\-display\fR.
See the \fBSECURITY ISSUES\fR section below for implementation details.

.SH SECURITY ISSUES
.PP
Please read the \fBsafe\fR manual page for Tcl to learn about the basic
security considerations for Safe Tcl.
.PP
\fB::safe::loadTk\fR adds the value of \fBtk_library\fR taken from the master

interpreter to the virtual access path of the safe interpreter so that
auto-loading will work in the safe interpreter.




.PP














.PP
Tk initialization is now safe with respect to not trusting
the slave's state for startup. \fB::safe::loadTk\fR

registers the slave's name so
when the Tk initialization (\fBTk_SafeInit\fR) is called
and in turn calls the master's \fB::safe::InitTk\fR it will
return the desired \fBargv\fR equivalent (\fB\-use\fR 
\fIwindowId\fR, correct \fB\-display\fR, etc...).
.PP
When \fB\-use\fR is not used, the new toplevel created is specially
decorated so the user is always aware that the user interface presented comes
from a potentially unsafe code and can easily delete the corresponding
interpreter.
.PP
On X11, conflicting \fB\-use\fR and \fB\-display\fR are likely
to generate a fatal X error.

.SH "SEE ALSO"
safe(n), interp(n), library(n), load(n), package(n), source(n), unknown(n)
 
.SH KEYWORDS
alias, auto\-loading, auto_mkindex, load, master interpreter, safe
interpreter, slave interpreter, source

Changes to doc/lower.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) lower.n 1.9 96/06/14 14:19:56
'\" 
.so man.macros
.TH lower n 3.3 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lower \- Change a window's position in the stacking order







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: lower.n,v 1.1.4.1 1998/09/30 02:16:21 stanton Exp $
'\" 
.so man.macros
.TH lower n 3.3 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lower \- Change a window's position in the stacking order

Changes to doc/menu.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) menu.n 1.61 97/10/31 12:58:40
'\" 
.so man.macros
.TH menu n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
menu \- Create and manipulate menu widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: menu.n,v 1.1.4.1 1998/09/30 02:16:21 stanton Exp $
'\" 
.so man.macros
.TH menu n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
menu \- Create and manipulate menu widgets

Changes to doc/menubar.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) menubar.n 1.13 96/08/27 13:21:45
'\" 
.so man.macros
.TH tk_menuBar n "" Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_menuBar, tk_bindForTraversal \- Obsolete support for menu bars







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: menubar.n,v 1.1.4.1 1998/09/30 02:16:22 stanton Exp $
'\" 
.so man.macros
.TH tk_menuBar n "" Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_menuBar, tk_bindForTraversal \- Obsolete support for menu bars

Changes to doc/menubutton.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) menubutton.n 1.36 97/10/31 12:58:49
'\" 
.so man.macros
.TH menubutton n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
menubutton \- Create and manipulate menubutton widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: menubutton.n,v 1.1.4.1 1998/09/30 02:16:22 stanton Exp $
'\" 
.so man.macros
.TH menubutton n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
menubutton \- Create and manipulate menubutton widgets

Changes to doc/message.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) message.n 1.32 97/10/31 12:58:50
'\" 
.so man.macros
.TH message n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
message \- Create and manipulate message widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: message.n,v 1.1.4.1 1998/09/30 02:16:23 stanton Exp $
'\" 
.so man.macros
.TH message n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
message \- Create and manipulate message widgets

Changes to doc/messageBox.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) messageBox.n 1.5 96/09/19 17:02:40
'\" 
.so man.macros
.TH tk_messageBox n 4.2 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_messageBox \- pops up a message window and waits for user response.






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: messageBox.n,v 1.1.4.2 1999/04/09 21:04:44 surles Exp $
'\" 
.so man.macros
.TH tk_messageBox n 4.2 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_messageBox \- pops up a message window and waits for user response.
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Displays three buttons whose symbolic names are \fByes\fR, \fBno\fR
and \fBcancel\fR.
.RE
.PP
.SH EXAMPLE
.CS
set answer [tk_messageBox \-message "Really quit?" \-type yesno \-icon question]
case $answer {
    yes exit
    no {tk_messageBox \-message "I know you like this application!" \-type ok}
}
.CE

.SH KEYWORDS
message box







|







76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Displays three buttons whose symbolic names are \fByes\fR, \fBno\fR
and \fBcancel\fR.
.RE
.PP
.SH EXAMPLE
.CS
set answer [tk_messageBox \-message "Really quit?" \-type yesno \-icon question]
switch -- $answer {
    yes exit
    no {tk_messageBox \-message "I know you like this application!" \-type ok}
}
.CE

.SH KEYWORDS
message box

Changes to doc/option.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) option.n 1.10 96/03/26 18:25:08
'\" 
.so man.macros
.TH option n "" Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
option \- Add/retrieve window options to/from the option database







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: option.n,v 1.1.4.1 1998/09/30 02:16:23 stanton Exp $
'\" 
.so man.macros
.TH option n "" Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
option \- Add/retrieve window options to/from the option database

Changes to doc/optionMenu.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) optionMenu.n 1.5 96/03/26 18:25:21
'\" 
.so man.macros
.TH tk_optionMenu n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_optionMenu \- Create an option menubutton and its menu







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: optionMenu.n,v 1.1.4.1 1998/09/30 02:16:24 stanton Exp $
'\" 
.so man.macros
.TH tk_optionMenu n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_optionMenu \- Create an option menubutton and its menu

Changes to doc/options.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) options.n 1.47 97/05/31 17:12:19
'\" 
.so man.macros
.TH options n 4.4 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
options \- Standard options supported by widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: options.n,v 1.1.4.1 1998/09/30 02:16:24 stanton Exp $
'\" 
.so man.macros
.TH options n 4.4 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
options \- Standard options supported by widgets

Changes to doc/pack-old.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) pack-old.n 1.12 96/03/26 18:25:44
'\" 
.so man.macros
.TH pack-old n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
pack \- Obsolete syntax for packer geometry manager







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: pack-old.n,v 1.1.4.1 1998/09/30 02:16:24 stanton Exp $
'\" 
.so man.macros
.TH pack-old n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
pack \- Obsolete syntax for packer geometry manager

Changes to doc/pack.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) pack.n 1.19 96/08/27 13:21:48
'\" 
.so man.macros
.TH pack n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
pack \- Geometry manager that packs around edges of cavity







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: pack.n,v 1.1.4.1 1998/09/30 02:16:25 stanton Exp $
'\" 
.so man.macros
.TH pack n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
pack \- Geometry manager that packs around edges of cavity

Changes to doc/palette.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) palette.n 1.5 96/03/26 18:26:11
'\" 
.so man.macros
.TH tk_setPalette n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_setPalette, tk_bisque \- Modify the Tk color palette






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: palette.n,v 1.1.4.1 1998/09/30 02:16:25 stanton Exp $
'\" 
.so man.macros
.TH tk_setPalette n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_setPalette, tk_bisque \- Modify the Tk color palette

Changes to doc/photo.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
'\"
'\" Copyright (c) 1994 The Australian National University
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" Author: Paul Mackerras ([email protected]),
'\"	    Department of Computer Science,
'\"	    Australian National University.
'\"
'\" "@(#) photo.n 1.12 97/10/14 10:52:30"
'\" 
.so man.macros
.TH photo n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
photo \- Full-color images











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
'\"
'\" Copyright (c) 1994 The Australian National University
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" Author: Paul Mackerras ([email protected]),
'\"	    Department of Computer Science,
'\"	    Australian National University.
'\"
'\" RCS: @(#) $Id: photo.n,v 1.1.4.1 1998/09/30 02:16:26 stanton Exp $
'\" 
.so man.macros
.TH photo n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
photo \- Full-color images

Changes to doc/place.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) place.n 1.13 96/08/27 13:21:49
'\" 
.so man.macros
.TH place n "" Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
place \- Geometry manager for fixed or rubber-sheet placement







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: place.n,v 1.1.4.1 1998/09/30 02:16:26 stanton Exp $
'\" 
.so man.macros
.TH place n "" Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
place \- Geometry manager for fixed or rubber-sheet placement

Changes to doc/popup.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) popup.n 1.5 96/03/26 18:26:45
'\" 
.so man.macros
.TH tk_popup n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_popup \- Post a popup menu






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
'\"
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: popup.n,v 1.1.4.1 1998/09/30 02:16:27 stanton Exp $
'\" 
.so man.macros
.TH tk_popup n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk_popup \- Post a popup menu

Changes to doc/radiobutton.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) radiobutton.n 1.41 97/10/31 12:58:51
'\" 
.so man.macros
.TH radiobutton n 4.4 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
radiobutton \- Create and manipulate radiobutton widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: radiobutton.n,v 1.1.4.1 1998/09/30 02:16:27 stanton Exp $
'\" 
.so man.macros
.TH radiobutton n 4.4 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
radiobutton \- Create and manipulate radiobutton widgets

Changes to doc/raise.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) raise.n 1.9 96/06/14 14:20:02
'\" 
.so man.macros
.TH raise n 3.3 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
raise \- Change a window's position in the stacking order







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: raise.n,v 1.1.4.1 1998/09/30 02:16:27 stanton Exp $
'\" 
.so man.macros
.TH raise n 3.3 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
raise \- Change a window's position in the stacking order

Changes to doc/scale.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) scale.n 1.32 97/10/31 12:58:51
'\" 
.so man.macros
.TH scale n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
scale \- Create and manipulate scale widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: scale.n,v 1.1.4.1 1998/09/30 02:16:28 stanton Exp $
'\" 
.so man.macros
.TH scale n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
scale \- Create and manipulate scale widgets

Changes to doc/scrollbar.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) scrollbar.n 1.33 97/10/31 12:58:52
'\" 
.so man.macros
.TH scrollbar n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
scrollbar \- Create and manipulate scrollbar widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: scrollbar.n,v 1.1.4.1 1998/09/30 02:16:28 stanton Exp $
'\" 
.so man.macros
.TH scrollbar n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
scrollbar \- Create and manipulate scrollbar widgets

Changes to doc/selection.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) selection.n 1.18 96/08/27 13:21:51
'\" 
.so man.macros
.TH selection n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
selection \- Manipulate the X selection







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: selection.n,v 1.1.4.1 1998/09/30 02:16:29 stanton Exp $
'\" 
.so man.macros
.TH selection n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
selection \- Manipulate the X selection

Changes to doc/send.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) send.n 1.18 96/08/27 13:21:47
'\" 
.so man.macros
.TH send n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
send \- Execute a command in a different application







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: send.n,v 1.1.4.3 1999/04/02 23:50:11 redman Exp $
'\" 
.so man.macros
.TH send n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
send \- Execute a command in a different application
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

will not respond to incoming send requests anymore,  nor will it
be able to issue outgoing requests.
Communication can be reenabled by invoking the \fBtk appname\fR
command.

.SH SECURITY
.PP
The \fBsend\fR command is potentially a serious security loophole,
since any application that can connect to your X server can send
scripts to your applications.
These incoming scripts can use Tcl to read and
write your files and invoke subprocesses under your name.
Host-based access control such as that provided by \fBxhost\fR
is particularly insecure, since it allows anyone with an account
on particular hosts to connect to your server, and if disabled it
allows anyone anywhere to connect to your server.
In order to provide at least a small amount of
security, Tk checks the access control being used by the server
and rejects incoming sends unless (a) \fBxhost\fR-style access control
is enabled (i.e. only certain hosts can establish connections) and (b) the
list of enabled hosts is empty.
This means that applications cannot connect to your server unless
they use some other form of authorization
such as that provide by \fBxauth\fR.




.SH KEYWORDS

application, name, remote execution, security, send








|
|















|
>
>
>

>
|
>
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
will not respond to incoming send requests anymore,  nor will it
be able to issue outgoing requests.
Communication can be reenabled by invoking the \fBtk appname\fR
command.

.SH SECURITY
.PP
The \fBsend\fR command is potentially a serious security loophole. On Unix,
any application that can connect to your X server can send
scripts to your applications.
These incoming scripts can use Tcl to read and
write your files and invoke subprocesses under your name.
Host-based access control such as that provided by \fBxhost\fR
is particularly insecure, since it allows anyone with an account
on particular hosts to connect to your server, and if disabled it
allows anyone anywhere to connect to your server.
In order to provide at least a small amount of
security, Tk checks the access control being used by the server
and rejects incoming sends unless (a) \fBxhost\fR-style access control
is enabled (i.e. only certain hosts can establish connections) and (b) the
list of enabled hosts is empty.
This means that applications cannot connect to your server unless
they use some other form of authorization
such as that provide by \fBxauth\fR.
.VS
Under Windows, \fBsend\fR is currently disabled.  Most of the
functionality is provided by the \fBdde\fR command instead.
.VE
.SH KEYWORDS
.VS
application, dde, name, remote execution, security, send
.VE

Changes to doc/text.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) text.n 1.68 97/10/31 12:58:41
'\" 
.so man.macros
.TH text n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
text \- Create and manipulate text widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: text.n,v 1.1.4.1 1998/09/30 02:16:29 stanton Exp $
'\" 
.so man.macros
.TH text n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
text \- Create and manipulate text widgets

Changes to doc/tk.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) tk.n 1.15 97/05/20 20:32:56
'\" 
.so man.macros
.TH tk n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk \- Manipulate Tk internal state







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: tk.n,v 1.1.4.1 1998/09/30 02:16:30 stanton Exp $
'\" 
.so man.macros
.TH tk n 4.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tk \- Manipulate Tk internal state

Changes to doc/tkerror.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) tkerror.n 1.19 97/10/31 12:58:53
'\" 
.so man.macros
.TH tkerror n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tkerror \- Command invoked to process background errors







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: tkerror.n,v 1.1.4.1 1998/09/30 02:16:30 stanton Exp $
'\" 
.so man.macros
.TH tkerror n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tkerror \- Command invoked to process background errors

Changes to doc/tkvars.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) tkvars.n 1.22 96/08/27 13:21:38
'\" 
.so man.macros
.TH tkvars n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tkvars \- Variables used or set by Tk







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: tkvars.n,v 1.1.4.1 1998/09/30 02:16:31 stanton Exp $
'\" 
.so man.macros
.TH tkvars n 4.1 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tkvars \- Variables used or set by Tk

Changes to doc/tkwait.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) tkwait.n 1.13 96/07/31 08:19:23
'\" 
.so man.macros
.TH tkwait n "" Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tkwait \- Wait for variable to change or window to be destroyed







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: tkwait.n,v 1.1.4.1 1998/09/30 02:16:31 stanton Exp $
'\" 
.so man.macros
.TH tkwait n "" Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tkwait \- Wait for variable to change or window to be destroyed

Changes to doc/toplevel.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) toplevel.n 1.29 97/10/31 12:58:53
'\" 
.so man.macros
.TH toplevel n 8.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
toplevel \- Create and manipulate toplevel widgets







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: toplevel.n,v 1.1.4.1 1998/09/30 02:16:31 stanton Exp $
'\" 
.so man.macros
.TH toplevel n 8.0 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
toplevel \- Create and manipulate toplevel widgets

Changes to doc/winfo.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) winfo.n 1.45 97/01/25 13:45:04
'\" 
.so man.macros
.TH winfo n 4.3 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
winfo \- Return window-related information







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: winfo.n,v 1.1.4.1 1998/09/30 02:16:32 stanton Exp $
'\" 
.so man.macros
.TH winfo n 4.3 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
winfo \- Return window-related information

Changes to doc/wish.1.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1991-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) wish.1 1.30 97/10/31 12:58:43
'\" 
.so man.macros
.TH wish 1 8.0 Tk "Tk Applications"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
wish \- Simple windowing shell







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1991-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: wish.1,v 1.1.4.1 1998/09/30 02:16:32 stanton Exp $
'\" 
.so man.macros
.TH wish 1 8.0 Tk "Tk Applications"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
wish \- Simple windowing shell

Changes to doc/wm.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1991-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" SCCS: @(#) wm.n 1.37 96/10/14 11:07:58
'\" 
.so man.macros
.TH wm n 4.3 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
wm \- Communicate with window manager







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
'\"
'\" Copyright (c) 1991-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: wm.n,v 1.1.4.1 1998/09/30 02:16:33 stanton Exp $
'\" 
.so man.macros
.TH wm n 4.3 Tk "Tk Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
wm \- Communicate with window manager

Changes to generic/README.

1
2
3
4
5
This directory contains Tk source files that work on all the platforms
where Tk runs (e.g. UNIX, PCs, and Macintoshes).  Platform-specific
sources are in the directories ../unix, ../win, and ../mac.

SCCS ID: @(#) README 1.1 95/09/11 14:02:45




|
1
2
3
4
5
This directory contains Tk source files that work on all the platforms
where Tk runs (e.g. UNIX, PCs, and Macintoshes).  Platform-specific
sources are in the directories ../unix, ../win, and ../mac.

RCS ID: @(#) $Id: README,v 1.1.4.1 1998/09/30 02:16:33 stanton Exp $

Changes to generic/default.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * default.h --
 *
 *	This file defines the defaults for all options for all of
 *	the Tk widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) default.h 1.4 96/02/07 17:33:39
 */

#ifndef _DEFAULT
#define _DEFAULT

#if defined(__WIN32__) || defined(_WIN32)
#   include "tkWinDefault.h"












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * default.h --
 *
 *	This file defines the defaults for all options for all of
 *	the Tk widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: default.h,v 1.1.4.1 1998/09/30 02:16:34 stanton Exp $
 */

#ifndef _DEFAULT
#define _DEFAULT

#if defined(__WIN32__) || defined(_WIN32)
#   include "tkWinDefault.h"

Changes to generic/ks_names.h.

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
/*
 * This file is generated from $(INCLUDESRC)/keysymdef.h.  Do not edit.

 */
{ "BackSpace", 0xFF08 },
{ "Tab", 0xFF09 },
{ "Linefeed", 0xFF0A },
{ "Clear", 0xFF0B },
{ "Return", 0xFF0D },
{ "Pause", 0xFF13 },
{ "Escape", 0xFF1B },
{ "Delete", 0xFFFF },
{ "Multi_key", 0xFF20 },
{ "Kanji", 0xFF21 },
{ "Home", 0xFF50 },
{ "Left", 0xFF51 },
{ "Up", 0xFF52 },
{ "Right", 0xFF53 },
{ "Down", 0xFF54 },
{ "Prior", 0xFF55 },
{ "Next", 0xFF56 },
{ "End", 0xFF57 },
{ "Begin", 0xFF58 },



{ "Select", 0xFF60 },
{ "Print", 0xFF61 },
{ "Execute", 0xFF62 },
{ "Insert", 0xFF63 },
{ "Undo", 0xFF65 },
{ "Redo", 0xFF66 },
{ "Menu", 0xFF67 },


>




















>
>
>







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
/*
 * This file is generated from $(INCLUDESRC)/keysymdef.h.  Do not edit.
 * RCS: $Id: ks_names.h,v 1.1.4.1 1998/09/30 02:16:34 stanton Exp $ 
 */
{ "BackSpace", 0xFF08 },
{ "Tab", 0xFF09 },
{ "Linefeed", 0xFF0A },
{ "Clear", 0xFF0B },
{ "Return", 0xFF0D },
{ "Pause", 0xFF13 },
{ "Escape", 0xFF1B },
{ "Delete", 0xFFFF },
{ "Multi_key", 0xFF20 },
{ "Kanji", 0xFF21 },
{ "Home", 0xFF50 },
{ "Left", 0xFF51 },
{ "Up", 0xFF52 },
{ "Right", 0xFF53 },
{ "Down", 0xFF54 },
{ "Prior", 0xFF55 },
{ "Next", 0xFF56 },
{ "End", 0xFF57 },
{ "Begin", 0xFF58 },
{ "Win_L", 0xFF5B },
{ "Win_R", 0xFF5C },
{ "App", 0xFF5D },
{ "Select", 0xFF60 },
{ "Print", 0xFF61 },
{ "Execute", 0xFF62 },
{ "Insert", 0xFF63 },
{ "Undo", 0xFF65 },
{ "Redo", 0xFF66 },
{ "Menu", 0xFF67 },

Added generic/prolog.ps.

























































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
%%BeginProlog
50 dict begin

% This is a standard prolog for Postscript generated by Tk's canvas
% widget.
% RCS: @(#) $Id: prolog.ps,v 1.1.2.2 1998/09/30 02:16:35 stanton Exp $

% The definitions below just define all of the variables used in
% any of the procedures here.  This is needed for obscure reasons
% explained on p. 716 of the Postscript manual (Section H.2.7,
% "Initializing Variables," in the section on Encapsulated Postscript).

/baseline 0 def
/stipimage 0 def
/height 0 def
/justify 0 def
/lineLength 0 def
/spacing 0 def
/stipple 0 def
/strings 0 def
/xoffset 0 def
/yoffset 0 def
/tmpstip null def

% Define the array ISOLatin1Encoding (which specifies how characters are
% encoded for ISO-8859-1 fonts), if it isn't already present (Postscript
% level 2 is supposed to define it, but level 1 doesn't).

systemdict /ISOLatin1Encoding known not {
    /ISOLatin1Encoding [
	/space /space /space /space /space /space /space /space
	/space /space /space /space /space /space /space /space
	/space /space /space /space /space /space /space /space
	/space /space /space /space /space /space /space /space
	/space /exclam /quotedbl /numbersign /dollar /percent /ampersand
	    /quoteright
	/parenleft /parenright /asterisk /plus /comma /minus /period /slash
	/zero /one /two /three /four /five /six /seven
	/eight /nine /colon /semicolon /less /equal /greater /question
	/at /A /B /C /D /E /F /G
	/H /I /J /K /L /M /N /O
	/P /Q /R /S /T /U /V /W
	/X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore
	/quoteleft /a /b /c /d /e /f /g
	/h /i /j /k /l /m /n /o
	/p /q /r /s /t /u /v /w
	/x /y /z /braceleft /bar /braceright /asciitilde /space
	/space /space /space /space /space /space /space /space
	/space /space /space /space /space /space /space /space
	/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
	/dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron
	/space /exclamdown /cent /sterling /currency /yen /brokenbar /section
	/dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen
	    /registered /macron
	/degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph
	    /periodcentered
	/cedillar /onesuperior /ordmasculine /guillemotright /onequarter
	    /onehalf /threequarters /questiondown
	/Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla
	/Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex
	    /Idieresis
	/Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply
	/Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn
	    /germandbls
	/agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla
	/egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex
	    /idieresis
	/eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide
	/oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn
	    /ydieresis
    ] def
} if

% font ISOEncode font
% This procedure changes the encoding of a font from the default
% Postscript encoding to ISOLatin1.  It's typically invoked just
% before invoking "setfont".  The body of this procedure comes from
% Section 5.6.1 of the Postscript book.

/ISOEncode {
    dup length dict begin
	{1 index /FID ne {def} {pop pop} ifelse} forall
	/Encoding ISOLatin1Encoding def
	currentdict
    end

    % I'm not sure why it's necessary to use "definefont" on this new
    % font, but it seems to be important; just use the name "Temporary"
    % for the font.

    /Temporary exch definefont
} bind def

% StrokeClip
%
% This procedure converts the current path into a clip area under
% the assumption of stroking.  It's a bit tricky because some Postscript
% interpreters get errors during strokepath for dashed lines.  If
% this happens then turn off dashes and try again.

/StrokeClip {
    {strokepath} stopped {
	(This Postscript printer gets limitcheck overflows when) =
	(stippling dashed lines;  lines will be printed solid instead.) =
	[] 0 setdash strokepath} if
    clip
} bind def

% desiredSize EvenPixels closestSize
%
% The procedure below is used for stippling.  Given the optimal size
% of a dot in a stipple pattern in the current user coordinate system,
% compute the closest size that is an exact multiple of the device's
% pixel size.  This allows stipple patterns to be displayed without
% aliasing effects.

/EvenPixels {
    % Compute exact number of device pixels per stipple dot.
    dup 0 matrix currentmatrix dtransform
    dup mul exch dup mul add sqrt

    % Round to an integer, make sure the number is at least 1, and compute
    % user coord distance corresponding to this.
    dup round dup 1 lt {pop 1} if
    exch div mul
} bind def

% width height string StippleFill --
%
% Given a path already set up and a clipping region generated from
% it, this procedure will fill the clipping region with a stipple
% pattern.  "String" contains a proper image description of the
% stipple pattern and "width" and "height" give its dimensions.  Each
% stipple dot is assumed to be about one unit across in the current
% user coordinate system.  This procedure trashes the graphics state.

/StippleFill {
    % The following code is needed to work around a NeWSprint bug.

    /tmpstip 1 index def

    % Change the scaling so that one user unit in user coordinates
    % corresponds to the size of one stipple dot.
    1 EvenPixels dup scale

    % Compute the bounding box occupied by the path (which is now
    % the clipping region), and round the lower coordinates down
    % to the nearest starting point for the stipple pattern.  Be
    % careful about negative numbers, since the rounding works
    % differently on them.

    pathbbox
    4 2 roll
    5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll
    6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll

    % Stack now: width height string y1 y2 x1 x2
    % Below is a doubly-nested for loop to iterate across this area
    % in units of the stipple pattern size, going up columns then
    % across rows, blasting out a stipple-pattern-sized rectangle at
    % each position

    6 index exch {
	2 index 5 index 3 index {
	    % Stack now: width height string y1 y2 x y

	    gsave
	    1 index exch translate
	    5 index 5 index true matrix tmpstip imagemask
	    grestore
	} for
	pop
    } for
    pop pop pop pop pop
} bind def

% -- AdjustColor --
% Given a color value already set for output by the caller, adjusts
% that value to a grayscale or mono value if requested by the CL
% variable.

/AdjustColor {
    CL 2 lt {
	currentgray
	CL 0 eq {
	    .5 lt {0} {1} ifelse
	} if
	setgray
    } if
} bind def

% x y strings spacing xoffset yoffset justify stipple DrawText --
% This procedure does all of the real work of drawing text.  The
% color and font must already have been set by the caller, and the
% following arguments must be on the stack:
%
% x, y -	Coordinates at which to draw text.
% strings -	An array of strings, one for each line of the text item,
%		in order from top to bottom.
% spacing -	Spacing between lines.
% xoffset -	Horizontal offset for text bbox relative to x and y: 0 for
%		nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.
% yoffset -	Vertical offset for text bbox relative to x and y: 0 for
%		nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.
% justify -	0 for left justification, 0.5 for center, 1 for right justify.
% stipple -	Boolean value indicating whether or not text is to be
%		drawn in stippled fashion.  If text is stippled,
%		procedure StippleText must have been defined to call
%		StippleFill in the right way.
%
% Also, when this procedure is invoked, the color and font must already
% have been set for the text.

/DrawText {
    /stipple exch def
    /justify exch def
    /yoffset exch def
    /xoffset exch def
    /spacing exch def
    /strings exch def

    % First scan through all of the text to find the widest line.

    /lineLength 0 def
    strings {
	stringwidth pop
	dup lineLength gt {/lineLength exch def} {pop} ifelse
	newpath
    } forall

    % Compute the baseline offset and the actual font height.

    0 0 moveto (TXygqPZ) false charpath
    pathbbox dup /baseline exch def
    exch pop exch sub /height exch def pop
    newpath

    % Translate coordinates first so that the origin is at the upper-left
    % corner of the text's bounding box. Remember that x and y for
    % positioning are still on the stack.

    translate
    lineLength xoffset mul
    strings length 1 sub spacing mul height add yoffset mul translate

    % Now use the baseline and justification information to translate so
    % that the origin is at the baseline and positioning point for the
    % first line of text.

    justify lineLength mul baseline neg translate

    % Iterate over each of the lines to output it.  For each line,
    % compute its width again so it can be properly justified, then
    % display it.

    strings {
	dup stringwidth pop
	justify neg mul 0 moveto
	stipple {

	    % The text is stippled, so turn it into a path and print
	    % by calling StippledText, which in turn calls StippleFill.
	    % Unfortunately, many Postscript interpreters will get
	    % overflow errors if we try to do the whole string at
	    % once, so do it a character at a time.

	    gsave
	    /char (X) def
	    {
		char 0 3 -1 roll put
		currentpoint
		gsave
		char true charpath clip StippleText
		grestore
		char stringwidth translate
		moveto
	    } forall
	    grestore
	} {show} ifelse
	0 spacing neg translate
    } forall
} bind def

%%EndProlog

Added generic/tk.decls.





































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
# tk.decls --
#
#	This file contains the declarations for all supported public
#	functions that are exported by the Tk library via the stubs table.
#	This file is used to generate the tkDecls.h, tkPlatDecls.h,
#	tkStub.c, and tkPlatStub.c files.
#	
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: tk.decls,v 1.2.2.3 1999/04/01 21:58:49 redman Exp $

library tk

# Define the tk interface with 3 sub interfaces:
#     tkPlat	 - platform specific public
#     tkInt	 - generic private
#     tkPlatInt - platform specific private

interface tk
hooks {tkPlat tkInt tkIntPlat tkIntXlib}

# Declare each of the functions in the public Tk interface.  Note that
# the an index should never be reused for a different function in order
# to preserve backwards compatibility.

declare 0 generic {
    void Tk_MainLoop (void)
}

declare 1 generic {
    XColor *Tk_3DBorderColor (Tk_3DBorder border)
}

declare 2 generic {
    GC Tk_3DBorderGC (Tk_Window tkwin, Tk_3DBorder border, \
	    int which)
}

declare 3 generic {
    void Tk_3DHorizontalBevel (Tk_Window tkwin, \
	    Drawable drawable, Tk_3DBorder border, int x, \
	    int y, int width, int height, int leftIn, \
	    int rightIn, int topBevel, int relief)
}

declare 4 generic {
    void Tk_3DVerticalBevel (Tk_Window tkwin, \
	    Drawable drawable, Tk_3DBorder border, int x, \
	    int y, int width, int height, int leftBevel, \
	    int relief)
}

declare 5 generic {
    void Tk_AddOption (Tk_Window tkwin, char *name, \
	    char *value, int priority)
}

declare 6 generic {
    void Tk_BindEvent (Tk_BindingTable bindingTable, \
	    XEvent *eventPtr, Tk_Window tkwin, int numObjects, \
	    ClientData *objectPtr)
}

declare 7 generic {
    void Tk_CanvasDrawableCoords (Tk_Canvas canvas, \
	    double x, double y, short *drawableXPtr, \
	    short *drawableYPtr)
}

declare 8 generic {
    void Tk_CanvasEventuallyRedraw (Tk_Canvas canvas, int x1, int y1, \
	    int x2, int y2)
}

declare 9 generic {
    int Tk_CanvasGetCoord (Tcl_Interp *interp, \
	    Tk_Canvas canvas, char *str, double *doublePtr)
}

declare 10 generic {
    Tk_CanvasTextInfo *Tk_CanvasGetTextInfo (Tk_Canvas canvas)
}

declare 11 generic {
    int Tk_CanvasPsBitmap (Tcl_Interp *interp, \
	    Tk_Canvas canvas, Pixmap bitmap, int x, int y, \
	    int width, int height)
}

declare 12 generic {
    int Tk_CanvasPsColor (Tcl_Interp *interp, \
	    Tk_Canvas canvas, XColor *colorPtr)
}

declare 13 generic {
    int Tk_CanvasPsFont (Tcl_Interp *interp, \
	    Tk_Canvas canvas, Tk_Font font)
}

declare 14 generic {
    void Tk_CanvasPsPath (Tcl_Interp *interp, \
	    Tk_Canvas canvas, double *coordPtr, int numPoints)
}

declare 15 generic {
    int Tk_CanvasPsStipple (Tcl_Interp *interp, \
	    Tk_Canvas canvas, Pixmap bitmap)
}

declare 16 generic {
    double Tk_CanvasPsY (Tk_Canvas canvas, double y)
}

declare 17 generic {
    void Tk_CanvasSetStippleOrigin (Tk_Canvas canvas, GC gc)
}

declare 18 generic {
    int Tk_CanvasTagsParseProc (ClientData clientData, Tcl_Interp *interp, \
	    Tk_Window tkwin, char *value, char *widgRec, int offset)
}

declare 19 generic {
    char * Tk_CanvasTagsPrintProc (ClientData clientData, Tk_Window tkwin, \
	    char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)
}

declare 20 generic {
    Tk_Window	Tk_CanvasTkwin (Tk_Canvas canvas)
}

declare 21 generic {
    void Tk_CanvasWindowCoords (Tk_Canvas canvas, double x, double y, \
	    short *screenXPtr, short *screenYPtr)
}

declare 22 generic {
    void Tk_ChangeWindowAttributes (Tk_Window tkwin, unsigned long valueMask, \
	    XSetWindowAttributes *attsPtr)
}

declare 23 generic {
    int Tk_CharBbox (Tk_TextLayout layout, int index, int *xPtr, \
	    int *yPtr, int *widthPtr, int *heightPtr)
}

declare 24 generic {
    void Tk_ClearSelection (Tk_Window tkwin, Atom selection)
}

declare 25 generic {
    int Tk_ClipboardAppend (Tcl_Interp *interp,Tk_Window tkwin, \
	    Atom target, Atom format, char* buffer)
}

declare 26 generic {
    int Tk_ClipboardClear (Tcl_Interp *interp, Tk_Window tkwin)
}

declare 27 generic {
    int Tk_ConfigureInfo (Tcl_Interp *interp, \
	    Tk_Window tkwin, Tk_ConfigSpec *specs, \
	    char *widgRec, char *argvName, int flags)
}

declare 28 generic {
    int Tk_ConfigureValue (Tcl_Interp *interp, \
	    Tk_Window tkwin, Tk_ConfigSpec *specs, \
	    char *widgRec, char *argvName, int flags)
}

declare 29 generic {
    int Tk_ConfigureWidget (Tcl_Interp *interp, \
	    Tk_Window tkwin, Tk_ConfigSpec *specs, \
	    int argc, char **argv, char *widgRec, \
	    int flags)
}

declare 30 generic {
    void Tk_ConfigureWindow (Tk_Window tkwin, \
	    unsigned int valueMask, XWindowChanges *valuePtr)
}

declare 31 generic {
    Tk_TextLayout Tk_ComputeTextLayout (Tk_Font font, \
	    CONST char *str, int numChars, int wrapLength, \
	    Tk_Justify justify, int flags, int *widthPtr, \
	    int *heightPtr)
}

declare 32 generic {
    Tk_Window Tk_CoordsToWindow (int rootX, int rootY, Tk_Window tkwin)
}

declare 33 generic {
    unsigned long Tk_CreateBinding (Tcl_Interp *interp, \
	    Tk_BindingTable bindingTable, ClientData object, \
	    char *eventStr, char *command, int append)
}

declare 34 generic {
    Tk_BindingTable Tk_CreateBindingTable (Tcl_Interp *interp)
}

declare 35 generic {
    Tk_ErrorHandler Tk_CreateErrorHandler (Display *display, \
	    int errNum, int request, int minorCode, \
	    Tk_ErrorProc *errorProc, ClientData clientData)
}

declare 36 generic {
    void Tk_CreateEventHandler (Tk_Window token, \
	    unsigned long mask, Tk_EventProc *proc, \
	    ClientData clientData)
}

declare 37 generic {
    void Tk_CreateGenericHandler (Tk_GenericProc *proc, ClientData clientData)
}

declare 38 generic {
    void Tk_CreateImageType (Tk_ImageType *typePtr)
}

declare 39 generic {
    void Tk_CreateItemType (Tk_ItemType *typePtr)
}

declare 40 generic {
    void Tk_CreatePhotoImageFormat (Tk_PhotoImageFormat *formatPtr)
}

declare 41 generic {
    void Tk_CreateSelHandler (Tk_Window tkwin, \
	    Atom selection, Atom target, \
	    Tk_SelectionProc *proc, ClientData clientData, \
	    Atom format)
}

declare 42 generic {
    Tk_Window Tk_CreateWindow (Tcl_Interp *interp, \
	    Tk_Window parent, char *name, char *screenName)
}

declare 43 generic {
    Tk_Window Tk_CreateWindowFromPath (Tcl_Interp *interp, Tk_Window tkwin, \
	    char *pathName, char *screenName)
}

declare 44 generic {
    int Tk_DefineBitmap (Tcl_Interp *interp, CONST char *name, char *source, \
	    int width, int height)
}

declare 45 generic {
    void Tk_DefineCursor (Tk_Window window, Tk_Cursor cursor)
}

declare 46 generic {
    void Tk_DeleteAllBindings (Tk_BindingTable bindingTable, ClientData object)
}

declare 47 generic {
    int Tk_DeleteBinding (Tcl_Interp *interp, \
	    Tk_BindingTable bindingTable, ClientData object, \
	    char *eventStr)
}

declare 48 generic {
    void Tk_DeleteBindingTable (Tk_BindingTable bindingTable)
}

declare 49 generic {
    void Tk_DeleteErrorHandler (Tk_ErrorHandler handler)
}

declare 50 generic {
    void Tk_DeleteEventHandler (Tk_Window token, \
	    unsigned long mask, Tk_EventProc *proc, \
	    ClientData clientData)
}

declare 51 generic {
    void Tk_DeleteGenericHandler (Tk_GenericProc *proc, ClientData clientData)
}

declare 52 generic {
    void Tk_DeleteImage (Tcl_Interp *interp, char *name)
}

declare 53 generic {
    void Tk_DeleteSelHandler (Tk_Window tkwin, Atom selection, Atom target)
}

declare 54 generic {
    void Tk_DestroyWindow (Tk_Window tkwin)
}

declare 55 generic {
    char * Tk_DisplayName (Tk_Window tkwin)
}

declare 56 generic {
    int Tk_DistanceToTextLayout (Tk_TextLayout layout, int x, int y)
}

declare 57 generic {
    void Tk_Draw3DPolygon (Tk_Window tkwin, \
	    Drawable drawable, Tk_3DBorder border, \
	    XPoint *pointPtr, int numPoints, int borderWidth, \
	    int leftRelief)
}

declare 58 generic {
    void Tk_Draw3DRectangle (Tk_Window tkwin, Drawable drawable, \
	    Tk_3DBorder border, int x, int y, int width, int height, \
	    int borderWidth, int relief)
}

declare 59 generic {
    void Tk_DrawChars (Display *display, Drawable drawable, GC gc, \
	    Tk_Font tkfont, CONST char *source, int numBytes, int x, int y)
}

declare 60 generic {
    void Tk_DrawFocusHighlight (Tk_Window tkwin, GC gc, int width, \
	    Drawable drawable)
}

declare 61 generic {
    void Tk_DrawTextLayout (Display *display, \
	    Drawable drawable, GC gc, Tk_TextLayout layout, \
	    int x, int y, int firstChar, int lastChar)
}

declare 62 generic {
    void Tk_Fill3DPolygon (Tk_Window tkwin, \
	    Drawable drawable, Tk_3DBorder border, \
	    XPoint *pointPtr, int numPoints, int borderWidth, \
	    int leftRelief)
}

declare 63 generic {
    void Tk_Fill3DRectangle (Tk_Window tkwin, \
	    Drawable drawable, Tk_3DBorder border, int x, \
	    int y, int width, int height, int borderWidth, \
	    int relief)
}

declare 64 generic {
    Tk_PhotoHandle Tk_FindPhoto (Tcl_Interp *interp, char *imageName)
}

declare 65 generic {
    Font Tk_FontId (Tk_Font font)
}

declare 66 generic {
    void Tk_Free3DBorder (Tk_3DBorder border)
}

declare 67 generic {
    void Tk_FreeBitmap (Display *display, Pixmap bitmap)
}

declare 68 generic {
    void Tk_FreeColor (XColor *colorPtr)
}

declare 69 generic {
    void Tk_FreeColormap (Display *display, Colormap colormap)
}

declare 70 generic {
    void Tk_FreeCursor (Display *display, Tk_Cursor cursor)
}

declare 71 generic {
    void Tk_FreeFont (Tk_Font f)
}

declare 72 generic {
    void Tk_FreeGC (Display *display, GC gc)
}

declare 73 generic {
    void Tk_FreeImage (Tk_Image image)
}

declare 74 generic {
    void Tk_FreeOptions (Tk_ConfigSpec *specs, \
	    char *widgRec, Display *display, int needFlags)
}

declare 75 generic {
    void Tk_FreePixmap (Display *display, Pixmap pixmap)
}

declare 76 generic {
    void Tk_FreeTextLayout (Tk_TextLayout textLayout)
}

declare 77 generic {
    void Tk_FreeXId (Display *display, XID xid)
}

declare 78 generic {
    GC Tk_GCForColor (XColor *colorPtr, Drawable drawable)
}

declare 79 generic {
    void Tk_GeometryRequest (Tk_Window tkwin, int reqWidth,  int reqHeight)
}

declare 80 generic {
    Tk_3DBorder	Tk_Get3DBorder (Tcl_Interp *interp, Tk_Window tkwin, \
	    Tk_Uid colorName)
}

declare 81 generic {
    void Tk_GetAllBindings (Tcl_Interp *interp, \
	    Tk_BindingTable bindingTable, ClientData object)
}

declare 82 generic {
    int Tk_GetAnchor (Tcl_Interp *interp, \
	    char *str, Tk_Anchor *anchorPtr)
}

declare 83 generic {
    char * Tk_GetAtomName (Tk_Window tkwin, Atom atom)
}

declare 84 generic {
    char * Tk_GetBinding (Tcl_Interp *interp, \
	    Tk_BindingTable bindingTable, ClientData object, \
	    char *eventStr)
}

declare 85 generic {
    Pixmap Tk_GetBitmap (Tcl_Interp *interp, Tk_Window tkwin, CONST char * str)
}

declare 86 generic {
    Pixmap Tk_GetBitmapFromData (Tcl_Interp *interp, \
	    Tk_Window tkwin, char *source, int width, int height)
}

declare 87 generic {
    int Tk_GetCapStyle (Tcl_Interp *interp, char *str, int *capPtr)
}

declare 88 generic {
    XColor * Tk_GetColor (Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid name)
}

declare 89 generic {
    XColor * Tk_GetColorByValue (Tk_Window tkwin, XColor *colorPtr)
}

declare 90 generic {
    Colormap Tk_GetColormap (Tcl_Interp *interp, Tk_Window tkwin, char *str)
}

declare 91 generic {
    Tk_Cursor Tk_GetCursor (Tcl_Interp *interp, Tk_Window tkwin, \
	    Tk_Uid str)
}

declare 92 generic {
    Tk_Cursor Tk_GetCursorFromData (Tcl_Interp *interp, \
	    Tk_Window tkwin, char *source, char *mask, \
	    int width, int height, int xHot, int yHot, \
	    Tk_Uid fg, Tk_Uid bg)
}

declare 93 generic {
    Tk_Font Tk_GetFont (Tcl_Interp *interp, \
	    Tk_Window tkwin, CONST char *str)
}

declare 94 generic {
    Tk_Font Tk_GetFontFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
}

declare 95 generic {
    void Tk_GetFontMetrics (Tk_Font font, Tk_FontMetrics *fmPtr)
}

declare 96 generic {
    GC Tk_GetGC (Tk_Window tkwin, unsigned long valueMask, XGCValues *valuePtr)
}

declare 97 generic {
    Tk_Image Tk_GetImage (Tcl_Interp *interp, Tk_Window tkwin, char *name, \
	    Tk_ImageChangedProc *changeProc, ClientData clientData)
}

declare 98 generic {
    ClientData Tk_GetImageMasterData (Tcl_Interp *interp, \
	    char *name, Tk_ImageType **typePtrPtr)
}

declare 99 generic {
    Tk_ItemType * Tk_GetItemTypes (void)
}

declare 100 generic {
    int Tk_GetJoinStyle (Tcl_Interp *interp, char *str, int *joinPtr)
}

declare 101 generic {
    int Tk_GetJustify (Tcl_Interp *interp, \
	    char *str, Tk_Justify *justifyPtr)
}

declare 102 generic {
    int Tk_GetNumMainWindows (void)
}

declare 103 generic {
    Tk_Uid Tk_GetOption (Tk_Window tkwin, char *name, char *className)
}

declare 104 generic {
    int Tk_GetPixels (Tcl_Interp *interp, \
	    Tk_Window tkwin, char *str, int *intPtr)
}

declare 105 generic {
    Pixmap Tk_GetPixmap (Display *display, Drawable d, \
	    int width, int height, int depth)
}

declare 106 generic {
    int Tk_GetRelief (Tcl_Interp *interp, char *name, int *reliefPtr)
}

declare 107 generic {
    void Tk_GetRootCoords (Tk_Window tkwin, int *xPtr, int *yPtr)
}

declare 108 generic {
    int Tk_GetScrollInfo (Tcl_Interp *interp, \
	    int argc, char **argv, double *dblPtr, int *intPtr)
}

declare 109 generic {
    int Tk_GetScreenMM (Tcl_Interp *interp, \
	    Tk_Window tkwin, char *str, double *doublePtr)
}

declare 110 generic {
    int Tk_GetSelection (Tcl_Interp *interp, \
	    Tk_Window tkwin, Atom selection, Atom target, \
	    Tk_GetSelProc *proc, ClientData clientData)
}

declare 111 generic {
    Tk_Uid Tk_GetUid (CONST char *str)
}

declare 112 generic {
    Visual * Tk_GetVisual (Tcl_Interp *interp, \
	    Tk_Window tkwin, char *str, int *depthPtr, \
	    Colormap *colormapPtr)
}

declare 113 generic {
    void Tk_GetVRootGeometry (Tk_Window tkwin, \
	    int *xPtr, int *yPtr, int *widthPtr, int *heightPtr)
}

declare 114 generic {
    int Tk_Grab (Tcl_Interp *interp, Tk_Window tkwin, int grabGlobal)
}

declare 115 generic {
    void Tk_HandleEvent (XEvent *eventPtr)
}

declare 116 generic {
    Tk_Window Tk_IdToWindow (Display *display, Window window)
}

declare 117 generic {
    void Tk_ImageChanged (Tk_ImageMaster master, int x, int y, \
	    int width, int height, int imageWidth, int imageHeight)
}

declare 118 generic {
    int Tk_Init (Tcl_Interp *interp)
}

declare 119 generic {
    Atom Tk_InternAtom (Tk_Window tkwin, char *name)
}

declare 120 generic {
    int Tk_IntersectTextLayout (Tk_TextLayout layout, int x, int y, \
	    int width, int height)
}

declare 121 generic {
    void Tk_MaintainGeometry (Tk_Window slave, \
	    Tk_Window master, int x, int y, int width, int height)
}

declare 122 generic {
    Tk_Window Tk_MainWindow (Tcl_Interp *interp)
}

declare 123 generic {
    void Tk_MakeWindowExist (Tk_Window tkwin)
}

declare 124 generic {
    void Tk_ManageGeometry (Tk_Window tkwin, \
	    Tk_GeomMgr *mgrPtr, ClientData clientData)
}

declare 125 generic {
    void Tk_MapWindow (Tk_Window tkwin)
}

declare 126 generic {
    int Tk_MeasureChars (Tk_Font tkfont, \
	    CONST char *source, int numBytes, int maxPixels, \
	    int flags, int *lengthPtr)
}

declare 127 generic {
    void Tk_MoveResizeWindow (Tk_Window tkwin, \
	    int x, int y, int width, int height)
}

declare 128 generic {
    void Tk_MoveWindow (Tk_Window tkwin, int x, int y)
}

declare 129 generic {
    void Tk_MoveToplevelWindow (Tk_Window tkwin, int x, int y)
}

declare 130 generic {
    char * Tk_NameOf3DBorder (Tk_3DBorder border)
}

declare 131 generic {
    char * Tk_NameOfAnchor (Tk_Anchor anchor)
}

declare 132 generic {
    char * Tk_NameOfBitmap (Display *display, Pixmap bitmap)
}

declare 133 generic {
    char * Tk_NameOfCapStyle (int cap)
}

declare 134 generic {
    char * Tk_NameOfColor (XColor *colorPtr)
}

declare 135 generic {
    char * Tk_NameOfCursor (Display *display, Tk_Cursor cursor)
}

declare 136 generic {
    char * Tk_NameOfFont (Tk_Font font)
}

declare 137 generic {
    char * Tk_NameOfImage (Tk_ImageMaster imageMaster)
}

declare 138 generic {
    char * Tk_NameOfJoinStyle (int join)
}

declare 139 generic {
    char * Tk_NameOfJustify (Tk_Justify justify)
}

declare 140 generic {
    char * Tk_NameOfRelief (int relief)
}

declare 141 generic {
    Tk_Window Tk_NameToWindow (Tcl_Interp *interp, \
	    char *pathName, Tk_Window tkwin)
}

declare 142 generic {
    void Tk_OwnSelection (Tk_Window tkwin, \
	    Atom selection, Tk_LostSelProc *proc, \
	    ClientData clientData)
}

declare 143 generic {
    int Tk_ParseArgv (Tcl_Interp *interp, \
	    Tk_Window tkwin, int *argcPtr, char **argv, \
	    Tk_ArgvInfo *argTable, int flags)
}

declare 144 generic {
    void Tk_PhotoPutBlock (Tk_PhotoHandle handle, \
	    Tk_PhotoImageBlock *blockPtr, int x, int y, \
	    int width, int height)
}

declare 145 generic {
    void Tk_PhotoPutZoomedBlock (Tk_PhotoHandle handle, \
	    Tk_PhotoImageBlock *blockPtr, int x, int y, \
	    int width, int height, int zoomX, int zoomY, \
	    int subsampleX, int subsampleY)
}

declare 146 generic {
    int Tk_PhotoGetImage (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr)
}

declare 147 generic {
    void Tk_PhotoBlank (Tk_PhotoHandle handle)
}

declare 148 generic {
    void Tk_PhotoExpand (Tk_PhotoHandle handle, int width, int height )
}

declare 149 generic {
    void Tk_PhotoGetSize (Tk_PhotoHandle handle, int *widthPtr, int *heightPtr)
}

declare 150 generic {
    void Tk_PhotoSetSize (Tk_PhotoHandle handle, int width, int height)
}

declare 151 generic {
    int Tk_PointToChar (Tk_TextLayout layout, int x, int y)
}

declare 152 generic {
    int Tk_PostscriptFontName (Tk_Font tkfont, Tcl_DString *dsPtr)
}

declare 153 generic {
    void Tk_PreserveColormap (Display *display, Colormap colormap)
}

declare 154 generic {
    void Tk_QueueWindowEvent (XEvent *eventPtr, Tcl_QueuePosition position)
}

declare 155 generic {
    void Tk_RedrawImage (Tk_Image image, int imageX, \
	    int imageY, int width, int height, \
	    Drawable drawable, int drawableX, int drawableY)
}

declare 156 generic {
    void Tk_ResizeWindow (Tk_Window tkwin, int width, int height)
}

declare 157 generic {
    int Tk_RestackWindow (Tk_Window tkwin, int aboveBelow, Tk_Window other)
}

declare 158 generic {
    Tk_RestrictProc *Tk_RestrictEvents (Tk_RestrictProc *proc, \
	    ClientData arg, ClientData *prevArgPtr)
}

declare 159 generic {
    int Tk_SafeInit (Tcl_Interp *interp)
}

declare 160 generic {
    char * Tk_SetAppName (Tk_Window tkwin, char *name)
}

declare 161 generic {
    void Tk_SetBackgroundFromBorder (Tk_Window tkwin, Tk_3DBorder border)
}

declare 162 generic {
    void Tk_SetClass (Tk_Window tkwin, char *className)
}

declare 163 generic {
    void Tk_SetGrid (Tk_Window tkwin, int reqWidth, int reqHeight, \
	    int gridWidth, int gridHeight)
}

declare 164 generic {
    void Tk_SetInternalBorder (Tk_Window tkwin, int width)
}

declare 165 generic {
    void Tk_SetWindowBackground (Tk_Window tkwin, unsigned long pixel)
}

declare 166 generic {
    void Tk_SetWindowBackgroundPixmap (Tk_Window tkwin, Pixmap pixmap)
}

declare 167 generic {
    void Tk_SetWindowBorder (Tk_Window tkwin, unsigned long pixel)
}

declare 168 generic {
    void Tk_SetWindowBorderWidth (Tk_Window tkwin, int width)
}

declare 169 generic {
    void Tk_SetWindowBorderPixmap (Tk_Window tkwin, Pixmap pixmap)
}

declare 170 generic {
    void Tk_SetWindowColormap (Tk_Window tkwin, Colormap colormap)
}

declare 171 generic {
    int Tk_SetWindowVisual (Tk_Window tkwin, Visual *visual, int depth,\
	    Colormap colormap)
}

declare 172 generic {
    void Tk_SizeOfBitmap (Display *display, Pixmap bitmap, int *widthPtr, \
	    int *heightPtr)
}

declare 173 generic {
    void Tk_SizeOfImage (Tk_Image image, int *widthPtr, int *heightPtr)
}

declare 174 generic {
    int Tk_StrictMotif (Tk_Window tkwin)
}

declare 175 generic {
    void Tk_TextLayoutToPostscript (Tcl_Interp *interp, Tk_TextLayout layout)
}

declare 176 generic {
    int Tk_TextWidth (Tk_Font font, CONST char *str, int numBytes)
}

declare 177 generic {
    void Tk_UndefineCursor (Tk_Window window)
}

declare 178 generic {
    void Tk_UnderlineChars (Display *display, \
	    Drawable drawable, GC gc, Tk_Font tkfont, \
	    CONST char *source, int x, int y, int firstByte, \
	    int lastByte)
}

declare 179 generic {
    void Tk_UnderlineTextLayout (Display *display, Drawable drawable, GC gc, \
	    Tk_TextLayout layout, int x, int y, \
	    int underline)
}

declare 180 generic {
    void Tk_Ungrab (Tk_Window tkwin)
}

declare 181 generic {
    void Tk_UnmaintainGeometry (Tk_Window slave, Tk_Window master)
}

declare 182 generic {
    void Tk_UnmapWindow (Tk_Window tkwin)
}

declare 183 generic {
    void Tk_UnsetGrid (Tk_Window tkwin)
}

declare 184 generic {
    void Tk_UpdatePointer (Tk_Window tkwin, int x, int y, int state)
}

# new functions for 8.1

declare 185 generic {
    Pixmap  Tk_AllocBitmapFromObj (Tcl_Interp *interp, Tk_Window tkwin, \
    Tcl_Obj *objPtr)
}

declare 186 generic {
    Tk_3DBorder Tk_Alloc3DBorderFromObj (Tcl_Interp *interp, Tk_Window tkwin, \
	    Tcl_Obj *objPtr)
}

declare 187 generic {
    XColor *  Tk_AllocColorFromObj (Tcl_Interp *interp, Tk_Window tkwin, \
	    Tcl_Obj *objPtr)
}

declare 188 generic {
    Tk_Cursor Tk_AllocCursorFromObj (Tcl_Interp *interp, Tk_Window tkwin, \
	    Tcl_Obj *objPtr)
}

declare 189 generic {
    Tk_Font  Tk_AllocFontFromObj (Tcl_Interp *interp, Tk_Window tkwin, \
	    Tcl_Obj *objPtr)

}

declare 190 generic {
    Tk_OptionTable Tk_CreateOptionTable (Tcl_Interp *interp, \
	    CONST Tk_OptionSpec *templatePtr)
}

declare 191 generic {
    void  Tk_DeleteOptionTable (Tk_OptionTable optionTable)
}

declare 192 generic {
    void  Tk_Free3DBorderFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
}

declare 193 generic {
    void  Tk_FreeBitmapFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
}

declare 194 generic {
    void  Tk_FreeColorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
}

declare 195 generic {
    void  Tk_FreeConfigOptions (char *recordPtr, Tk_OptionTable optionToken, \
	    Tk_Window tkwin)

}

declare 196 generic {
    void  Tk_FreeSavedOptions (Tk_SavedOptions *savePtr)
}

declare 197 generic {
    void  Tk_FreeCursorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
}

declare 198 generic {
    void  Tk_FreeFontFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
}

declare 199 generic {
    Tk_3DBorder Tk_Get3DBorderFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
}

declare 200 generic {
    int  Tk_GetAnchorFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr, \
	    Tk_Anchor *anchorPtr)
}

declare 201 generic {
    Pixmap  Tk_GetBitmapFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
}

declare 202 generic {
    XColor *  Tk_GetColorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
}

declare 203 generic {
    Tk_Cursor Tk_GetCursorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
}

declare 204 generic {
    Tcl_Obj * Tk_GetOptionInfo (Tcl_Interp *interp, \
	    char *recordPtr, Tk_OptionTable optionTable, \
	    Tcl_Obj *namePtr, Tk_Window tkwin)
}

declare 205 generic {
    Tcl_Obj * Tk_GetOptionValue (Tcl_Interp *interp, char *recordPtr, \
	    Tk_OptionTable optionTable, Tcl_Obj *namePtr, Tk_Window tkwin)
}

declare 206 generic {
    int  Tk_GetJustifyFromObj (Tcl_Interp *interp, \
	    Tcl_Obj *objPtr, Tk_Justify *justifyPtr)
}

declare 207 generic {
    int  Tk_GetMMFromObj (Tcl_Interp *interp, \
	    Tk_Window tkwin, Tcl_Obj *objPtr, double *doublePtr)
}

declare 208 generic {
    int  Tk_GetPixelsFromObj (Tcl_Interp *interp, \
	    Tk_Window tkwin, Tcl_Obj *objPtr, int *intPtr)
}

declare 209 generic {
    int  Tk_GetReliefFromObj (Tcl_Interp *interp, \
	    Tcl_Obj *objPtr, int *resultPtr)
}

declare 210 generic {
    int  Tk_GetScrollInfoObj (Tcl_Interp *interp, \
	    int objc, Tcl_Obj *CONST objv[], double *dblPtr, int *intPtr)
}

declare 211 generic {
    int  Tk_InitOptions (
       Tcl_Interp *interp, char *recordPtr, \
	       Tk_OptionTable optionToken, Tk_Window tkwin)
}

declare 212 generic {
    void  Tk_MainEx (int argc, char **argv, Tcl_AppInitProc *appInitProc, \
	    Tcl_Interp *interp)
}

declare 213 generic {
    void  Tk_RestoreSavedOptions (Tk_SavedOptions *savePtr)
}

declare 214 generic {
    int  Tk_SetOptions (Tcl_Interp *interp, char *recordPtr, \
	    Tk_OptionTable optionTable, int objc, \
	    Tcl_Obj *CONST objv[], Tk_Window tkwin, \
	    Tk_SavedOptions *savePtr, int *maskPtr)
}


# Define the platform specific public Tk interface.  These functions are
# only available on the designated platform.

interface tkPlat

# Unix specific functions
#   (none)

# Windows specific functions

declare 0 win {
    Window Tk_AttachHWND (Tk_Window tkwin, HWND hwnd)
}

declare 1 win {
    HINSTANCE Tk_GetHINSTANCE (void)
}

declare 2 win {
    HWND Tk_GetHWND (Window window)
}

declare 3 win {
    Tk_Window Tk_HWNDToWindow (HWND hwnd)
}

declare 4 win {
    void Tk_PointerEvent (HWND hwnd, int x, int y)
}

declare 5 win {
    int Tk_TranslateWinEvent (HWND hwnd, \
	    UINT message, WPARAM wParam, LPARAM lParam, LRESULT *result)
}

# Mac specific functions

declare 0 mac {
    void Tk_MacSetEmbedHandler ( \
	    Tk_MacEmbedRegisterWinProc *registerWinProcPtr, \
	    Tk_MacEmbedGetGrafPortProc *getPortProcPtr, \
	    Tk_MacEmbedMakeContainerExistProc *containerExistProcPtr, \
	    Tk_MacEmbedGetClipProc *getClipProc, \
	    Tk_MacEmbedGetOffsetInParentProc *getOffsetProc)
}
 
declare 1 mac {
    void Tk_MacTurnOffMenus (void)
}

declare 2 mac {
    void Tk_MacTkOwnsCursor (int tkOwnsIt)
}

declare 3 mac {
    void TkMacInitMenus (Tcl_Interp *interp)
}

declare 4 mac {
    void TkMacInitAppleEvents (Tcl_Interp *interp)
}

declare 5 mac {
    int TkMacConvertEvent (EventRecord *eventPtr)
}

declare 6 mac {
    int TkMacConvertTkEvent (EventRecord *eventPtr, Window window)
}

declare 7 mac {
    void TkGenWMConfigureEvent (Tk_Window tkwin, \
	    int x, int y, int width, int height, int flags)
}

declare 8 mac {
    void TkMacInvalClipRgns (TkWindow *winPtr)
}

declare 9 mac {
    int TkMacHaveAppearance (void)
}

declare 10 mac {
    GWorldPtr TkMacGetDrawablePort (Drawable drawable)
}

Changes to generic/tk.h.

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
/*
 * tk.h --
 *
 *	Declarations for Tk-related things that are visible
 *	outside of the Tk module itself.
 *
 * Copyright (c) 1989-1994 The Regents of the University of California.
 * Copyright (c) 1994 The Australian National University.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tk.h 1.211 97/11/20 12:44:45
 */

#ifndef _TK
#define _TK

/*
 * When version numbers change here, you must also go into the following files
 * and update the version numbers:
 *
 * unix/configure.in
 * win/makefile.bc
 * win/makefile.vc

 * library/tk.tcl
 *
 * The release level should be  0 for alpha, 1 for beta, and 2 for
 * final/patch.  The release serial value is the number that follows the
 * "a", "b", or "p" in the patch level; for example, if the patch level
 * is 4.3b2, TK_RELEASE_SERIAL is 2.  It restarts at 1 whenever the
 * release level is changed, except for the final release, which should
 * be 0.
 *
 * You may also need to update some of these files when the numbers change
 * for the version of Tcl that this release of Tk is compiled against.
 */

#define TK_MAJOR_VERSION   8
#define TK_MINOR_VERSION   0
#define TK_RELEASE_LEVEL   2
#define TK_RELEASE_SERIAL  2

#define TK_VERSION "8.0"
#define TK_PATCH_LEVEL "8.0p2"

/* 
 * A special definition used to allow this header file to be included 
 * in resource files.
 */

#ifndef RESOURCE_INCLUDED

/*
 * The following definitions set up the proper options for Macintosh
 * compilers.  We use this method because there is no autoconf equivalent.
 */

#ifdef MAC_TCL
#   ifndef REDO_KEYSYM_LOOKUP
#	define REDO_KEYSYM_LOOKUP
#   endif
#endif

#ifndef _TCL
#   include <tcl.h>
#endif








#ifndef _XLIB_H
#   ifdef MAC_TCL
#	include <Xlib.h>
#	include <X.h>
#   else
#	include <X11/Xlib.h>
#   endif
#endif
#ifdef __STDC__
#   include <stddef.h>
#endif






/*
 * Decide whether or not to use input methods.
 */

#ifdef XNQueryInputStyle
#define TK_USE_INPUT_METHODS
#endif

/*
 * Dummy types that are used by clients:
 */

typedef struct Tk_BindingTable_ *Tk_BindingTable;
typedef struct Tk_Canvas_ *Tk_Canvas;
typedef struct Tk_Cursor_ *Tk_Cursor;
typedef struct Tk_ErrorHandler_ *Tk_ErrorHandler;
typedef struct Tk_Font_ *Tk_Font;
typedef struct Tk_Image__ *Tk_Image;
typedef struct Tk_ImageMaster_ *Tk_ImageMaster;

typedef struct Tk_TextLayout_ *Tk_TextLayout;
typedef struct Tk_Window_ *Tk_Window;
typedef struct Tk_3DBorder_ *Tk_3DBorder;

/*
 * Additional types exported to clients.
 */

typedef char *Tk_Uid;

/*



 * Structure used to specify how to handle argv options.


























 */

typedef struct {








    char *key;		/* The key string that flags the option in the
			 * argv array. */

    int type;		/* Indicates option type;  see below. */




    char *src;		/* Value to be used in setting dst;  usage








			 * depends on type. */

    char *dst;		/* Address of value to be modified;  usage
			 * depends on type. */
    char *help;		/* Documentation message describing this option. */






} Tk_ArgvInfo;

/*
 * Legal values for the type field of a Tk_ArgvInfo: see the user

 * documentation for details.
 */

#define TK_ARGV_CONSTANT		15
#define TK_ARGV_INT			16
#define TK_ARGV_STRING			17



#define TK_ARGV_UID			18

#define TK_ARGV_REST			19
#define TK_ARGV_FLOAT			20
#define TK_ARGV_FUNC			21

#define TK_ARGV_GENFUNC			22

#define TK_ARGV_HELP			23









#define TK_ARGV_CONST_OPTION		24
#define TK_ARGV_OPTION_VALUE		25
#define TK_ARGV_OPTION_NAME_VALUE	26

#define TK_ARGV_END			27




/*







 * Flag bits for passing to Tk_ParseArgv:


 */


#define TK_ARGV_NO_DEFAULTS		0x1
#define TK_ARGV_NO_LEFTOVERS		0x2

#define TK_ARGV_NO_ABBREV		0x4

#define TK_ARGV_DONT_SKIP_FIRST_ARG	0x8
















/*
 * Structure used to describe application-specific configuration
 * options:  indicates procedures to call to parse an option and
 * to return a text string describing an option.

 */








typedef int (Tk_OptionParseProc) _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, Tk_Window tkwin, char *value, char *widgRec,
	int offset));
typedef char *(Tk_OptionPrintProc) _ANSI_ARGS_((ClientData clientData,
	Tk_Window tkwin, char *widgRec, int offset,
	Tcl_FreeProc **freeProcPtr));








|
>




|












>
|
<
|
|
|
<
<
<
|





|
|
|

|
|
<
<
<
<
<
<
<















>
>
>
>
>
>
>
>











>
>
>
>
>




















>











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


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


|
>
|


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

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




|
>

>
>
>
>
>
>
>







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

30
31
32



33
34
35
36
37
38
39
40
41
42
43
44







45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192

193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217

218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
/*
 * tk.h --
 *
 *	Declarations for Tk-related things that are visible
 *	outside of the Tk module itself.
 *
 * Copyright (c) 1989-1994 The Regents of the University of California.
 * Copyright (c) 1994 The Australian National University.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tk.h,v 1.1.4.15 1999/04/01 21:58:49 redman Exp $
 */

#ifndef _TK
#define _TK

/*
 * When version numbers change here, you must also go into the following files
 * and update the version numbers:
 *
 * unix/configure.in
 * win/makefile.bc
 * win/makefile.vc
 * README
 * library/tk.tcl	(only if major.minor changes, not patchlevel)

 * mac/README		(only if major.minor changes, not patchlevel)
 * win/README		(only if major.minor changes, not patchlevel)
 * unix/README		(only if major.minor changes, not patchlevel)




 * You may also need to update some of these files when the numbers change
 * for the version of Tcl that this release of Tk is compiled against.
 */

#define TK_MAJOR_VERSION   8
#define TK_MINOR_VERSION   1
#define TK_RELEASE_LEVEL   TCL_BETA_RELEASE
#define TK_RELEASE_SERIAL  3

#define TK_VERSION "8.1"
#define TK_PATCH_LEVEL "8.1b3"








/*
 * The following definitions set up the proper options for Macintosh
 * compilers.  We use this method because there is no autoconf equivalent.
 */

#ifdef MAC_TCL
#   ifndef REDO_KEYSYM_LOOKUP
#	define REDO_KEYSYM_LOOKUP
#   endif
#endif

#ifndef _TCL
#   include <tcl.h>
#endif

/* 
 * A special definition used to allow this header file to be included 
 * in resource files.
 */

#ifndef RESOURCE_INCLUDED

#ifndef _XLIB_H
#   ifdef MAC_TCL
#	include <Xlib.h>
#	include <X.h>
#   else
#	include <X11/Xlib.h>
#   endif
#endif
#ifdef __STDC__
#   include <stddef.h>
#endif

#ifdef BUILD_tk
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * Decide whether or not to use input methods.
 */

#ifdef XNQueryInputStyle
#define TK_USE_INPUT_METHODS
#endif

/*
 * Dummy types that are used by clients:
 */

typedef struct Tk_BindingTable_ *Tk_BindingTable;
typedef struct Tk_Canvas_ *Tk_Canvas;
typedef struct Tk_Cursor_ *Tk_Cursor;
typedef struct Tk_ErrorHandler_ *Tk_ErrorHandler;
typedef struct Tk_Font_ *Tk_Font;
typedef struct Tk_Image__ *Tk_Image;
typedef struct Tk_ImageMaster_ *Tk_ImageMaster;
typedef struct Tk_OptionTable_ *Tk_OptionTable;
typedef struct Tk_TextLayout_ *Tk_TextLayout;
typedef struct Tk_Window_ *Tk_Window;
typedef struct Tk_3DBorder_ *Tk_3DBorder;

/*
 * Additional types exported to clients.
 */

typedef char *Tk_Uid;

/*
 * The enum below defines the valid types for Tk configuration options
 * as implemented by Tk_InitOptions, Tk_SetOptions, etc.
 */

typedef enum {
    TK_OPTION_BOOLEAN,
    TK_OPTION_INT,
    TK_OPTION_DOUBLE,
    TK_OPTION_STRING,
    TK_OPTION_STRING_TABLE,
    TK_OPTION_COLOR,
    TK_OPTION_FONT,
    TK_OPTION_BITMAP,
    TK_OPTION_BORDER,
    TK_OPTION_RELIEF,
    TK_OPTION_CURSOR,
    TK_OPTION_JUSTIFY,
    TK_OPTION_ANCHOR,
    TK_OPTION_SYNONYM,
    TK_OPTION_PIXELS,
    TK_OPTION_WINDOW,
    TK_OPTION_END
} Tk_OptionType;

/*
 * Structures of the following type are used by widgets to specify
 * their configuration options.  Typically each widget has a static
 * array of these structures, where each element of the array describes
 * a single configuration option.  The array is passed to
 * Tk_CreateOptionTable.
 */

typedef struct Tk_OptionSpec {
    Tk_OptionType type;		/* Type of option, such as TK_OPTION_COLOR; 
				 * see definitions above. Last option in
				 * table must have type TK_OPTION_END. */
    char *optionName;		/* Name used to specify option in Tcl	
				 * commands. */
    char *dbName;		/* Name for option in option database. */
    char *dbClass;		/* Class for option in database. */
    char *defValue;		/* Default value for option if not specified
				 * in command line, the option database,
				 * or the system. */
    int objOffset;		/* Where in record to store a Tcl_Obj * that
				 * holds the value of this option, specified
				 * as an offset in bytes from the start of
				 * the record. Use the Tk_Offset macro to
				 * generate values for this.  -1 means don't
				 * store the Tcl_Obj in the record. */
    int internalOffset;		/* Where in record to store the internal
				 * representation of the value of this option,
				 * such as an int or XColor *.  This field
				 * is specified as an offset in bytes
				 * from the start of the record. Use the
				 * Tk_Offset macro to generate values for it.
				 * -1 means don't store the internal
				 * representation in the record. */
    int flags;			/* Any combination of the values defined
				 * below. */
    ClientData clientData;	/* An alternate place to put option-specific
    				 * data. Used for the monochrome default value
				 * for colors, etc. */
    int typeMask;		/* An arbitrary bit mask defined by the
				 * class manager; typically bits correspond
				 * to certain kinds of options such as all
				 * those that require a redisplay when they
				 * change.  Tk_SetOptions returns the bit-wise
				 * OR of the typeMasks of all options that
				 * were changed. */
} Tk_OptionSpec;

/*
 * Flag values for Tk_OptionSpec structures.  These flags are shared by
 * Tk_ConfigSpec structures, so be sure to coordinate any changes
 * carefully.
 */


#define TK_OPTION_NULL_OK		1

/*
 * Macro to use to fill in "offset" fields of Tk_OptionSpecs.
 * Computes number of bytes from beginning of structure to a
 * given field.
 */

#ifdef offsetof
#define Tk_Offset(type, field) ((int) offsetof(type, field))
#else
#define Tk_Offset(type, field) ((int) ((char *) &((type *) 0)->field))
#endif

/*
 * The following two structures are used for error handling.  When
 * configuration options are being modified, the old values are
 * saved in a Tk_SavedOptions structure.  If an error occurs, then the
 * contents of the structure can be used to restore all of the old
 * values.  The contents of this structure are for the private use
 * Tk.  No-one outside Tk should ever read or write any of the fields
 * of these structures.
 */

typedef struct Tk_SavedOption {

    struct TkOption *optionPtr;		/* Points to information that describes
					 * the option. */
    Tcl_Obj *valuePtr;			/* The old value of the option, in
					 * the form of a Tcl object; may be
					 * NULL if the value wasn't saved as
					 * an object. */
    double internalForm;		/* The old value of the option, in
					 * some internal representation such
					 * as an int or (XColor *).  Valid
					 * only if optionPtr->specPtr->objOffset
					 * is < 0.  The space must be large
					 * enough to accommodate a double, a
					 * long, or a pointer; right now it
					 * looks like a double is big
					 * enough.  Also, using a double
					 * guarantees that the field is
					 * properly aligned for storing large
					 * values. */
} Tk_SavedOption;

#ifdef TCL_MEM_DEBUG
#   define TK_NUM_SAVED_OPTIONS 2
#else
#   define TK_NUM_SAVED_OPTIONS 20
#endif

typedef struct Tk_SavedOptions {
    char *recordPtr;			/* The data structure in which to
					 * restore configuration options. */
    Tk_Window tkwin;			/* Window associated with recordPtr;
					 * needed to restore certain options. */
    int numItems;			/* The number of valid items in 
					 * items field. */
    Tk_SavedOption items[TK_NUM_SAVED_OPTIONS];
					/* Items used to hold old values. */
    struct Tk_SavedOptions *nextPtr;	/* Points to next structure in list;	
					 * needed if too many options changed
					 * to hold all the old values in a
					 * single structure.  NULL means no
					 * more structures. */
} Tk_SavedOptions;

/*
 * Structure used to describe application-specific configuration
 * options:  indicates procedures to call to parse an option and
 * to return a text string describing an option. THESE ARE
 * DEPRECATED; PLEASE USE THE NEW STRUCTURES LISTED ABOVE.
 */

/*
 * This is a temporary flag used while tkObjConfig and new widgets
 * are in development.
 */

#ifndef __NO_OLD_CONFIG

typedef int (Tk_OptionParseProc) _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, Tk_Window tkwin, char *value, char *widgRec,
	int offset));
typedef char *(Tk_OptionPrintProc) _ANSI_ARGS_((ClientData clientData,
	Tk_Window tkwin, char *widgRec, int offset,
	Tcl_FreeProc **freeProcPtr));
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265












































266
267
268
269
270
271
272
} Tk_ConfigSpec;

/*
 * Type values for Tk_ConfigSpec structures.  See the user
 * documentation for details.
 */

#define TK_CONFIG_BOOLEAN	1
#define TK_CONFIG_INT		2
#define TK_CONFIG_DOUBLE	3
#define TK_CONFIG_STRING	4
#define TK_CONFIG_UID		5
#define TK_CONFIG_COLOR		6
#define TK_CONFIG_FONT		7
#define TK_CONFIG_BITMAP	8
#define TK_CONFIG_BORDER	9
#define TK_CONFIG_RELIEF	10
#define TK_CONFIG_CURSOR	11
#define TK_CONFIG_ACTIVE_CURSOR	12
#define TK_CONFIG_JUSTIFY	13
#define TK_CONFIG_ANCHOR	14
#define TK_CONFIG_SYNONYM	15
#define TK_CONFIG_CAP_STYLE	16
#define TK_CONFIG_JOIN_STYLE	17
#define TK_CONFIG_PIXELS	18
#define TK_CONFIG_MM		19
#define TK_CONFIG_WINDOW	20
#define TK_CONFIG_CUSTOM	21
#define TK_CONFIG_END		22

/*
 * Macro to use to fill in "offset" fields of Tk_ConfigInfos.
 * Computes number of bytes from beginning of structure to a
 * given field.
 */

#ifdef offsetof
#define Tk_Offset(type, field) ((int) offsetof(type, field))
#else
#define Tk_Offset(type, field) ((int) ((char *) &((type *) 0)->field))
#endif

/*
 * Possible values for flags argument to Tk_ConfigureWidget:
 */

#define TK_CONFIG_ARGV_ONLY	1

/*
 * Possible flag values for Tk_ConfigInfo structures.  Any bits at
 * or above TK_CONFIG_USER_BIT may be used by clients for selecting
 * certain entries.  Before changing any values here, coordinate with
 * tkConfig.c (internal-use-only flags are defined there).
 */

#define TK_CONFIG_COLOR_ONLY		1
#define TK_CONFIG_MONO_ONLY		2
#define TK_CONFIG_NULL_OK		4
#define TK_CONFIG_DONT_SET_DEFAULT	8
#define TK_CONFIG_OPTION_SPECIFIED	0x10
#define TK_CONFIG_USER_BIT		0x100













































/*
 * Enumerated type for describing actions to be taken in response
 * to a restrictProc established by Tk_RestrictEvents.
 */

typedef enum {







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








|


|


|
|
|



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







320
321
322
323
324
325
326
327

328




329

330

331




332


333

334
335











336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
} Tk_ConfigSpec;

/*
 * Type values for Tk_ConfigSpec structures.  See the user
 * documentation for details.
 */

typedef enum {

    TK_CONFIG_BOOLEAN, TK_CONFIG_INT, TK_CONFIG_DOUBLE, TK_CONFIG_STRING,




    TK_CONFIG_UID, TK_CONFIG_COLOR, TK_CONFIG_FONT, TK_CONFIG_BITMAP,

    TK_CONFIG_BORDER, TK_CONFIG_RELIEF, TK_CONFIG_CURSOR, 

    TK_CONFIG_ACTIVE_CURSOR, TK_CONFIG_JUSTIFY, TK_CONFIG_ANCHOR, 




    TK_CONFIG_SYNONYM, TK_CONFIG_CAP_STYLE, TK_CONFIG_JOIN_STYLE,


    TK_CONFIG_PIXELS, TK_CONFIG_MM, TK_CONFIG_WINDOW, TK_CONFIG_CUSTOM, 

    TK_CONFIG_END
} Tk_ConfigTypes;












/*
 * Possible values for flags argument to Tk_ConfigureWidget:
 */

#define TK_CONFIG_ARGV_ONLY	1

/*
 * Possible flag values for Tk_ConfigSpec structures.  Any bits at
 * or above TK_CONFIG_USER_BIT may be used by clients for selecting
 * certain entries.  Before changing any values here, coordinate with
 * tkOldConfig.c (internal-use-only flags are defined there).
 */

#define TK_CONFIG_NULL_OK		1
#define TK_CONFIG_COLOR_ONLY		2
#define TK_CONFIG_MONO_ONLY		4
#define TK_CONFIG_DONT_SET_DEFAULT	8
#define TK_CONFIG_OPTION_SPECIFIED	0x10
#define TK_CONFIG_USER_BIT		0x100
#endif /* __NO_OLD_CONFIG */

/*
 * Structure used to specify how to handle argv options.
 */

typedef struct {
    char *key;		/* The key string that flags the option in the
			 * argv array. */
    int type;		/* Indicates option type;  see below. */
    char *src;		/* Value to be used in setting dst;  usage
			 * depends on type. */
    char *dst;		/* Address of value to be modified;  usage
			 * depends on type. */
    char *help;		/* Documentation message describing this option. */
} Tk_ArgvInfo;

/*
 * Legal values for the type field of a Tk_ArgvInfo: see the user
 * documentation for details.
 */

#define TK_ARGV_CONSTANT		15
#define TK_ARGV_INT			16
#define TK_ARGV_STRING			17
#define TK_ARGV_UID			18
#define TK_ARGV_REST			19
#define TK_ARGV_FLOAT			20
#define TK_ARGV_FUNC			21
#define TK_ARGV_GENFUNC			22
#define TK_ARGV_HELP			23
#define TK_ARGV_CONST_OPTION		24
#define TK_ARGV_OPTION_VALUE		25
#define TK_ARGV_OPTION_NAME_VALUE	26
#define TK_ARGV_END			27

/*
 * Flag bits for passing to Tk_ParseArgv:
 */

#define TK_ARGV_NO_DEFAULTS		0x1
#define TK_ARGV_NO_LEFTOVERS		0x2
#define TK_ARGV_NO_ABBREV		0x4
#define TK_ARGV_DONT_SKIP_FIRST_ARG	0x8

/*
 * Enumerated type for describing actions to be taken in response
 * to a restrictProc established by Tk_RestrictEvents.
 */

typedef enum {
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
#define TK_INTERACTIVE_PRIO	80
#define TK_MAX_PRIO		100

/*
 * Relief values returned by Tk_GetRelief:
 */

#define TK_RELIEF_RAISED	1
#define TK_RELIEF_FLAT		2
#define TK_RELIEF_SUNKEN	4
#define TK_RELIEF_GROOVE	8
#define TK_RELIEF_RIDGE		16
#define TK_RELIEF_SOLID		32

/*
 * "Which" argument values for Tk_3DBorderGC:
 */

#define TK_3D_FLAT_GC		1
#define TK_3D_LIGHT_GC		2







|
|
|
|
|
|







417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
#define TK_INTERACTIVE_PRIO	80
#define TK_MAX_PRIO		100

/*
 * Relief values returned by Tk_GetRelief:
 */

#define TK_RELIEF_FLAT		0
#define TK_RELIEF_GROOVE	1
#define TK_RELIEF_RAISED	2
#define TK_RELIEF_RIDGE		3
#define TK_RELIEF_SOLID		4
#define TK_RELIEF_SUNKEN	5

/*
 * "Which" argument values for Tk_3DBorderGC:
 */

#define TK_3D_FLAT_GC		1
#define TK_3D_LIGHT_GC		2
405
406
407
408
409
410
411

412
413

414
415

416
417
418
419
420
421
422
423
 * Extensions to the X event set
 *
 *---------------------------------------------------------------------------
 */
#define VirtualEvent	    (LASTEvent)
#define ActivateNotify	    (LASTEvent + 1)
#define DeactivateNotify    (LASTEvent + 2)

#define TK_LASTEVENT	    (LASTEvent + 3)


#define VirtualEventMask    (1L << 30)
#define ActivateMask	    (1L << 29)

#define TK_LASTEVENT	    (LASTEvent + 3)


/*
 * A virtual event shares most of its fields with the XKeyEvent and
 * XButtonEvent structures.  99% of the time a virtual event will be
 * an abstraction of a key or button event, so this structure provides
 * the most information to the user.  The only difference is the changing







>
|

>
|

>
|







539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
 * Extensions to the X event set
 *
 *---------------------------------------------------------------------------
 */
#define VirtualEvent	    (LASTEvent)
#define ActivateNotify	    (LASTEvent + 1)
#define DeactivateNotify    (LASTEvent + 2)
#define MouseWheelEvent     (LASTEvent + 3)
#define TK_LASTEVENT	    (LASTEvent + 4)

#define MouseWheelMask	    (1L << 28)

#define ActivateMask	    (1L << 29)
#define VirtualEventMask    (1L << 30)
#define TK_LASTEVENT	    (LASTEvent + 4)


/*
 * A virtual event shares most of its fields with the XKeyEvent and
 * XButtonEvent structures.  99% of the time a virtual event will be
 * an abstraction of a key or button event, so this structure provides
 * the most information to the user.  The only difference is the changing
656
657
658
659
660
661
662







663
664
665
666
667
668
669
					 * this type of item. */
    int x1, y1, x2, y2;			/* Bounding box for item, in integer
					 * canvas units. Set by item-specific
					 * code and guaranteed to contain every
					 * pixel drawn in item.  Item area
					 * includes x1 and y1 but not x2
					 * and y2. */








    /*
     *------------------------------------------------------------------
     * Starting here is additional type-specific stuff;  see the
     * declarations for individual types to see what is part of
     * each type.  The actual space below is determined by the
     * "itemInfoSize" of the type's Tk_ItemType record.







>
>
>
>
>
>
>







793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
					 * this type of item. */
    int x1, y1, x2, y2;			/* Bounding box for item, in integer
					 * canvas units. Set by item-specific
					 * code and guaranteed to contain every
					 * pixel drawn in item.  Item area
					 * includes x1 and y1 but not x2
					 * and y2. */
    struct Tk_Item *prevPtr;		/* Previous in display list of all
					 * items in this canvas. Later items
					 * in list are drawn just below earlier
					 * ones. */
    int   reserved1;			/* This padding is for compatibility */
    char *reserved2;			/* with Jan Nijtmans dash patch */
    int   reserved3;

    /*
     *------------------------------------------------------------------
     * Starting here is additional type-specific stuff;  see the
     * declarations for individual types to see what is part of
     * each type.  The actual space below is determined by the
     * "itemInfoSize" of the type's Tk_ItemType record.
710
711
712
713
714
715
716


717
718
719
720
721
722
723
typedef int	Tk_ItemSelectionProc _ANSI_ARGS_((Tk_Canvas canvas,
		    Tk_Item *itemPtr, int offset, char *buffer,
		    int maxBytes));
typedef void	Tk_ItemInsertProc _ANSI_ARGS_((Tk_Canvas canvas,
		    Tk_Item *itemPtr, int beforeThis, char *string));
typedef void	Tk_ItemDCharsProc _ANSI_ARGS_((Tk_Canvas canvas,
		    Tk_Item *itemPtr, int first, int last));



typedef struct Tk_ItemType {
    char *name;				/* The name of this type of item, such
					 * as "line". */
    int itemSize;			/* Total amount of space needed for
					 * item's record. */
    Tk_ItemCreateProc *createProc;	/* Procedure to create a new item of







>
>







854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
typedef int	Tk_ItemSelectionProc _ANSI_ARGS_((Tk_Canvas canvas,
		    Tk_Item *itemPtr, int offset, char *buffer,
		    int maxBytes));
typedef void	Tk_ItemInsertProc _ANSI_ARGS_((Tk_Canvas canvas,
		    Tk_Item *itemPtr, int beforeThis, char *string));
typedef void	Tk_ItemDCharsProc _ANSI_ARGS_((Tk_Canvas canvas,
		    Tk_Item *itemPtr, int first, int last));

#ifndef __NO_OLD_CONFIG

typedef struct Tk_ItemType {
    char *name;				/* The name of this type of item, such
					 * as "line". */
    int itemSize;			/* Total amount of space needed for
					 * item's record. */
    Tk_ItemCreateProc *createProc;	/* Procedure to create a new item of
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
					 * item. */
    Tk_ItemInsertProc *insertProc;	/* Procedure to insert something into
					 * an item. */
    Tk_ItemDCharsProc *dCharsProc;	/* Procedure to delete characters
					 * from an item. */
    struct Tk_ItemType *nextPtr;	/* Used to link types together into
					 * a list. */




} Tk_ItemType;



/*
 * The following structure provides information about the selection and
 * the insertion cursor.  It is needed by only a few items, such as
 * those that display text.  It is shared by the generic canvas code
 * and the item-specific code, but most of the fields should be written
 * only by the canvas generic code.
 */

typedef struct Tk_CanvasTextInfo {
    Tk_3DBorder selBorder;	/* Border and background for selected
				 * characters.  Read-only to items.*/
    int selBorderWidth;		/* Width of border around selection. 
				 * Read-only to items. */
    XColor *selFgColorPtr;	/* Foreground color for selected text.
				 * Read-only to items. */
    Tk_Item *selItemPtr;	/* Pointer to selected item.  NULL means
				 * selection isn't in this canvas.
				 * Writable by items. */
    int selectFirst;		/* Index of first selected character. 
				 * Writable by items. */
    int selectLast;		/* Index of last selected character. 
				 * Writable by items. */
    Tk_Item *anchorItemPtr;	/* Item corresponding to "selectAnchor":
				 * not necessarily selItemPtr.   Read-only
				 * to items. */

    int selectAnchor;		/* Fixed end of selection (i.e. "select to"
				 * operation will use this as one end of the
				 * selection).  Writable by items. */
    Tk_3DBorder insertBorder;	/* Used to draw vertical bar for insertion
				 * cursor.  Read-only to items. */
    int insertWidth;		/* Total width of insertion cursor.  Read-only
				 * to items. */
    int insertBorderWidth;	/* Width of 3-D border around insert cursor.
				 * Read-only to items. */
    Tk_Item *focusItemPtr;	/* Item that currently has the input focus,







>
>
>
>

>
>



















|
|
|
|



>
|
|
|







904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
					 * item. */
    Tk_ItemInsertProc *insertProc;	/* Procedure to insert something into
					 * an item. */
    Tk_ItemDCharsProc *dCharsProc;	/* Procedure to delete characters
					 * from an item. */
    struct Tk_ItemType *nextPtr;	/* Used to link types together into
					 * a list. */
    char *reserved1;			/* Reserved for future extension. */
    int   reserved2;			/* Carefully compatible with */
    char *reserved3;			/* Jan Nijtmans dash patch */
    char *reserved4;
} Tk_ItemType;

#endif

/*
 * The following structure provides information about the selection and
 * the insertion cursor.  It is needed by only a few items, such as
 * those that display text.  It is shared by the generic canvas code
 * and the item-specific code, but most of the fields should be written
 * only by the canvas generic code.
 */

typedef struct Tk_CanvasTextInfo {
    Tk_3DBorder selBorder;	/* Border and background for selected
				 * characters.  Read-only to items.*/
    int selBorderWidth;		/* Width of border around selection. 
				 * Read-only to items. */
    XColor *selFgColorPtr;	/* Foreground color for selected text.
				 * Read-only to items. */
    Tk_Item *selItemPtr;	/* Pointer to selected item.  NULL means
				 * selection isn't in this canvas.
				 * Writable by items. */
    int selectFirst;		/* Character index of first selected
				 * character.  Writable by items. */
    int selectLast;		/* Character index of last selected
				 * character.  Writable by items. */
    Tk_Item *anchorItemPtr;	/* Item corresponding to "selectAnchor":
				 * not necessarily selItemPtr.   Read-only
				 * to items. */
    int selectAnchor;		/* Character index of fixed end of
				 * selection (i.e. "select to" operation will
				 * use this as one end of the selection).
				 * Writable by items. */
    Tk_3DBorder insertBorder;	/* Used to draw vertical bar for insertion
				 * cursor.  Read-only to items. */
    int insertWidth;		/* Total width of insertion cursor.  Read-only
				 * to items. */
    int insertBorderWidth;	/* Width of 3-D border around insert cursor.
				 * Read-only to items. */
    Tk_Item *focusItemPtr;	/* Item that currently has the input focus,
860
861
862
863
864
865
866

867
868
869
870
871
872
873
				 * will not be called until after freeProc
				 * has been called for each instance of the
				 * image. */
    struct Tk_ImageType *nextPtr;
				/* Next in list of all image types currently
				 * known.  Filled in by Tk, not by image
				 * manager. */

};

/*
 *--------------------------------------------------------------
 *
 * Additional definitions used to manage images of type "photo".
 *







>







1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
				 * will not be called until after freeProc
				 * has been called for each instance of the
				 * image. */
    struct Tk_ImageType *nextPtr;
				/* Next in list of all image types currently
				 * known.  Filled in by Tk, not by image
				 * manager. */
    char *reserved;		/* reserved for future expansion */
};

/*
 *--------------------------------------------------------------
 *
 * Additional definitions used to manage images of type "photo".
 *
892
893
894
895
896
897
898

899
900
901
902
903
904
905
    int		pitch;		/* Address difference between corresponding
				 * pixels in successive lines. */
    int		pixelSize;	/* Address difference between successive
				 * pixels in the same line. */
    int		offset[3];	/* Address differences between the red, green
				 * and blue components of the pixel and the
				 * pixel as a whole. */

} Tk_PhotoImageBlock;

/*
 * Procedure prototypes and structures used in reading and
 * writing photo images:
 */








>







1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
    int		pitch;		/* Address difference between corresponding
				 * pixels in successive lines. */
    int		pixelSize;	/* Address difference between successive
				 * pixels in the same line. */
    int		offset[3];	/* Address differences between the red, green
				 * and blue components of the pixel and the
				 * pixel as a whole. */
    int		reserved;	/* Reserved for extensions (dash patch) */
} Tk_PhotoImageBlock;

/*
 * Procedure prototypes and structures used in reading and
 * writing photo images:
 */

995
996
997
998
999
1000
1001














1002
1003
1004
1005
1006
1007
1008
/* Additional stuff that has moved to Tcl: */

#define Tk_AfterCmd		Tcl_AfterCmd
#define Tk_EventuallyFree	Tcl_EventuallyFree
#define Tk_FreeProc		Tcl_FreeProc
#define Tk_Preserve		Tcl_Preserve
#define Tk_Release		Tcl_Release















/*
 *--------------------------------------------------------------
 *
 * Additional procedure types defined by Tk.
 *
 *--------------------------------------------------------------







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







1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
/* Additional stuff that has moved to Tcl: */

#define Tk_AfterCmd		Tcl_AfterCmd
#define Tk_EventuallyFree	Tcl_EventuallyFree
#define Tk_FreeProc		Tcl_FreeProc
#define Tk_Preserve		Tcl_Preserve
#define Tk_Release		Tcl_Release

/* Removed Tk_Main, use macro instead */
#define Tk_Main(argc, argv, proc) \
    Tk_MainEx(argc, argv, proc, Tcl_CreateInterp())

char *Tk_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, char *version, int exact));

#ifndef USE_TK_STUBS

#define Tk_InitStubs(interp, version, exact) \
    Tcl_PkgRequire(interp, "Tk", version, exact)

#endif


/*
 *--------------------------------------------------------------
 *
 * Additional procedure types defined by Tk.
 *
 *--------------------------------------------------------------
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537




1538
 *--------------------------------------------------------------
 *
 * Exported procedures and variables.
 *
 *--------------------------------------------------------------
 */

EXTERN XColor *		Tk_3DBorderColor _ANSI_ARGS_((Tk_3DBorder border));
EXTERN GC		Tk_3DBorderGC _ANSI_ARGS_((Tk_Window tkwin,
			    Tk_3DBorder border, int which));
EXTERN void		Tk_3DHorizontalBevel _ANSI_ARGS_((Tk_Window tkwin,
			    Drawable drawable, Tk_3DBorder border, int x,
			    int y, int width, int height, int leftIn,
			    int rightIn, int topBevel, int relief));
EXTERN void		Tk_3DVerticalBevel _ANSI_ARGS_((Tk_Window tkwin,
			    Drawable drawable, Tk_3DBorder border, int x,
			    int y, int width, int height, int leftBevel,
			    int relief));
EXTERN void		Tk_AddOption _ANSI_ARGS_((Tk_Window tkwin, char *name,
			    char *value, int priority));
EXTERN void		Tk_BindEvent _ANSI_ARGS_((Tk_BindingTable bindingTable,
			    XEvent *eventPtr, Tk_Window tkwin, int numObjects,
			    ClientData *objectPtr));
EXTERN void		Tk_CanvasDrawableCoords _ANSI_ARGS_((Tk_Canvas canvas,
			    double x, double y, short *drawableXPtr,
			    short *drawableYPtr));
EXTERN void		Tk_CanvasEventuallyRedraw _ANSI_ARGS_((
			    Tk_Canvas canvas, int x1, int y1, int x2,
			    int y2));
EXTERN int		Tk_CanvasGetCoord _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Canvas canvas, char *string,
			    double *doublePtr));
EXTERN Tk_CanvasTextInfo *Tk_CanvasGetTextInfo _ANSI_ARGS_((Tk_Canvas canvas));
EXTERN int		Tk_CanvasPsBitmap _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Canvas canvas, Pixmap bitmap, int x, int y,
			    int width, int height));
EXTERN int		Tk_CanvasPsColor _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Canvas canvas, XColor *colorPtr));
EXTERN int		Tk_CanvasPsFont _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Canvas canvas, Tk_Font font));
EXTERN void		Tk_CanvasPsPath _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Canvas canvas, double *coordPtr, int numPoints));
EXTERN int		Tk_CanvasPsStipple _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Canvas canvas, Pixmap bitmap));
EXTERN double		Tk_CanvasPsY _ANSI_ARGS_((Tk_Canvas canvas, double y));
EXTERN void		Tk_CanvasSetStippleOrigin _ANSI_ARGS_((
			    Tk_Canvas canvas, GC gc));
EXTERN int		Tk_CanvasTagsParseProc _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp,
			    Tk_Window tkwin, char *value, char *widgRec,
			    int offset));
EXTERN char *		Tk_CanvasTagsPrintProc _ANSI_ARGS_((
			    ClientData clientData, Tk_Window tkwin,
			    char *widgRec, int offset,
			    Tcl_FreeProc **freeProcPtr));
EXTERN Tk_Window	Tk_CanvasTkwin _ANSI_ARGS_((Tk_Canvas canvas));
EXTERN void		Tk_CanvasWindowCoords _ANSI_ARGS_((Tk_Canvas canvas,
			    double x, double y, short *screenXPtr,
			    short *screenYPtr));
EXTERN void		Tk_ChangeWindowAttributes _ANSI_ARGS_((Tk_Window tkwin,
			    unsigned long valueMask,
			    XSetWindowAttributes *attsPtr));
EXTERN int		Tk_CharBbox _ANSI_ARGS_((Tk_TextLayout layout,
			    int index, int *xPtr, int *yPtr, int *widthPtr,
			    int *heightPtr));
EXTERN void		Tk_ClearSelection _ANSI_ARGS_((Tk_Window tkwin,
			    Atom selection));
EXTERN int		Tk_ClipboardAppend _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Atom target, Atom format,
			    char* buffer));
EXTERN int		Tk_ClipboardClear _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin));
EXTERN int		Tk_ConfigureInfo _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Tk_ConfigSpec *specs,
			    char *widgRec, char *argvName, int flags));
EXTERN int		Tk_ConfigureValue _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Tk_ConfigSpec *specs,
			    char *widgRec, char *argvName, int flags));
EXTERN int		Tk_ConfigureWidget _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Tk_ConfigSpec *specs,
			    int argc, char **argv, char *widgRec,
			    int flags));
EXTERN void		Tk_ConfigureWindow _ANSI_ARGS_((Tk_Window tkwin,
			    unsigned int valueMask, XWindowChanges *valuePtr));
EXTERN Tk_TextLayout	Tk_ComputeTextLayout _ANSI_ARGS_((Tk_Font font,
			    CONST char *string, int numChars, int wrapLength,
			    Tk_Justify justify, int flags, int *widthPtr,
			    int *heightPtr));
EXTERN Tk_Window	Tk_CoordsToWindow _ANSI_ARGS_((int rootX, int rootY,
			    Tk_Window tkwin));
EXTERN unsigned long	Tk_CreateBinding _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_BindingTable bindingTable, ClientData object,
			    char *eventString, char *command, int append));
EXTERN Tk_BindingTable	Tk_CreateBindingTable _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN Tk_ErrorHandler	Tk_CreateErrorHandler _ANSI_ARGS_((Display *display,
			    int errNum, int request, int minorCode,
			    Tk_ErrorProc *errorProc, ClientData clientData));
EXTERN void		Tk_CreateEventHandler _ANSI_ARGS_((Tk_Window token,
			    unsigned long mask, Tk_EventProc *proc,
			    ClientData clientData));
EXTERN void		Tk_CreateGenericHandler _ANSI_ARGS_((
			    Tk_GenericProc *proc, ClientData clientData));
EXTERN void		Tk_CreateImageType _ANSI_ARGS_((
			    Tk_ImageType *typePtr));
EXTERN void		Tk_CreateItemType _ANSI_ARGS_((Tk_ItemType *typePtr));
EXTERN void		Tk_CreatePhotoImageFormat _ANSI_ARGS_((
			    Tk_PhotoImageFormat *formatPtr));
EXTERN void		Tk_CreateSelHandler _ANSI_ARGS_((Tk_Window tkwin,
			    Atom selection, Atom target,
			    Tk_SelectionProc *proc, ClientData clientData,
			    Atom format));
EXTERN Tk_Window	Tk_CreateWindow _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window parent, char *name, char *screenName));
EXTERN Tk_Window	Tk_CreateWindowFromPath _ANSI_ARGS_((
			    Tcl_Interp *interp, Tk_Window tkwin,
			    char *pathName, char *screenName));
EXTERN int		Tk_DefineBitmap _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Uid name, char *source, int width,
			    int height));
EXTERN void		Tk_DefineCursor _ANSI_ARGS_((Tk_Window window,
			    Tk_Cursor cursor));
EXTERN void		Tk_DeleteAllBindings _ANSI_ARGS_((
			    Tk_BindingTable bindingTable, ClientData object));
EXTERN int		Tk_DeleteBinding _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_BindingTable bindingTable, ClientData object,
			    char *eventString));
EXTERN void		Tk_DeleteBindingTable _ANSI_ARGS_((
			    Tk_BindingTable bindingTable));
EXTERN void		Tk_DeleteErrorHandler _ANSI_ARGS_((
			    Tk_ErrorHandler handler));
EXTERN void		Tk_DeleteEventHandler _ANSI_ARGS_((Tk_Window token,
			    unsigned long mask, Tk_EventProc *proc,
			    ClientData clientData));
EXTERN void		Tk_DeleteGenericHandler _ANSI_ARGS_((
			    Tk_GenericProc *proc, ClientData clientData));
EXTERN void		Tk_DeleteImage _ANSI_ARGS_((Tcl_Interp *interp,
			    char *name));
EXTERN void		Tk_DeleteSelHandler _ANSI_ARGS_((Tk_Window tkwin,
			    Atom selection, Atom target));
EXTERN void             Tk_DestroyWindow _ANSI_ARGS_((Tk_Window tkwin));
EXTERN char *		Tk_DisplayName _ANSI_ARGS_((Tk_Window tkwin));
EXTERN int		Tk_DistanceToTextLayout _ANSI_ARGS_((
			    Tk_TextLayout layout, int x, int y));
EXTERN void		Tk_Draw3DPolygon _ANSI_ARGS_((Tk_Window tkwin,
			    Drawable drawable, Tk_3DBorder border,
			    XPoint *pointPtr, int numPoints, int borderWidth,
			    int leftRelief));
EXTERN void		Tk_Draw3DRectangle _ANSI_ARGS_((Tk_Window tkwin,
			    Drawable drawable, Tk_3DBorder border, int x,
			    int y, int width, int height, int borderWidth,
			    int relief));
EXTERN void		Tk_DrawChars _ANSI_ARGS_((Display *display,
			    Drawable drawable, GC gc, Tk_Font tkfont,
			    CONST char *source, int numChars, int x,
			    int y));
EXTERN void		Tk_DrawFocusHighlight _ANSI_ARGS_((Tk_Window tkwin,
			    GC gc, int width, Drawable drawable));
EXTERN void		Tk_DrawTextLayout _ANSI_ARGS_((Display *display,
			    Drawable drawable, GC gc, Tk_TextLayout layout,
			    int x, int y, int firstChar, int lastChar));
EXTERN void		Tk_Fill3DPolygon _ANSI_ARGS_((Tk_Window tkwin,
			    Drawable drawable, Tk_3DBorder border,
			    XPoint *pointPtr, int numPoints, int borderWidth,
			    int leftRelief));
EXTERN void		Tk_Fill3DRectangle _ANSI_ARGS_((Tk_Window tkwin,
			    Drawable drawable, Tk_3DBorder border, int x,
			    int y, int width, int height, int borderWidth,
			    int relief));
EXTERN Tk_PhotoHandle	Tk_FindPhoto _ANSI_ARGS_((Tcl_Interp *interp,
			    char *imageName));
EXTERN Font		Tk_FontId _ANSI_ARGS_((Tk_Font font));
EXTERN void		Tk_Free3DBorder _ANSI_ARGS_((Tk_3DBorder border));
EXTERN void		Tk_FreeBitmap _ANSI_ARGS_((Display *display,
			    Pixmap bitmap));
EXTERN void		Tk_FreeColor _ANSI_ARGS_((XColor *colorPtr));
EXTERN void		Tk_FreeColormap _ANSI_ARGS_((Display *display,
			    Colormap colormap));
EXTERN void		Tk_FreeCursor _ANSI_ARGS_((Display *display,
			    Tk_Cursor cursor));
EXTERN void		Tk_FreeFont _ANSI_ARGS_((Tk_Font));
EXTERN void		Tk_FreeGC _ANSI_ARGS_((Display *display, GC gc));
EXTERN void		Tk_FreeImage _ANSI_ARGS_((Tk_Image image));
EXTERN void		Tk_FreeOptions _ANSI_ARGS_((Tk_ConfigSpec *specs,
			    char *widgRec, Display *display, int needFlags));
EXTERN void		Tk_FreePixmap _ANSI_ARGS_((Display *display,
			    Pixmap pixmap));
EXTERN void		Tk_FreeTextLayout _ANSI_ARGS_((
			    Tk_TextLayout textLayout));
EXTERN void		Tk_FreeXId _ANSI_ARGS_((Display *display, XID xid));
EXTERN GC		Tk_GCForColor _ANSI_ARGS_((XColor *colorPtr,
			    Drawable drawable));
EXTERN void		Tk_GeometryRequest _ANSI_ARGS_((Tk_Window tkwin,
			    int reqWidth,  int reqHeight));
EXTERN Tk_3DBorder	Tk_Get3DBorder _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Tk_Uid colorName));
EXTERN void		Tk_GetAllBindings _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_BindingTable bindingTable, ClientData object));
EXTERN int		Tk_GetAnchor _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, Tk_Anchor *anchorPtr));
EXTERN char *		Tk_GetAtomName _ANSI_ARGS_((Tk_Window tkwin,
			    Atom atom));
EXTERN char *		Tk_GetBinding _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_BindingTable bindingTable, ClientData object,
			    char *eventString));
EXTERN Pixmap		Tk_GetBitmap _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Tk_Uid string));
EXTERN Pixmap		Tk_GetBitmapFromData _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *source,
			    int width, int height));
EXTERN int		Tk_GetCapStyle _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, int *capPtr));
EXTERN XColor *		Tk_GetColor _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Tk_Uid name));
EXTERN XColor *		Tk_GetColorByValue _ANSI_ARGS_((Tk_Window tkwin,
			    XColor *colorPtr));
EXTERN Colormap		Tk_GetColormap _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *string));
EXTERN Tk_Cursor	Tk_GetCursor _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Tk_Uid string));
EXTERN Tk_Cursor	Tk_GetCursorFromData _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *source, char *mask,
			    int width, int height, int xHot, int yHot,
			    Tk_Uid fg, Tk_Uid bg));
EXTERN Tk_Font		Tk_GetFont _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, CONST char *string));
EXTERN Tk_Font		Tk_GetFontFromObj _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Tcl_Obj *objPtr));
EXTERN void		Tk_GetFontMetrics _ANSI_ARGS_((Tk_Font font,
			    Tk_FontMetrics *fmPtr));
EXTERN GC		Tk_GetGC _ANSI_ARGS_((Tk_Window tkwin,
			    unsigned long valueMask, XGCValues *valuePtr));
EXTERN Tk_Image		Tk_GetImage _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *name,
			    Tk_ImageChangedProc *changeProc,
			    ClientData clientData));
EXTERN ClientData	Tk_GetImageMasterData _ANSI_ARGS_ ((Tcl_Interp *interp,
			    char *name, Tk_ImageType **typePtrPtr));
EXTERN Tk_ItemType *	Tk_GetItemTypes _ANSI_ARGS_((void));
EXTERN int		Tk_GetJoinStyle _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, int *joinPtr));
EXTERN int		Tk_GetJustify _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, Tk_Justify *justifyPtr));
EXTERN int		Tk_GetNumMainWindows _ANSI_ARGS_((void));
EXTERN Tk_Uid		Tk_GetOption _ANSI_ARGS_((Tk_Window tkwin, char *name,
			    char *className));
EXTERN int		Tk_GetPixels _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *string, int *intPtr));
EXTERN Pixmap		Tk_GetPixmap _ANSI_ARGS_((Display *display, Drawable d,
			    int width, int height, int depth));
EXTERN int		Tk_GetRelief _ANSI_ARGS_((Tcl_Interp *interp,
			    char *name, int *reliefPtr));
EXTERN void		Tk_GetRootCoords _ANSI_ARGS_ ((Tk_Window tkwin,
			    int *xPtr, int *yPtr));
EXTERN int		Tk_GetScrollInfo _ANSI_ARGS_((Tcl_Interp *interp,
			    int argc, char **argv, double *dblPtr,
			    int *intPtr));
EXTERN int		Tk_GetScreenMM _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *string, double *doublePtr));
EXTERN int		Tk_GetSelection _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Atom selection, Atom target,
			    Tk_GetSelProc *proc, ClientData clientData));
EXTERN Tk_Uid		Tk_GetUid _ANSI_ARGS_((CONST char *string));
EXTERN Visual *		Tk_GetVisual _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *string, int *depthPtr,
			    Colormap *colormapPtr));
EXTERN void		Tk_GetVRootGeometry _ANSI_ARGS_((Tk_Window tkwin,
			    int *xPtr, int *yPtr, int *widthPtr,
			    int *heightPtr));
EXTERN int		Tk_Grab _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, int grabGlobal));
EXTERN void		Tk_HandleEvent _ANSI_ARGS_((XEvent *eventPtr));
EXTERN Tk_Window      	Tk_IdToWindow _ANSI_ARGS_((Display *display,
			    Window window));
EXTERN void		Tk_ImageChanged _ANSI_ARGS_((
			    Tk_ImageMaster master, int x, int y,
			    int width, int height, int imageWidth,
			    int imageHeight));
EXTERN int		Tk_Init _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN Atom		Tk_InternAtom _ANSI_ARGS_((Tk_Window tkwin,
			    char *name));
EXTERN int		Tk_IntersectTextLayout _ANSI_ARGS_((
			    Tk_TextLayout layout, int x, int y, int width,
			    int height));
EXTERN void		Tk_Main _ANSI_ARGS_((int argc, char **argv,
			    Tcl_AppInitProc *appInitProc));
EXTERN void		Tk_MainLoop _ANSI_ARGS_((void));
EXTERN void		Tk_MaintainGeometry _ANSI_ARGS_((Tk_Window slave,
			    Tk_Window master, int x, int y, int width,
			    int height));
EXTERN Tk_Window	Tk_MainWindow _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN void		Tk_MakeWindowExist _ANSI_ARGS_((Tk_Window tkwin));
EXTERN void		Tk_ManageGeometry _ANSI_ARGS_((Tk_Window tkwin,
			    Tk_GeomMgr *mgrPtr, ClientData clientData));
EXTERN void		Tk_MapWindow _ANSI_ARGS_((Tk_Window tkwin));
EXTERN int		Tk_MeasureChars _ANSI_ARGS_((Tk_Font tkfont,
			    CONST char *source, int maxChars, int maxPixels,
			    int flags, int *lengthPtr));
EXTERN void		Tk_MoveResizeWindow _ANSI_ARGS_((Tk_Window tkwin,
			    int x, int y, int width, int height));
EXTERN void		Tk_MoveWindow _ANSI_ARGS_((Tk_Window tkwin, int x,
			    int y));
EXTERN void		Tk_MoveToplevelWindow _ANSI_ARGS_((Tk_Window tkwin,
			    int x, int y));
EXTERN char *		Tk_NameOf3DBorder _ANSI_ARGS_((Tk_3DBorder border));
EXTERN char *		Tk_NameOfAnchor _ANSI_ARGS_((Tk_Anchor anchor));
EXTERN char *		Tk_NameOfBitmap _ANSI_ARGS_((Display *display,
			    Pixmap bitmap));
EXTERN char *		Tk_NameOfCapStyle _ANSI_ARGS_((int cap));
EXTERN char *		Tk_NameOfColor _ANSI_ARGS_((XColor *colorPtr));
EXTERN char *		Tk_NameOfCursor _ANSI_ARGS_((Display *display,
			    Tk_Cursor cursor));
EXTERN char *		Tk_NameOfFont _ANSI_ARGS_((Tk_Font font));
EXTERN char *		Tk_NameOfImage _ANSI_ARGS_((
			    Tk_ImageMaster imageMaster));
EXTERN char *		Tk_NameOfJoinStyle _ANSI_ARGS_((int join));
EXTERN char *		Tk_NameOfJustify _ANSI_ARGS_((Tk_Justify justify));
EXTERN char *		Tk_NameOfRelief _ANSI_ARGS_((int relief));
EXTERN Tk_Window	Tk_NameToWindow _ANSI_ARGS_((Tcl_Interp *interp,
			    char *pathName, Tk_Window tkwin));
EXTERN void		Tk_OwnSelection _ANSI_ARGS_((Tk_Window tkwin,
			    Atom selection, Tk_LostSelProc *proc,
			    ClientData clientData));
EXTERN int		Tk_ParseArgv _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, int *argcPtr, char **argv,
			    Tk_ArgvInfo *argTable, int flags));
EXTERN void		Tk_PhotoPutBlock _ANSI_ARGS_((Tk_PhotoHandle handle,
			    Tk_PhotoImageBlock *blockPtr, int x, int y,
			    int width, int height));
EXTERN void		Tk_PhotoPutZoomedBlock _ANSI_ARGS_((
			    Tk_PhotoHandle handle,
			    Tk_PhotoImageBlock *blockPtr, int x, int y,
			    int width, int height, int zoomX, int zoomY,
			    int subsampleX, int subsampleY));
EXTERN int		Tk_PhotoGetImage _ANSI_ARGS_((Tk_PhotoHandle handle,
			    Tk_PhotoImageBlock *blockPtr));
EXTERN void		Tk_PhotoBlank _ANSI_ARGS_((Tk_PhotoHandle handle));
EXTERN void		Tk_PhotoExpand _ANSI_ARGS_((Tk_PhotoHandle handle,
			    int width, int height ));
EXTERN void		Tk_PhotoGetSize _ANSI_ARGS_((Tk_PhotoHandle handle,
			    int *widthPtr, int *heightPtr));
EXTERN void		Tk_PhotoSetSize _ANSI_ARGS_((Tk_PhotoHandle handle,
			    int width, int height));
EXTERN int		Tk_PointToChar _ANSI_ARGS_((Tk_TextLayout layout,
			    int x, int y));
EXTERN int		Tk_PostscriptFontName _ANSI_ARGS_((Tk_Font tkfont,
			    Tcl_DString *dsPtr));
EXTERN void		Tk_PreserveColormap _ANSI_ARGS_((Display *display,
			    Colormap colormap));
EXTERN void		Tk_QueueWindowEvent _ANSI_ARGS_((XEvent *eventPtr,
			    Tcl_QueuePosition position));
EXTERN void		Tk_RedrawImage _ANSI_ARGS_((Tk_Image image, int imageX,
			    int imageY, int width, int height,
			    Drawable drawable, int drawableX, int drawableY));
EXTERN void		Tk_ResizeWindow _ANSI_ARGS_((Tk_Window tkwin,
			    int width, int height));
EXTERN int		Tk_RestackWindow _ANSI_ARGS_((Tk_Window tkwin,
			    int aboveBelow, Tk_Window other));
EXTERN Tk_RestrictProc *Tk_RestrictEvents _ANSI_ARGS_((Tk_RestrictProc *proc,
			    ClientData arg, ClientData *prevArgPtr));
EXTERN int		Tk_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN char *		Tk_SetAppName _ANSI_ARGS_((Tk_Window tkwin,
			    char *name));
EXTERN void		Tk_SetBackgroundFromBorder _ANSI_ARGS_((
			    Tk_Window tkwin, Tk_3DBorder border));
EXTERN void		Tk_SetClass _ANSI_ARGS_((Tk_Window tkwin,
			    char *className));
EXTERN void		Tk_SetGrid _ANSI_ARGS_((Tk_Window tkwin,
			    int reqWidth, int reqHeight, int gridWidth,
			    int gridHeight));
EXTERN void		Tk_SetInternalBorder _ANSI_ARGS_((Tk_Window tkwin,
			    int width));
EXTERN void		Tk_SetWindowBackground _ANSI_ARGS_((Tk_Window tkwin,
			    unsigned long pixel));
EXTERN void		Tk_SetWindowBackgroundPixmap _ANSI_ARGS_((
			    Tk_Window tkwin, Pixmap pixmap));
EXTERN void		Tk_SetWindowBorder _ANSI_ARGS_((Tk_Window tkwin,
			    unsigned long pixel));
EXTERN void		Tk_SetWindowBorderWidth _ANSI_ARGS_((Tk_Window tkwin,
			    int width));
EXTERN void		Tk_SetWindowBorderPixmap _ANSI_ARGS_((Tk_Window tkwin,
			    Pixmap pixmap));
EXTERN void		Tk_SetWindowColormap _ANSI_ARGS_((Tk_Window tkwin,
			    Colormap colormap));
EXTERN int		Tk_SetWindowVisual _ANSI_ARGS_((Tk_Window tkwin,
			    Visual *visual, int depth,
			    Colormap colormap));
EXTERN void		Tk_SizeOfBitmap _ANSI_ARGS_((Display *display,
			    Pixmap bitmap, int *widthPtr,
			    int *heightPtr));
EXTERN void		Tk_SizeOfImage _ANSI_ARGS_((Tk_Image image,
			    int *widthPtr, int *heightPtr));
EXTERN int		Tk_StrictMotif _ANSI_ARGS_((Tk_Window tkwin));
EXTERN void		Tk_TextLayoutToPostscript _ANSI_ARGS_((
			    Tcl_Interp *interp, Tk_TextLayout layout));
EXTERN int		Tk_TextWidth _ANSI_ARGS_((Tk_Font font,
			    CONST char *string, int numChars));
EXTERN void		Tk_UndefineCursor _ANSI_ARGS_((Tk_Window window));
EXTERN void		Tk_UnderlineChars _ANSI_ARGS_((Display *display,
			    Drawable drawable, GC gc, Tk_Font tkfont,
			    CONST char *source, int x, int y, int firstChar,
			    int lastChar));
EXTERN void		Tk_UnderlineTextLayout _ANSI_ARGS_((
			    Display *display, Drawable drawable, GC gc,
			    Tk_TextLayout layout, int x, int y,
			    int underline));
EXTERN void		Tk_Ungrab _ANSI_ARGS_((Tk_Window tkwin));
EXTERN void		Tk_UnmaintainGeometry _ANSI_ARGS_((Tk_Window slave,
			    Tk_Window master));
EXTERN void		Tk_UnmapWindow _ANSI_ARGS_((Tk_Window tkwin));
EXTERN void		Tk_UnsetGrid _ANSI_ARGS_((Tk_Window tkwin));
EXTERN void		Tk_UpdatePointer _ANSI_ARGS_((Tk_Window tkwin,
			    int x, int y, int state));

/*
 * Tcl commands exported by Tk:
 */

EXTERN int		Tk_AfterCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_BellCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_BindCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_BindtagsCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_ButtonCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_CanvasCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_CheckbuttonCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_ClipboardCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int              Tk_ChooseColorCmd _ANSI_ARGS_((ClientData clientData,
                            Tcl_Interp *interp, int argc, char **argv));
EXTERN int              Tk_ChooseFontCmd _ANSI_ARGS_((ClientData clientData,
                            Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_DestroyCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_EntryCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_EventCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_FileeventCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_FrameCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_FocusCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_FontObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
EXTERN int              Tk_GetOpenFileCmd _ANSI_ARGS_((ClientData clientData,
                            Tcl_Interp *interp, int argc, char **argv));
EXTERN int              Tk_GetSaveFileCmd _ANSI_ARGS_((ClientData clientData,
                            Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_GrabCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_GridCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_ImageCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_LabelCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_ListboxCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_LowerCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_MenuCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_MenubuttonCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int              Tk_MessageBoxCmd _ANSI_ARGS_((ClientData clientData,
                            Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_MessageCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_OptionCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_PackCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_PlaceCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_RadiobuttonCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_RaiseCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_ScaleCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_ScrollbarCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_SelectionCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_SendCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_TextCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_TkObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
EXTERN int		Tk_TkwaitCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_ToplevelCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_UpdateCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_WinfoObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
EXTERN int		Tk_WmCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));

#endif /* RESOURCE_INCLUDED */




#endif /* _TK */







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





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


>
>
>
>

1195
1196
1197
1198
1199
1200
1201





















1202































































































































































































































































































































































































1203
1204
1205
1206
1207





























































































1208
1209
1210
1211
1212
1213
1214
 *--------------------------------------------------------------
 *
 * Exported procedures and variables.
 *
 *--------------------------------------------------------------
 */






















#include "tkDecls.h"
































































































































































































































































































































































































/*
 * Tcl commands exported by Tk:
 */































































































#endif /* RESOURCE_INCLUDED */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TK */

Changes to generic/tk3d.c.

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
/* 
 * tk3d.c --
 *
 *	This module provides procedures to draw borders in
 *	the three-dimensional Motif style.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tk3d.c 1.60 97/01/13 17:23:10
 */

#include <tk3d.h>

/*
 * Hash table to map from a border's values (color, etc.) to a
 * Border structure for those values.
 */

static Tcl_HashTable borderTable;
typedef struct {
    Tk_Uid colorName;		/* Color for border. */
    Colormap colormap;		/* Colormap used for allocating border
				 * colors. */
    Screen *screen;		/* Screen on which border will be drawn. */
} BorderKey;

static int initialized = 0;	/* 0 means static structures haven't
				 * been initialized yet. */

/*
 * Forward declarations for procedures defined in this file:
 */

static void		BorderInit _ANSI_ARGS_((void));



static int		Intersect _ANSI_ARGS_((XPoint *a1Ptr, XPoint *a2Ptr,
			    XPoint *b1Ptr, XPoint *b2Ptr, XPoint *iPtr));

static void		ShiftLine _ANSI_ARGS_((XPoint *p1Ptr, XPoint *p2Ptr,
			    int distance, XPoint *p3Ptr));


























































































































/*
 *--------------------------------------------------------------
 *
 * Tk_Get3DBorder --
 *
 *	Create a data structure for displaying a 3-D border.
 *
 * Results:
 *	The return value is a token for a data structure
 *	describing a 3-D border.  This token may be passed
 *	to Tk_Draw3DRectangle and Tk_Free3DBorder.  If an
 *	error prevented the border from being created then
 *	NULL is returned and an error message will be left
 *	in interp->result.
 *
 * Side effects:
 *	Data structures, graphics contexts, etc. are allocated.
 *	It is the caller's responsibility to eventually call
 *	Tk_Free3DBorder to release the resources.
 *
 *--------------------------------------------------------------
 */

Tk_3DBorder
Tk_Get3DBorder(interp, tkwin, colorName)
    Tcl_Interp *interp;		/* Place to store an error message. */
    Tk_Window tkwin;		/* Token for window in which border will
				 * be drawn. */
    Tk_Uid colorName;		/* String giving name of color
				 * for window background. */
{
    BorderKey key;
    Tcl_HashEntry *hashPtr;
    register TkBorder *borderPtr;
    int new;
    XGCValues gcValues;

    if (!initialized) {
	BorderInit();

    }


    /*
     * First, check to see if there's already a border that will work
     * for this request.
     */

    key.colorName = colorName;
    key.colormap = Tk_Colormap(tkwin);
    key.screen = Tk_Screen(tkwin);

    hashPtr = Tcl_CreateHashEntry(&borderTable, (char *) &key, &new);
    if (!new) {
	borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr);




	borderPtr->refCount++;



    } else {
	XColor *bgColorPtr;


	/*
	 * No satisfactory border exists yet.  Initialize a new one.
	 */
    
	bgColorPtr = Tk_GetColor(interp, tkwin, colorName);
	if (bgColorPtr == NULL) {

	    Tcl_DeleteHashEntry(hashPtr);

	    return NULL;
	}

	borderPtr = TkpGetBorder();
	borderPtr->screen = Tk_Screen(tkwin);
	borderPtr->visual = Tk_Visual(tkwin);
	borderPtr->depth = Tk_Depth(tkwin);
	borderPtr->colormap = key.colormap;
	borderPtr->refCount = 1;

	borderPtr->bgColorPtr = bgColorPtr;
	borderPtr->darkColorPtr = NULL;
	borderPtr->lightColorPtr = NULL;
	borderPtr->shadow = None;
	borderPtr->bgGC = None;
	borderPtr->darkGC = None;
	borderPtr->lightGC = None;
	borderPtr->hashPtr = hashPtr;

	Tcl_SetHashValue(hashPtr, borderPtr);
    
	/*
	 * Create the information for displaying the background color,
	 * but delay the allocation of shadows until they are actually
	 * needed for drawing.
	 */
    
	gcValues.foreground = borderPtr->bgColorPtr->pixel;
	borderPtr->bgGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
    }
    return (Tk_3DBorder) borderPtr;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_Draw3DRectangle --












|


|


|
|


|
<
<
<
<
<
<
|
<
<





|
>
>
>


>


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









|
|
|
|
|
<














|


<

|


|
<
<
>
|
>

<
|
|
<
|
<
<
<

|

|
>
>
>
>
|
>
>
>

|
|
>
|
|
|
|
|
|
>

>
|
|

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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23






24


25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173

174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190

191
192
193
194
195


196
197
198
199

200
201

202



203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256

257
258
259
260
261
262
263
/* 
 * tk3d.c --
 *
 *	This module provides procedures to draw borders in
 *	the three-dimensional Motif style.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tk3d.c,v 1.1.4.4 1998/12/13 08:16:00 lfb Exp $
 */

#include "tk3d.h"

/*
 * The following table defines the string values for reliefs, which are
 * used by Tk_GetReliefFromObj.
 */

static char *reliefStrings[] = {"flat", "groove", "raised", "ridge", "solid",






	"sunken", (char *) NULL};



/*
 * Forward declarations for procedures defined in this file:
 */

static void		BorderInit _ANSI_ARGS_((TkDisplay *dispPtr));
static void		DupBorderObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
			    Tcl_Obj *dupObjPtr));
static void		FreeBorderObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
static int		Intersect _ANSI_ARGS_((XPoint *a1Ptr, XPoint *a2Ptr,
			    XPoint *b1Ptr, XPoint *b2Ptr, XPoint *iPtr));
static void		InitBorderObj _ANSI_ARGS_((Tcl_Obj *objPtr));
static void		ShiftLine _ANSI_ARGS_((XPoint *p1Ptr, XPoint *p2Ptr,
			    int distance, XPoint *p3Ptr));

/*
 * The following structure defines the implementation of the "border" Tcl
 * object, used for drawing. The border object remembers the hash table entry
 * associated with a border. The actual allocation and deallocation of the
 * border should be done by the configuration package when the border option
 * is set.
 */

static Tcl_ObjType borderObjType = {
    "border",			/* name */
    FreeBorderObjProc,		/* freeIntRepProc */
    DupBorderObjProc,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL			/* setFromAnyProc */
};

/*
 *----------------------------------------------------------------------
 *
 * Tk_Alloc3DBorderFromObj --
 *
 *	Given a Tcl_Obj *, map the value to a corresponding
 *	Tk_3DBorder structure based on the tkwin given.
 *
 * Results:
 *	The return value is a token for a data structure describing a
 *	3-D border.  This token may be passed to procedures such as
 *	Tk_Draw3DRectangle and Tk_Free3DBorder.  If an error prevented
 *	the border from being created then NULL is returned and an error
 *	message will be left in the interp's result.
 *
 * Side effects:
 *	The border is added to an internal database with a reference
 *	count. For each call to this procedure, there should eventually
 *	be a call to Tk_FreeBorderFromObj so that the database is
 *	cleaned up when borders aren't in use anymore.
 *
 *----------------------------------------------------------------------
 */

Tk_3DBorder
Tk_Alloc3DBorderFromObj(interp, tkwin, objPtr)
    Tcl_Interp *interp;		/* Interp for error results. */
    Tk_Window tkwin;		/* Need the screen the border is used on.*/
    Tcl_Obj *objPtr;		/* Object giving name of color for window
				 * background. */
{
    TkBorder *borderPtr;

    if (objPtr->typePtr != &borderObjType) {
	InitBorderObj(objPtr);
    }
    borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1;

    /*
     * If the object currently points to a TkBorder, see if it's the
     * one we want.  If so, increment its reference count and return.
     */

    if (borderPtr != NULL) {
	if (borderPtr->resourceRefCount == 0) {
	    /*
	     * This is a stale reference: it refers to a border that's
	     * no longer in use.  Clear the reference.
	     */

	    FreeBorderObjProc(objPtr);
	    borderPtr = NULL;
	} else if ((Tk_Screen(tkwin) == borderPtr->screen)
		&& (Tk_Colormap(tkwin) == borderPtr->colormap)) {
	    borderPtr->resourceRefCount++;
	    return (Tk_3DBorder) borderPtr;
	}
    }

    /*
     * The object didn't point to the border that we wanted.  Search
     * the list of borders with the same name to see if one of the
     * others is the right one.
     */

    /*
     * If the cached value is NULL, either the object type was not a
     * color going in, or the object is a color type but had
     * previously been freed.
     *
     * If the value is not NULL, the internal rep is the value
     * of the color the last time this object was accessed. Check
     * the screen and colormap of the last access, and if they
     * match, we are done.
     */

    if (borderPtr != NULL) {
	TkBorder *firstBorderPtr = 
		(TkBorder *) Tcl_GetHashValue(borderPtr->hashPtr);
	FreeBorderObjProc(objPtr);
	for (borderPtr = firstBorderPtr ; borderPtr != NULL;
		borderPtr = borderPtr->nextPtr) {
	    if ((Tk_Screen(tkwin) == borderPtr->screen)
		&& (Tk_Colormap(tkwin) == borderPtr->colormap)) {
		borderPtr->resourceRefCount++;
		borderPtr->objRefCount++;
		objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;
		return (Tk_3DBorder) borderPtr;
	    }
	}
    }

    /*
     * Still no luck.  Call Tk_Get3DBorder to allocate a new border.
     */

    borderPtr = (TkBorder *) Tk_Get3DBorder(interp, tkwin,
	    Tcl_GetString(objPtr));
    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;
    if (borderPtr != NULL) {
	borderPtr->objRefCount++;
    }
    return (Tk_3DBorder) borderPtr;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_Get3DBorder --
 *
 *	Create a data structure for displaying a 3-D border.
 *
 * Results:
 *	The return value is a token for a data structure describing a
 *	3-D border.  This token may be passed to procedures such as
 *	Tk_Draw3DRectangle and Tk_Free3DBorder.  If an error prevented
 *	the border from being created then NULL is returned and an error
 *	message will be left in the interp's result.

 *
 * Side effects:
 *	Data structures, graphics contexts, etc. are allocated.
 *	It is the caller's responsibility to eventually call
 *	Tk_Free3DBorder to release the resources.
 *
 *--------------------------------------------------------------
 */

Tk_3DBorder
Tk_Get3DBorder(interp, tkwin, colorName)
    Tcl_Interp *interp;		/* Place to store an error message. */
    Tk_Window tkwin;		/* Token for window in which border will
				 * be drawn. */
    char *colorName;		/* String giving name of color
				 * for window background. */
{

    Tcl_HashEntry *hashPtr;
    TkBorder *borderPtr, *existingBorderPtr;
    int new;
    XGCValues gcValues;
    XColor *bgColorPtr;


    TkDisplay *dispPtr;

    dispPtr = ((TkWindow *) tkwin)->dispPtr;


    if (!dispPtr->borderInit) {
	BorderInit(dispPtr);

    }




    hashPtr = Tcl_CreateHashEntry(&dispPtr->borderTable, colorName, &new);
    if (!new) {
	existingBorderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr);
	for (borderPtr = existingBorderPtr; borderPtr != NULL;
		borderPtr = borderPtr->nextPtr) {
	    if ((Tk_Screen(tkwin) == borderPtr->screen)
		    && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
		borderPtr->resourceRefCount++;
		return (Tk_3DBorder) borderPtr;
	    }
	}
    } else {
	existingBorderPtr = NULL;
    }

    /*
     * No satisfactory border exists yet.  Initialize a new one.
     */

    bgColorPtr = Tk_GetColor(interp, tkwin, colorName);
    if (bgColorPtr == NULL) {
	if (new) {
	    Tcl_DeleteHashEntry(hashPtr);
	}
	return NULL;
    }

    borderPtr = TkpGetBorder();
    borderPtr->screen = Tk_Screen(tkwin);
    borderPtr->visual = Tk_Visual(tkwin);
    borderPtr->depth = Tk_Depth(tkwin);
    borderPtr->colormap = Tk_Colormap(tkwin);
    borderPtr->resourceRefCount = 1;
    borderPtr->objRefCount = 0;
    borderPtr->bgColorPtr = bgColorPtr;
    borderPtr->darkColorPtr = NULL;
    borderPtr->lightColorPtr = NULL;
    borderPtr->shadow = None;
    borderPtr->bgGC = None;
    borderPtr->darkGC = None;
    borderPtr->lightGC = None;
    borderPtr->hashPtr = hashPtr;
    borderPtr->nextPtr = existingBorderPtr;
    Tcl_SetHashValue(hashPtr, borderPtr);

    /*
     * Create the information for displaying the background color,
     * but delay the allocation of shadows until they are actually
     * needed for drawing.
     */

    gcValues.foreground = borderPtr->bgColorPtr->pixel;
    borderPtr->bgGC = Tk_GetGC(tkwin, GCForeground, &gcValues);

    return (Tk_3DBorder) borderPtr;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_Draw3DRectangle --
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218

char *
Tk_NameOf3DBorder(border)
    Tk_3DBorder border;		/* Token for border. */
{
    TkBorder *borderPtr = (TkBorder *) border;

    return ((BorderKey *) borderPtr->hashPtr->key.words)->colorName;
}

/*
 *--------------------------------------------------------------------
 *
 * Tk_3DBorderColor --
 *







|







325
326
327
328
329
330
331
332
333
334
335
336
337
338
339

char *
Tk_NameOf3DBorder(border)
    Tk_3DBorder border;		/* Token for border. */
{
    TkBorder *borderPtr = (TkBorder *) border;

    return borderPtr->hashPtr->key.string;
}

/*
 *--------------------------------------------------------------------
 *
 * Tk_3DBorderColor --
 *
299
300
301
302
303
304
305
306
307

308
309
310




311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332


333










334
335
336



































































































337
338
339
340
341
342
343
 *--------------------------------------------------------------
 */

void
Tk_Free3DBorder(border)
    Tk_3DBorder border;		/* Token for border to be released. */
{
    register TkBorder *borderPtr = (TkBorder *) border;
    Display *display = DisplayOfScreen(borderPtr->screen);


    borderPtr->refCount--;
    if (borderPtr->refCount == 0) {




	TkpFreeBorder(borderPtr);
	if (borderPtr->bgColorPtr != NULL) {
	    Tk_FreeColor(borderPtr->bgColorPtr);
	}
	if (borderPtr->darkColorPtr != NULL) {
	    Tk_FreeColor(borderPtr->darkColorPtr);
	}
	if (borderPtr->lightColorPtr != NULL) {
	    Tk_FreeColor(borderPtr->lightColorPtr);
	}
	if (borderPtr->shadow != None) {
	    Tk_FreeBitmap(display, borderPtr->shadow);
	}
	if (borderPtr->bgGC != None) {
	    Tk_FreeGC(display, borderPtr->bgGC);
	}
	if (borderPtr->darkGC != None) {
	    Tk_FreeGC(display, borderPtr->darkGC);
	}
	if (borderPtr->lightGC != None) {
	    Tk_FreeGC(display, borderPtr->lightGC);
	}


	Tcl_DeleteHashEntry(borderPtr->hashPtr);










	ckfree((char *) borderPtr);
    }
}




































































































/*
 *----------------------------------------------------------------------
 *
 * Tk_SetBackgroundFromBorder --
 *
 *	Change the background of a window to one appropriate for a given







|

>

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



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







420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
 *--------------------------------------------------------------
 */

void
Tk_Free3DBorder(border)
    Tk_3DBorder border;		/* Token for border to be released. */
{
    TkBorder *borderPtr = (TkBorder *) border;
    Display *display = DisplayOfScreen(borderPtr->screen);
    TkBorder *prevPtr;

    borderPtr->resourceRefCount--;
    if (borderPtr->resourceRefCount > 0) {
	return;
    }

    prevPtr = (TkBorder *) Tcl_GetHashValue(borderPtr->hashPtr);
    TkpFreeBorder(borderPtr);
    if (borderPtr->bgColorPtr != NULL) {
	Tk_FreeColor(borderPtr->bgColorPtr);
    }
    if (borderPtr->darkColorPtr != NULL) {
	Tk_FreeColor(borderPtr->darkColorPtr);
    }
    if (borderPtr->lightColorPtr != NULL) {
	Tk_FreeColor(borderPtr->lightColorPtr);
    }
    if (borderPtr->shadow != None) {
	Tk_FreeBitmap(display, borderPtr->shadow);
    }
    if (borderPtr->bgGC != None) {
	Tk_FreeGC(display, borderPtr->bgGC);
    }
    if (borderPtr->darkGC != None) {
	Tk_FreeGC(display, borderPtr->darkGC);
    }
    if (borderPtr->lightGC != None) {
	Tk_FreeGC(display, borderPtr->lightGC);
    }
    if (prevPtr == borderPtr) {
	if (borderPtr->nextPtr == NULL) {
	    Tcl_DeleteHashEntry(borderPtr->hashPtr);
	} else {
	    Tcl_SetHashValue(borderPtr->hashPtr, borderPtr->nextPtr);
	}
    } else {
	while (prevPtr->nextPtr != borderPtr) {
	    prevPtr = prevPtr->nextPtr;
	}
	prevPtr->nextPtr = borderPtr->nextPtr;
    }
    if (borderPtr->objRefCount == 0) {
	ckfree((char *) borderPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_Free3DBorderFromObj --
 *
 *	This procedure is called to release a border allocated by
 *	Tk_Alloc3DBorderFromObj. It does not throw away the Tcl_Obj *;
 *	it only gets rid of the hash table entry for this border
 *	and clears the cached value that is normally stored in the object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The reference count associated with the border represented by
 *	objPtr is decremented, and the border's resources are released 
 *	to X if there are no remaining uses for it.
 *
 *----------------------------------------------------------------------
 */

void
Tk_Free3DBorderFromObj(tkwin, objPtr)
    Tk_Window tkwin;		/* The window this border lives in. Needed
				 * for the screen and colormap values. */
    Tcl_Obj *objPtr;		/* The Tcl_Obj * to be freed. */
{
    Tk_Free3DBorder(Tk_Get3DBorderFromObj(tkwin, objPtr));
}

/*
 *---------------------------------------------------------------------------
 *
 * FreeBorderObjProc -- 
 *
 *	This proc is called to release an object reference to a border.
 *	Called when the object's internal rep is released or when
 *	the cached borderPtr needs to be changed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object reference count is decremented. When both it
 *	and the hash ref count go to zero, the border's resources
 *	are released.
 *
 *---------------------------------------------------------------------------
 */

static void
FreeBorderObjProc(objPtr)
    Tcl_Obj *objPtr;		/* The object we are releasing. */
{
    TkBorder *borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1;

    if (borderPtr != NULL) {
	borderPtr->objRefCount--;
	if ((borderPtr->objRefCount == 0) 
		&& (borderPtr->resourceRefCount == 0)) {
	    ckfree((char *) borderPtr);
	}
	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * DupBorderObjProc -- 
 *
 *	When a cached border object is duplicated, this is called to
 *	update the internal reps.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The border's objRefCount is incremented and the internal rep
 *	of the copy is set to point to it.
 *
 *---------------------------------------------------------------------------
 */

static void
DupBorderObjProc(srcObjPtr, dupObjPtr)
    Tcl_Obj *srcObjPtr;		/* The object we are copying from. */
    Tcl_Obj *dupObjPtr;		/* The object we are copying to. */
{
    TkBorder *borderPtr = (TkBorder *) srcObjPtr->internalRep.twoPtrValue.ptr1;
    
    dupObjPtr->typePtr = srcObjPtr->typePtr;
    dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;

    if (borderPtr != NULL) {
	borderPtr->objRefCount++;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_SetBackgroundFromBorder --
 *
 *	Change the background of a window to one appropriate for a given
357
358
359
360
361
362
363





























364
365
366
367
368
369
370
    Tk_Window tkwin;		/* Window whose background is to be set. */
    Tk_3DBorder border;		/* Token for border. */
{
    register TkBorder *borderPtr = (TkBorder *) border;

    Tk_SetWindowBackground(tkwin, borderPtr->bgColorPtr->pixel);
}






























/*
 *----------------------------------------------------------------------
 *
 * Tk_GetRelief --
 *
 *	Parse a relief description and return the corresponding







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







594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
    Tk_Window tkwin;		/* Window whose background is to be set. */
    Tk_3DBorder border;		/* Token for border. */
{
    register TkBorder *borderPtr = (TkBorder *) border;

    Tk_SetWindowBackground(tkwin, borderPtr->bgColorPtr->pixel);
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetReliefFromObj --
 *
 *	Return an integer value based on the value of the objPtr.
 *
 * Results:
 *	The return value is a standard Tcl result. If an error occurs during
 *	conversion, an error message is left in the interpreter's result
 *	unless "interp" is NULL.
 *
 * Side effects:
 *	The object gets converted by Tcl_GetIndexFromObj.
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetReliefFromObj(interp, objPtr, resultPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    Tcl_Obj *objPtr;		/* The object we are trying to get the 
				 * value from. */
    int *resultPtr;		/* Where to place the answer. */
{
    return Tcl_GetIndexFromObj(interp, objPtr, reliefStrings, "relief", 0, 
	    resultPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetRelief --
 *
 *	Parse a relief description and return the corresponding
403
404
405
406
407
408
409


410
411

412
413
414
415
416
417
418
    } else if ((c == 'r') && (strncmp(name, "ridge", length) == 0)) {
        *reliefPtr = TK_RELIEF_RIDGE;
    } else if ((c == 's') && (strncmp(name, "solid", length) == 0)) {
	*reliefPtr = TK_RELIEF_SOLID;
    } else if ((c == 's') && (strncmp(name, "sunken", length) == 0)) {
	*reliefPtr = TK_RELIEF_SUNKEN;
    } else {


	sprintf(interp->result, "bad relief type \"%.50s\": must be %s",
		name, "flat, groove, raised, ridge, solid, or sunken");

	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------







>
>
|

>







669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
    } else if ((c == 'r') && (strncmp(name, "ridge", length) == 0)) {
        *reliefPtr = TK_RELIEF_RIDGE;
    } else if ((c == 's') && (strncmp(name, "solid", length) == 0)) {
	*reliefPtr = TK_RELIEF_SOLID;
    } else if ((c == 's') && (strncmp(name, "sunken", length) == 0)) {
	*reliefPtr = TK_RELIEF_SUNKEN;
    } else {
	char buf[200];

	sprintf(buf, "bad relief type \"%.50s\": must be %s",
		name, "flat, groove, raised, ridge, solid, or sunken");
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
778
779
780
781
782
783
784
785

786
787
788
789
790
791
792
793
794
795
 * Side effects:
 *	Read the code.
 *
 *-------------------------------------------------------------
 */

static void
BorderInit()

{
    initialized = 1;
    Tcl_InitHashTable(&borderTable, sizeof(BorderKey)/sizeof(int));
}

/*
 *--------------------------------------------------------------
 *
 * ShiftLine --
 *







|
>

|
|







1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
 * Side effects:
 *	Read the code.
 *
 *-------------------------------------------------------------
 */

static void
BorderInit(dispPtr)
     TkDisplay * dispPtr;     /* Used to access thread-specific data. */
{
    dispPtr->borderInit = 1;
    Tcl_InitHashTable(&dispPtr->borderTable, TCL_STRING_KEYS);
}

/*
 *--------------------------------------------------------------
 *
 * ShiftLine --
 *
943
944
945
946
947
948
949







































































































































































    if (p < 0) {
	iPtr->y = - ((-p + q/2)/q);
    } else {
	iPtr->y = (p + q/2)/q;
    }
    return 0;
}














































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
    if (p < 0) {
	iPtr->y = - ((-p + q/2)/q);
    } else {
	iPtr->y = (p + q/2)/q;
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_Get3DBorderFromObj --
 *
 *	Returns the border referred to by a Tcl object.  The border must
 *	already have been allocated via a call to Tk_Alloc3DBorderFromObj 
 *	or Tk_Get3DBorder.
 *
 * Results:
 *	Returns the Tk_3DBorder that matches the tkwin and the string rep
 *	of the name of the border given in objPtr.
 *
 * Side effects:
 *	If the object is not already a border, the conversion will free
 *	any old internal representation. 
 *
 *----------------------------------------------------------------------
 */

Tk_3DBorder
Tk_Get3DBorderFromObj(tkwin, objPtr)
    Tk_Window tkwin;
    Tcl_Obj *objPtr;		/* The object whose string value selects
				 * a border. */
{
    TkBorder *borderPtr = NULL;
    Tcl_HashEntry *hashPtr;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    if (objPtr->typePtr != &borderObjType) {
	InitBorderObj(objPtr);
    }

    borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1;
    if (borderPtr != NULL) {
	if ((borderPtr->resourceRefCount > 0)
		&& (Tk_Screen(tkwin) == borderPtr->screen)
		&& (Tk_Colormap(tkwin) == borderPtr->colormap)) {
	    /*
	     * The object already points to the right border structure.
	     * Just return it.
	     */

	    return (Tk_3DBorder) borderPtr;
	}
	hashPtr = borderPtr->hashPtr;
	FreeBorderObjProc(objPtr);
    } else {
	hashPtr = Tcl_FindHashEntry(&dispPtr->borderTable, 
                Tcl_GetString(objPtr));
	if (hashPtr == NULL) {
	    goto error;
	}
    }

    /*
     * At this point we've got a hash table entry, off of which hang
     * one or more  TkBorder structures.  See if any of them will work.
     */

    for (borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr);
	    (borderPtr != NULL); borderPtr = borderPtr->nextPtr) {
	if ((Tk_Screen(tkwin) == borderPtr->screen)
		&& (Tk_Colormap(tkwin) == borderPtr->colormap)) {
	    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;
	    borderPtr->objRefCount++;
	    return (Tk_3DBorder) borderPtr;
	}
    }

    error:
    panic("Tk_Get3DBorderFromObj called with non-existent border!");
    /*
     * The following code isn't reached; it's just there to please compilers.
     */
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * InitBorderObj --
 *
 *	Attempt to generate a border internal form for the Tcl object
 *	"objPtr".
 *
 * Results:
 *	The return value is a standard Tcl result. If an error occurs during
 *	conversion, an error message is left in the interpreter's result
 *	unless "interp" is NULL.
 *
 * Side effects:
 *	If no error occurs, a blank internal format for a border value
 *	is intialized. The final form cannot be done without a Tk_Window.
 *
 *----------------------------------------------------------------------
 */

static void
InitBorderObj(objPtr)
    Tcl_Obj *objPtr;		/* The object to convert. */
{
    Tcl_ObjType *typePtr;

    /*
     * Free the old internalRep before setting the new one. 
     */

    Tcl_GetString(objPtr);
    typePtr = objPtr->typePtr;
    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	(*typePtr->freeIntRepProc)(objPtr);
    }
    objPtr->typePtr = &borderObjType;
    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TkDebugBorder --
 *
 *	This procedure returns debugging information about a border.
 *
 * Results:
 *	The return value is a list with one sublist for each TkBorder
 *	corresponding to "name".  Each sublist has two elements that
 *	contain the resourceRefCount and objRefCount fields from the
 *	TkBorder structure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TkDebugBorder(tkwin, name)
    Tk_Window tkwin;		/* The window in which the border will be
				 * used (not currently used). */
    char *name;			/* Name of the desired color. */
{
    TkBorder *borderPtr;
    Tcl_HashEntry *hashPtr;
    Tcl_Obj *resultPtr, *objPtr;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    resultPtr = Tcl_NewObj();
    hashPtr = Tcl_FindHashEntry(&dispPtr->borderTable, name);
    if (hashPtr != NULL) {
	borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr);
	if (borderPtr == NULL) {
	    panic("TkDebugBorder found empty hash table entry");
	}
	for ( ; (borderPtr != NULL); borderPtr = borderPtr->nextPtr) {
	    objPtr = Tcl_NewObj();
	    Tcl_ListObjAppendElement(NULL, objPtr,
		    Tcl_NewIntObj(borderPtr->resourceRefCount));
	    Tcl_ListObjAppendElement(NULL, objPtr,
		    Tcl_NewIntObj(borderPtr->objRefCount)); 
	    Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
	}
    }
    return resultPtr;
}

Changes to generic/tk3d.h.

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
/*
 * tk3d.h --
 *
 *	Declarations of types and functions shared by the 3d border
 *	module.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tk3d.h 1.1 96/11/04 13:52:59
 */

#ifndef _TK3D
#define _TK3D

#include <tkInt.h>






/*
 * One of the following data structures is allocated for
 * each 3-D border currently in use.  Structures of this
 * type are indexed by borderTable, so that a single
 * structure can be shared for several uses.
 */

typedef struct {
    Screen *screen;		/* Screen on which the border will be used. */
    Visual *visual;		/* Visual for all windows and pixmaps using
				 * the border. */
    int depth;			/* Number of bits per pixel of drawables where
				 * the border will be used. */
    Colormap colormap;		/* Colormap out of which pixels are
				 * allocated. */
    int refCount;		/* Number of different users of










				 * this border.  */
    XColor *bgColorPtr;		/* Background color (intensity
				 * between lightColorPtr and
				 * darkColorPtr). */
    XColor *darkColorPtr;	/* Color for darker areas (must free when
				 * deleting structure). NULL means shadows
				 * haven't been allocated yet.*/
    XColor *lightColorPtr;	/* Color used for lighter areas of border






|




|







>
>
>
>
>

|
|
|
|


|







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







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
/*
 * tk3d.h --
 *
 *	Declarations of types and functions shared by the 3d border
 *	module.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tk3d.h,v 1.1.4.2 1998/09/30 02:16:37 stanton Exp $
 */

#ifndef _TK3D
#define _TK3D

#include <tkInt.h>

#ifdef BUILD_tk
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * One of the following data structures is allocated for each 3-D border
 * currently in use.  Structures of this type are indexed by
 * borderTable, so that a single structure can be shared for several
 * uses.
 */

typedef struct TkBorder {
    Screen *screen;		/* Screen on which the border will be used. */
    Visual *visual;		/* Visual for all windows and pixmaps using
				 * the border. */
    int depth;			/* Number of bits per pixel of drawables where
				 * the border will be used. */
    Colormap colormap;		/* Colormap out of which pixels are
				 * allocated. */
    int resourceRefCount;	/* Number of active uses of this color (each
				 * active use corresponds to a call to
				 * Tk_Alloc3DBorderFromObj or Tk_Get3DBorder).
				 * If this count is 0, then this structure
				 * is no longer valid and it isn't present
				 * in borderTable: it is being kept around
				 * only because there are objects referring
				 * to it.  The structure is freed when
				 * resourceRefCount and objRefCount are
				 * both 0. */
    int objRefCount;		/* The number of Tcl objects that reference
				 * this structure. */
    XColor *bgColorPtr;		/* Background color (intensity
				 * between lightColorPtr and
				 * darkColorPtr). */
    XColor *darkColorPtr;	/* Color for darker areas (must free when
				 * deleting structure). NULL means shadows
				 * haven't been allocated yet.*/
    XColor *lightColorPtr;	/* Color used for lighter areas of border
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
				 * border. None means the shadow colors
				 * haven't been allocated yet.*/
    GC lightGC;			/* Used to draw lighter parts of
				 * the border. None means the shadow colors
				 * haven't been allocated yet. */
    Tcl_HashEntry *hashPtr;	/* Entry in borderTable (needed in
				 * order to delete structure). */





} TkBorder;


/*
 * Maximum intensity for a color:
 */

#define MAX_INTENSITY 65535

/*
 * Declarations for platform specific interfaces used by this module.
 */

EXTERN TkBorder *	TkpGetBorder _ANSI_ARGS_((void));
EXTERN void		TkpGetShadows _ANSI_ARGS_((TkBorder *borderPtr,
			    Tk_Window tkwin));
EXTERN void		TkpFreeBorder _ANSI_ARGS_((TkBorder *borderPtr));




#endif /* _TK3D */







>
>
>
>
>


















>
>
>

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
				 * border. None means the shadow colors
				 * haven't been allocated yet.*/
    GC lightGC;			/* Used to draw lighter parts of
				 * the border. None means the shadow colors
				 * haven't been allocated yet. */
    Tcl_HashEntry *hashPtr;	/* Entry in borderTable (needed in
				 * order to delete structure). */
    struct TkBorder *nextPtr;	/* Points to the next TkBorder structure with
				 * the same color name.  Borders with the
				 * same name but different screens or
				 * colormaps are chained together off a
				 * single entry in borderTable. */
} TkBorder;


/*
 * Maximum intensity for a color:
 */

#define MAX_INTENSITY 65535

/*
 * Declarations for platform specific interfaces used by this module.
 */

EXTERN TkBorder *	TkpGetBorder _ANSI_ARGS_((void));
EXTERN void		TkpGetShadows _ANSI_ARGS_((TkBorder *borderPtr,
			    Tk_Window tkwin));
EXTERN void		TkpFreeBorder _ANSI_ARGS_((TkBorder *borderPtr));

# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TK3D */

Changes to generic/tkArgv.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkArgv.c --
 *
 *	This file contains a procedure that handles table-based
 *	argv-argc parsing.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkArgv.c 1.21 97/04/25 16:50:27
 */

#include "tkPort.h"
#include "tk.h"

/*
 * Default table of argument descriptors.  These are normally available







|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkArgv.c --
 *
 *	This file contains a procedure that handles table-based
 *	argv-argc parsing.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkArgv.c,v 1.1.4.2 1998/09/30 02:16:37 stanton Exp $
 */

#include "tkPort.h"
#include "tk.h"

/*
 * Default table of argument descriptors.  These are normally available
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 * Tk_ParseArgv --
 *
 *	Process an argv array according to a table of expected
 *	command-line options.  See the manual page for more details.
 *
 * Results:
 *	The return value is a standard Tcl return value.  If an
 *	error occurs then an error message is left in interp->result.
 *	Under normal conditions, both *argcPtr and *argv are modified
 *	to return the arguments that couldn't be processed here (they
 *	didn't match the option table, or followed an TK_ARGV_REST
 *	argument).
 *
 * Side effects:
 *	Variables may be modified, resources may be entered for tkwin,







|







41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 * Tk_ParseArgv --
 *
 *	Process an argv array according to a table of expected
 *	command-line options.  See the manual page for more details.
 *
 * Results:
 *	The return value is a standard Tcl return value.  If an
 *	error occurs then an error message is left in the interp's result.
 *	Under normal conditions, both *argcPtr and *argv are modified
 *	to return the arguments that couldn't be processed here (they
 *	didn't match the option table, or followed an TK_ARGV_REST
 *	argument).
 *
 * Side effects:
 *	Variables may be modified, resources may be entered for tkwin,
287
288
289
290
291
292
293
294


295
296

297

298
299
300
301
302
303
304
		    return TCL_ERROR;
		}
		Tk_AddOption(tkwin, argv[srcIndex], argv[srcIndex+1],
			TK_INTERACTIVE_PRIO);
		srcIndex += 2;
		argc -= 2;
		break;
	    default:


		sprintf(interp->result, "bad argument type %d in Tk_ArgvInfo",
			infoPtr->type);

		return TCL_ERROR;

	}
    }

    /*
     * If we broke out of the loop because of an OPT_REST argument,
     * copy the remaining arguments down.
     */







|
>
>
|

>

>







287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
		    return TCL_ERROR;
		}
		Tk_AddOption(tkwin, argv[srcIndex], argv[srcIndex+1],
			TK_INTERACTIVE_PRIO);
		srcIndex += 2;
		argc -= 2;
		break;
	    default: {
		char buf[64 + TCL_INTEGER_SPACE];
		
		sprintf(buf, "bad argument type %d in Tk_ArgvInfo",
			infoPtr->type);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
		return TCL_ERROR;
	    }
	}
    }

    /*
     * If we broke out of the loop because of an OPT_REST argument,
     * copy the remaining arguments down.
     */
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
 *----------------------------------------------------------------------
 *
 * PrintUsage --
 *
 *	Generate a help string describing command-line options.
 *
 * Results:
 *	Interp->result will be modified to hold a help string
 *	describing all the options in argTable, plus all those
 *	in the default table unless TK_ARGV_NO_DEFAULTS is
 *	specified in flags.
 *
 * Side effects:
 *	None.
 *







|







328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
 *----------------------------------------------------------------------
 *
 * PrintUsage --
 *
 *	Generate a help string describing command-line options.
 *
 * Results:
 *	The interp's result will be modified to hold a help string
 *	describing all the options in argTable, plus all those
 *	in the default table unless TK_ARGV_NO_DEFAULTS is
 *	specified in flags.
 *
 * Side effects:
 *	None.
 *
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
				 * in this word, then don't generate
				 * information for default options. */
{
    register Tk_ArgvInfo *infoPtr;
    int width, i, numSpaces;
#define NUM_SPACES 20
    static char spaces[] = "                    ";
    char tmp[30];

    /*
     * First, compute the width of the widest option key, so that we
     * can make everything line up.
     */

    width = 4;







|







353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
				 * in this word, then don't generate
				 * information for default options. */
{
    register Tk_ArgvInfo *infoPtr;
    int width, i, numSpaces;
#define NUM_SPACES 20
    static char spaces[] = "                    ";
    char tmp[TCL_DOUBLE_SPACE];

    /*
     * First, compute the width of the widest option key, so that we
     * can make everything line up.
     */

    width = 4;

Changes to generic/tkAtom.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkAtom.c 1.13 96/02/15 18:51:34
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * The following are a list of the predefined atom strings.







|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkAtom.c,v 1.1.4.1 1998/09/30 02:16:38 stanton Exp $
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * The following are a list of the predefined atom strings.

Changes to generic/tkBind.c.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17




18
19
20
21
22
23
24
/* 
 * tkBind.c --
 *
 *	This file provides procedures that associate Tcl commands
 *	with X events or sequences of X events.
 *
 * Copyright (c) 1989-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkBind.c 1.133 97/07/01 17:59:53
 */

#include "tkPort.h"
#include "tkInt.h"





/*
 * File structure:
 *
 * Structure definitions and static variables.
 *
 * Init/Free this package.







|
>




|




>
>
>
>







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
/* 
 * tkBind.c --
 *
 *	This file provides procedures that associate Tcl commands
 *	with X events or sequences of X events.
 *
 * Copyright (c) 1989-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 *  RCS: @(#) $Id: tkBind.c,v 1.1.4.8 1999/04/03 02:54:15 redman Exp $
 */

#include "tkPort.h"
#include "tkInt.h"

#ifdef __WIN32__
#include "tkWinInt.h"
#endif

/*
 * File structure:
 *
 * Structure definitions and static variables.
 *
 * Init/Free this package.
335
336
337
338
339
340
341


342
343
344
345
346
347
348
				 * interpreter. */
    ScreenInfo screenInfo;	/* Keeps track of the current display and
				 * screen, so it can be restored after
				 * a binding has executed. */
    PendingBinding *pendingList;/* The list of pending C bindings, kept in
				 * case a C or Tcl binding causes the target
				 * window to be deleted. */


} BindInfo;
    
/*
 * In X11R4 and earlier versions, XStringToKeysym is ridiculously
 * slow.  The data structure and hash table below, along with the
 * code that uses them, implement a fast mapping from strings to
 * keysyms.  In X11R5 and later releases XStringToKeysym is plenty







>
>







340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
				 * interpreter. */
    ScreenInfo screenInfo;	/* Keeps track of the current display and
				 * screen, so it can be restored after
				 * a binding has executed. */
    PendingBinding *pendingList;/* The list of pending C bindings, kept in
				 * case a C or Tcl binding causes the target
				 * window to be deleted. */
    int deleted;		/* 1 the application has been deleted but
				 * the structure has been preserved. */
} BindInfo;
    
/*
 * In X11R4 and earlier versions, XStringToKeysym is ridiculously
 * slow.  The data structure and hash table below, along with the
 * code that uses them, implement a fast mapping from strings to
 * keysyms.  In X11R5 and later releases XStringToKeysym is plenty
369
370
371
372
373
374
375

376
377
378
379
380
381
382

/*
 * Set to non-zero when the package-wide static variables have been
 * initialized.
 */

static int initialized = 0;


/*
 * A hash table is kept to map from the string names of event
 * modifiers to information about those modifiers.  The structure
 * for storing this information, and the hash table built at
 * initialization time, are defined below.
 */







>







376
377
378
379
380
381
382
383
384
385
386
387
388
389
390

/*
 * Set to non-zero when the package-wide static variables have been
 * initialized.
 */

static int initialized = 0;
TCL_DECLARE_MUTEX(bindMutex)

/*
 * A hash table is kept to map from the string names of event
 * modifiers to information about those modifiers.  The structure
 * for storing this information, and the hash table built at
 * initialization time, are defined below.
 */
491
492
493
494
495
496
497

498
499
500
501
502
503
504
    {"Configure",	ConfigureNotify,	StructureNotifyMask},
    {"Gravity",		GravityNotify,		StructureNotifyMask},
    {"Circulate",	CirculateNotify,	StructureNotifyMask},
    {"Property",	PropertyNotify,		PropertyChangeMask},
    {"Colormap",	ColormapNotify,		ColormapChangeMask},
    {"Activate",	ActivateNotify,		ActivateMask},
    {"Deactivate",	DeactivateNotify,	ActivateMask},

    {(char *) NULL,	0,			0}
};
static Tcl_HashTable eventTable;

/*
 * The defines and table below are used to classify events into
 * various groups.  The reason for this is that logically identical







>







499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
    {"Configure",	ConfigureNotify,	StructureNotifyMask},
    {"Gravity",		GravityNotify,		StructureNotifyMask},
    {"Circulate",	CirculateNotify,	StructureNotifyMask},
    {"Property",	PropertyNotify,		PropertyChangeMask},
    {"Colormap",	ColormapNotify,		ColormapChangeMask},
    {"Activate",	ActivateNotify,		ActivateMask},
    {"Deactivate",	DeactivateNotify,	ActivateMask},
    {"MouseWheel",	MouseWheelEvent,	MouseWheelMask},
    {(char *) NULL,	0,			0}
};
static Tcl_HashTable eventTable;

/*
 * The defines and table below are used to classify events into
 * various groups.  The reason for this is that logically identical
563
564
565
566
567
568
569
570















571
572
573
574
575
576
577
   /* SelectionRequest */	0,
   /* SelectionNotify */	0,
   /* ColormapNotify */		COLORMAP,
   /* ClientMessage */		0,
   /* MappingNotify */		0,
   /* VirtualEvent */		VIRTUAL,
   /* Activate */		ACTIVATE,	    
   /* Deactivate */		ACTIVATE















};

/*
 * The following tables are used as a two-way map between X's internal
 * numeric values for fields in an XEvent and the strings used in Tcl.  The
 * tables are used both when constructing an XEvent from user input and
 * when providing data from an XEvent to the user.







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







572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
   /* SelectionRequest */	0,
   /* SelectionNotify */	0,
   /* ColormapNotify */		COLORMAP,
   /* ClientMessage */		0,
   /* MappingNotify */		0,
   /* VirtualEvent */		VIRTUAL,
   /* Activate */		ACTIVATE,	    
   /* Deactivate */		ACTIVATE,
   /* MouseWheel */		KEY
};

/*
 * The following table is used to map between the location where an
 * generated event should be queued and the string used to specify the
 * location.
 */
 
static TkStateMap queuePosition[] = {
    {-1,			"now"},
    {TCL_QUEUE_HEAD,		"head"},
    {TCL_QUEUE_MARK,		"mark"},
    {TCL_QUEUE_TAIL,		"tail"},
    {-2,			NULL}
};

/*
 * The following tables are used as a two-way map between X's internal
 * numeric values for fields in an XEvent and the strings used in Tcl.  The
 * tables are used both when constructing an XEvent from user input and
 * when providing data from an XEvent to the user.
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
static void		GetPatternString _ANSI_ARGS_((PatSeq *psPtr,
			    Tcl_DString *dsPtr));
static int		GetVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
			    VirtualEventTable *vetPtr, char *virtString));
static Tk_Uid		GetVirtualEventUid _ANSI_ARGS_((Tcl_Interp *interp,
			    char *virtString));
static int		HandleEventGenerate _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window main, int argc, char **argv));

static void		InitKeymapInfo _ANSI_ARGS_((TkDisplay *dispPtr));
static void		InitVirtualEventTable _ANSI_ARGS_((
			    VirtualEventTable *vetPtr));
static PatSeq *		MatchPatterns _ANSI_ARGS_((TkDisplay *dispPtr,
			    BindingTable *bindPtr, PatSeq *psPtr,
			    PatSeq *bestPtr, ClientData *objectPtr,
			    PatSeq **sourcePtrPtr));



static int		ParseEventDescription _ANSI_ARGS_((Tcl_Interp *interp,
			    char **eventStringPtr, Pattern *patPtr,
			    unsigned long *eventMaskPtr));



/*
 * The following define is used as a short circuit for the callback
 * procedure to evaluate a TclBinding.  The actual evaluation of the
 * binding is handled inline, because special things have to be done
 * with a Tcl binding before evaluation time.
 */







|
>







>
>
>



>
>







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
static void		GetPatternString _ANSI_ARGS_((PatSeq *psPtr,
			    Tcl_DString *dsPtr));
static int		GetVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
			    VirtualEventTable *vetPtr, char *virtString));
static Tk_Uid		GetVirtualEventUid _ANSI_ARGS_((Tcl_Interp *interp,
			    char *virtString));
static int		HandleEventGenerate _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window main, int objc,
			    Tcl_Obj *CONST objv[]));
static void		InitKeymapInfo _ANSI_ARGS_((TkDisplay *dispPtr));
static void		InitVirtualEventTable _ANSI_ARGS_((
			    VirtualEventTable *vetPtr));
static PatSeq *		MatchPatterns _ANSI_ARGS_((TkDisplay *dispPtr,
			    BindingTable *bindPtr, PatSeq *psPtr,
			    PatSeq *bestPtr, ClientData *objectPtr,
			    PatSeq **sourcePtrPtr));
static int		NameToWindow _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window main, Tcl_Obj *objPtr,
			    Tk_Window *tkwinPtr));
static int		ParseEventDescription _ANSI_ARGS_((Tcl_Interp *interp,
			    char **eventStringPtr, Pattern *patPtr,
			    unsigned long *eventMaskPtr));
static void		SetKeycodeAndState _ANSI_ARGS_((Tk_Window tkwin,
			    KeySym keySym, XEvent *eventPtr));

/*
 * The following define is used as a short circuit for the callback
 * procedure to evaluate a TclBinding.  The actual evaluation of the
 * binding is handled inline, because special things have to be done
 * with a Tcl binding before evaluation time.
 */
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
    /*
     * Initialize the static data structures used by the binding package.
     * They are only initialized once, no matter how many interps are
     * created.
     */

    if (!initialized) {


	Tcl_HashEntry *hPtr;
	ModInfo *modPtr;
	EventInfo *eiPtr;
	int dummy;

#ifdef REDO_KEYSYM_LOOKUP
	KeySymInfo *kPtr;

	Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
	Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS);
	for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
	    hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy);
	    Tcl_SetHashValue(hPtr, kPtr->value);
	    hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value,
		    &dummy);
	    Tcl_SetHashValue(hPtr, kPtr->name);
	}
#endif /* REDO_KEYSYM_LOOKUP */

	Tcl_InitHashTable(&modTable, TCL_STRING_KEYS);
	for (modPtr = modArray; modPtr->name != NULL; modPtr++) {
	    hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &dummy);
	    Tcl_SetHashValue(hPtr, modPtr);
	}
    
	Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS);
	for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
	    hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy);
	    Tcl_SetHashValue(hPtr, eiPtr);
	}
	initialized = 1;


    }

    mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp);

    bindInfoPtr = (BindInfo *) ckalloc(sizeof(BindInfo));
    InitVirtualEventTable(&bindInfoPtr->virtualEventTable);
    bindInfoPtr->screenInfo.curDispPtr = NULL;
    bindInfoPtr->screenInfo.curScreenIndex = -1;
    bindInfoPtr->screenInfo.bindingDepth = 0;
    bindInfoPtr->pendingList = NULL;

    mainPtr->bindInfo = (TkBindInfo) bindInfoPtr;

    TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable);
}

/*
 *---------------------------------------------------------------------------







>
>
|
|
|
|


|

|
|
|
|
|
|
|
|
|


|
|
|
|
|

|
|
|
|
|
|
>
>










>







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
    /*
     * Initialize the static data structures used by the binding package.
     * They are only initialized once, no matter how many interps are
     * created.
     */

    if (!initialized) {
        Tcl_MutexLock(&bindMutex);
	if (!initialized) {
	    Tcl_HashEntry *hPtr;
	    ModInfo *modPtr;
	    EventInfo *eiPtr;
	    int dummy;

#ifdef REDO_KEYSYM_LOOKUP
	    KeySymInfo *kPtr;

	    Tcl_InitHashTable(&keySymTable, TCL_STRING_KEYS);
	    Tcl_InitHashTable(&nameTable, TCL_ONE_WORD_KEYS);
	    for (kPtr = keyArray; kPtr->name != NULL; kPtr++) {
	        hPtr = Tcl_CreateHashEntry(&keySymTable, kPtr->name, &dummy);
		Tcl_SetHashValue(hPtr, kPtr->value);
		hPtr = Tcl_CreateHashEntry(&nameTable, (char *) kPtr->value,
		        &dummy);
		Tcl_SetHashValue(hPtr, kPtr->name);
	    }
#endif /* REDO_KEYSYM_LOOKUP */

	    Tcl_InitHashTable(&modTable, TCL_STRING_KEYS);
	    for (modPtr = modArray; modPtr->name != NULL; modPtr++) {
	        hPtr = Tcl_CreateHashEntry(&modTable, modPtr->name, &dummy);
		Tcl_SetHashValue(hPtr, modPtr);
	    }
    
	    Tcl_InitHashTable(&eventTable, TCL_STRING_KEYS);
	    for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
	        hPtr = Tcl_CreateHashEntry(&eventTable, eiPtr->name, &dummy);
		Tcl_SetHashValue(hPtr, eiPtr);
	    }
	    initialized = 1;
	}
        Tcl_MutexUnlock(&bindMutex);
    }

    mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp);

    bindInfoPtr = (BindInfo *) ckalloc(sizeof(BindInfo));
    InitVirtualEventTable(&bindInfoPtr->virtualEventTable);
    bindInfoPtr->screenInfo.curDispPtr = NULL;
    bindInfoPtr->screenInfo.curScreenIndex = -1;
    bindInfoPtr->screenInfo.bindingDepth = 0;
    bindInfoPtr->pendingList = NULL;
    bindInfoPtr->deleted = 0;
    mainPtr->bindInfo = (TkBindInfo) bindInfoPtr;

    TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable);
}

/*
 *---------------------------------------------------------------------------
772
773
774
775
776
777
778


779
780
781
782
783
784
785
    BindInfo *bindInfoPtr;
    
    Tk_DeleteBindingTable(mainPtr->bindingTable);
    mainPtr->bindingTable = NULL;

    bindInfoPtr = (BindInfo *) mainPtr->bindInfo;
    DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable);


    mainPtr->bindInfo = NULL;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_CreateBindingTable --







>
>







807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
    BindInfo *bindInfoPtr;
    
    Tk_DeleteBindingTable(mainPtr->bindingTable);
    mainPtr->bindingTable = NULL;

    bindInfoPtr = (BindInfo *) mainPtr->bindInfo;
    DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable);
    bindInfoPtr->deleted = 1;
    Tcl_EventuallyFree((ClientData) bindInfoPtr, Tcl_Free);
    mainPtr->bindInfo = NULL;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_CreateBindingTable --
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
 *
 *	Add a binding to a binding table, so that future calls to
 *	Tk_BindEvent may execute the command in the binding.
 *
 * Results:
 *	The return value is 0 if an error occurred while setting
 *	up the binding.  In this case, an error message will be
 *	left in interp->result.  If all went well then the return
 *	value is a mask of the event types that must be made
 *	available to Tk_BindEvent in order to properly detect when
 *	this binding triggers.  This value can be used to determine
 *	what events to select for in a window, for example.
 *
 * Side effects:
 *	An existing binding on the same event sequence may be







|







923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
 *
 *	Add a binding to a binding table, so that future calls to
 *	Tk_BindEvent may execute the command in the binding.
 *
 * Results:
 *	The return value is 0 if an error occurred while setting
 *	up the binding.  In this case, an error message will be
 *	left in the interp's result.  If all went well then the return
 *	value is a mask of the event types that must be made
 *	available to Tk_BindEvent in order to properly detect when
 *	this binding triggers.  This value can be used to determine
 *	what events to select for in a window, for example.
 *
 * Side effects:
 *	An existing binding on the same event sequence may be
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
 *
 *	Add a C binding to a binding table, so that future calls to
 *	Tk_BindEvent may callback the procedure in the binding.
 *
 * Results:
 *	The return value is 0 if an error occurred while setting
 *	up the binding.  In this case, an error message will be
 *	left in interp->result.  If all went well then the return
 *	value is a mask of the event types that must be made
 *	available to Tk_BindEvent in order to properly detect when
 *	this binding triggers.  This value can be used to determine
 *	what events to select for in a window, for example.
 *
 * Side effects:
 *	Any existing binding on the same event sequence will be







|







1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
 *
 *	Add a C binding to a binding table, so that future calls to
 *	Tk_BindEvent may callback the procedure in the binding.
 *
 * Results:
 *	The return value is 0 if an error occurred while setting
 *	up the binding.  In this case, an error message will be
 *	left in the interp's result.  If all went well then the return
 *	value is a mask of the event types that must be made
 *	available to Tk_BindEvent in order to properly detect when
 *	this binding triggers.  This value can be used to determine
 *	what events to select for in a window, for example.
 *
 * Side effects:
 *	Any existing binding on the same event sequence will be
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
 *
 * Tk_DeleteBinding --
 *
 *	Remove an event binding from a binding table.
 *
 * Results:
 *	The result is a standard Tcl return value.  If an error
 *	occurs then interp->result will contain an error message.
 *
 * Side effects:
 *	The binding given by object and eventString is removed
 *	from bindingTable.
 *
 *--------------------------------------------------------------
 */







|







1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
 *
 * Tk_DeleteBinding --
 *
 *	Remove an event binding from a binding table.
 *
 * Results:
 *	The result is a standard Tcl return value.  If an error
 *	occurs then the interp's result will contain an error message.
 *
 * Side effects:
 *	The binding given by object and eventString is removed
 *	from bindingTable.
 *
 *--------------------------------------------------------------
 */
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
 *
 * Results:
 *	The return value is a pointer to the command string
 *	associated with eventString for object in the domain
 *	given by bindingTable.  If there is no binding for
 *	eventString, or if eventString is improperly formed,
 *	then NULL is returned and an error message is left in
 *	interp->result.  The return value is semi-static:  it
 *	will persist until the binding is changed or deleted.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */







|







1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
 *
 * Results:
 *	The return value is a pointer to the command string
 *	associated with eventString for object in the domain
 *	given by bindingTable.  If there is no binding for
 *	eventString, or if eventString is improperly formed,
 *	then NULL is returned and an error message is left in
 *	the interp's result.  The return value is semi-static:  it
 *	will persist until the binding is changed or deleted.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
 *
 * Tk_GetAllBindings --
 *
 *	Return a list of event strings for all the bindings
 *	associated with a given object.
 *
 * Results:
 *	There is no return value.  Interp->result is modified to
 *	hold a Tcl list with one entry for each binding associated
 *	with object in bindingTable.  Each entry in the list
 *	contains the event string associated with one binding.
 *
 * Side effects:
 *	None.
 *







|







1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
 *
 * Tk_GetAllBindings --
 *
 *	Return a list of event strings for all the bindings
 *	associated with a given object.
 *
 * Results:
 *	There is no return value.  The interp's result is modified to
 *	hold a Tcl list with one entry for each binding associated
 *	with object in bindingTable.  Each entry in the list
 *	contains the event string associated with one binding.
 *
 * Side effects:
 *	None.
 *
1377
1378
1379
1380
1381
1382
1383

1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
					 * locate display information). */
    int numObjects;			/* Number of objects at *objectPtr. */
    ClientData *objectPtr;		/* Array of one or more objects
					 * to check for a matching binding. */
{
    BindingTable *bindPtr;
    TkDisplay *dispPtr;

    BindInfo *bindInfoPtr;
    TkDisplay *oldDispPtr;
    ScreenInfo *screenPtr;
    XEvent *ringPtr;
    PatSeq *vMatchDetailList, *vMatchNoDetailList;
    int flags, oldScreen, i, deferModal;
    unsigned int matchCount, matchSpace;
    Tcl_Interp *interp;
    Tcl_DString scripts, savedResult;
    Detail detail;







>


<







1414
1415
1416
1417
1418
1419
1420
1421
1422
1423

1424
1425
1426
1427
1428
1429
1430
					 * locate display information). */
    int numObjects;			/* Number of objects at *objectPtr. */
    ClientData *objectPtr;		/* Array of one or more objects
					 * to check for a matching binding. */
{
    BindingTable *bindPtr;
    TkDisplay *dispPtr;
    ScreenInfo *screenPtr;
    BindInfo *bindInfoPtr;
    TkDisplay *oldDispPtr;

    XEvent *ringPtr;
    PatSeq *vMatchDetailList, *vMatchNoDetailList;
    int flags, oldScreen, i, deferModal;
    unsigned int matchCount, matchSpace;
    Tcl_Interp *interp;
    Tcl_DString scripts, savedResult;
    Detail detail;
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
			eventPtr, detail.keySym, &scripts);
	    } else {
		if (matchCount >= matchSpace) {
		    PendingBinding *new;
		    unsigned int oldSize, newSize;
		    
		    oldSize = sizeof(staticPending)
			- sizeof(staticPending.matchArray)
			+ matchSpace * sizeof(PatSeq*);
		    matchSpace *= 2;
		    newSize = sizeof(staticPending)
			- sizeof(staticPending.matchArray)
			+ matchSpace * sizeof(PatSeq*);
		    new = (PendingBinding *) ckalloc(newSize);
		    memcpy((VOID *) new, (VOID *) pendingPtr, oldSize);
		    if (pendingPtr != &staticPending) {
			ckfree((char *) pendingPtr);
		    }
		    pendingPtr = new;
		}







|
|


|
|







1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
			eventPtr, detail.keySym, &scripts);
	    } else {
		if (matchCount >= matchSpace) {
		    PendingBinding *new;
		    unsigned int oldSize, newSize;
		    
		    oldSize = sizeof(staticPending)
			    - sizeof(staticPending.matchArray)
			    + matchSpace * sizeof(PatSeq*);
		    matchSpace *= 2;
		    newSize = sizeof(staticPending)
			    - sizeof(staticPending.matchArray)
			    + matchSpace * sizeof(PatSeq*);
		    new = (PendingBinding *) ckalloc(newSize);
		    memcpy((VOID *) new, (VOID *) pendingPtr, oldSize);
		    if (pendingPtr != &staticPending) {
			ckfree((char *) pendingPtr);
		    }
		    pendingPtr = new;
		}
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
    /*
     * Now go back through and evaluate the binding for each object,
     * in order, dealing with "break" and "continue" exceptions
     * appropriately.
     *
     * There are two tricks here:
     * 1. Bindings can be invoked from in the middle of Tcl commands,
     *    where interp->result is significant (for example, a widget
     *    might be deleted because of an error in creating it, so the
     *    result contains an error message that is eventually going to
     *    be returned by the creating command).  To preserve the result,
     *    we save it in a dynamic string.
     * 2. The binding's action can potentially delete the binding,
     *    so bindPtr may not point to anything valid once the action
     *    completes.  Thus we have to save bindPtr->interp in a







|







1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
    /*
     * Now go back through and evaluate the binding for each object,
     * in order, dealing with "break" and "continue" exceptions
     * appropriately.
     *
     * There are two tricks here:
     * 1. Bindings can be invoked from in the middle of Tcl commands,
     *    where the interp's result is significant (for example, a widget
     *    might be deleted because of an error in creating it, so the
     *    result contains an error message that is eventually going to
     *    be returned by the creating command).  To preserve the result,
     *    we save it in a dynamic string.
     * 2. The binding's action can potentially delete the binding,
     *    so bindPtr may not point to anything valid once the action
     *    completes.  Thus we have to save bindPtr->interp in a
1677
1678
1679
1680
1681
1682
1683







1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702








1703
1704
1705

1706

1707
1708
1709
1710
1711
1712
1713
	    || (Tk_ScreenNumber(tkwin) != screenPtr->curScreenIndex)) {
	screenPtr->curDispPtr = dispPtr;
	screenPtr->curScreenIndex = Tk_ScreenNumber(tkwin);
	ChangeScreen(interp, dispPtr->name, screenPtr->curScreenIndex);
    }

    if (matchCount > 0) {







	pendingPtr->nextPtr = bindInfoPtr->pendingList;
	pendingPtr->tkwin = tkwin;
	pendingPtr->deleted = 0;
	bindInfoPtr->pendingList = pendingPtr;
    }
    
    /*
     * Save the current value of the TK_DEFER_MODAL flag so we can
     * restore it at the end of the loop.  Clear the flag so we can
     * detect any recursive requests for a modal loop.
     */

    flags = winPtr->flags;
    winPtr->flags &= ~TK_DEFER_MODAL;

    p = Tcl_DStringValue(&scripts);
    end = p + Tcl_DStringLength(&scripts);
    i = 0;









    while (p < end) {
	int code;
	

	screenPtr->bindingDepth++;

	Tcl_AllowExceptions(interp);

	if (*p == '\0') {
	    PatSeq *psPtr;
	    
	    psPtr = pendingPtr->matchArray[i];
	    i++;







>
>
>
>
>
>
>



















>
>
>
>
>
>
>
>



>
|
>







1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
	    || (Tk_ScreenNumber(tkwin) != screenPtr->curScreenIndex)) {
	screenPtr->curDispPtr = dispPtr;
	screenPtr->curScreenIndex = Tk_ScreenNumber(tkwin);
	ChangeScreen(interp, dispPtr->name, screenPtr->curScreenIndex);
    }

    if (matchCount > 0) {
	/*
	 * Remember the list of pending C binding callbacks, so we can mark
	 * them as deleted and not call them if the act of evaluating a C
	 * or Tcl binding deletes a C binding callback or even the whole
	 * window.
	 */

	pendingPtr->nextPtr = bindInfoPtr->pendingList;
	pendingPtr->tkwin = tkwin;
	pendingPtr->deleted = 0;
	bindInfoPtr->pendingList = pendingPtr;
    }
    
    /*
     * Save the current value of the TK_DEFER_MODAL flag so we can
     * restore it at the end of the loop.  Clear the flag so we can
     * detect any recursive requests for a modal loop.
     */

    flags = winPtr->flags;
    winPtr->flags &= ~TK_DEFER_MODAL;

    p = Tcl_DStringValue(&scripts);
    end = p + Tcl_DStringLength(&scripts);
    i = 0;

    /*
     * Be carefule when dereferencing screenPtr or bindInfoPtr.  If we
     * evaluate something that destroys ".", bindInfoPtr would have been
     * freed, but we can tell that by first checking to see if
     * winPtr->mainPtr == NULL.
     */

    Tcl_Preserve((ClientData) bindInfoPtr);
    while (p < end) {
	int code;
	
	if (!bindInfoPtr->deleted) {
	    screenPtr->bindingDepth++;
	}
	Tcl_AllowExceptions(interp);

	if (*p == '\0') {
	    PatSeq *psPtr;
	    
	    psPtr = pendingPtr->matchArray[i];
	    i++;
1725
1726
1727
1728
1729
1730
1731


1732

1733
1734
1735
1736
1737
1738
1739
		ckfree((char *) psPtr);
	    }
	} else {
	    code = Tcl_GlobalEval(interp, p);
	    p += strlen(p);
	}
	p++;


	screenPtr->bindingDepth--;

	if (code != TCL_OK) {
	    if (code == TCL_CONTINUE) {
		/*
		 * Do nothing:  just go on to the next command.
		 */
	    } else if (code == TCL_BREAK) {
		break;







>
>
|
>







1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
		ckfree((char *) psPtr);
	    }
	} else {
	    code = Tcl_GlobalEval(interp, p);
	    p += strlen(p);
	}
	p++;

	if (!bindInfoPtr->deleted) {
	    screenPtr->bindingDepth--;
	}
	if (code != TCL_OK) {
	    if (code == TCL_CONTINUE) {
		/*
		 * Do nothing:  just go on to the next command.
		 */
	    } else if (code == TCL_BREAK) {
		break;
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779






1780
1781
1782
1783
1784
1785
1786
1787

1788
1789
1790
1791
1792

1793
1794
1795
1796
1797
1798
1799
	winPtr->flags = (winPtr->flags & (unsigned int) ~TK_DEFER_MODAL) 
	    | (flags & TK_DEFER_MODAL);
	if (deferModal) {
	    (*winPtr->classProcsPtr->modalProc)(tkwin, eventPtr);
	}
    }

    if ((screenPtr->bindingDepth != 0) &&
            ((oldDispPtr != screenPtr->curDispPtr)
                    || (oldScreen != screenPtr->curScreenIndex))) {

	/*
	 * Some other binding script is currently executing, but its
	 * screen is no longer current.  Change the current display
	 * back again.
	 */

	screenPtr->curDispPtr = oldDispPtr;
	screenPtr->curScreenIndex = oldScreen;
	ChangeScreen(interp, oldDispPtr->name, oldScreen);
    }
    Tcl_DStringResult(interp, &savedResult);
    Tcl_DStringFree(&scripts);

    if (matchCount > 0) {






	PendingBinding **curPtrPtr;

	for (curPtrPtr = &bindInfoPtr->pendingList; ; ) {
	    if (*curPtrPtr == pendingPtr) {
		*curPtrPtr = pendingPtr->nextPtr;
		break;
	    }
	    curPtrPtr = &(*curPtrPtr)->nextPtr;

	}
	if (pendingPtr != &staticPending) {
	    ckfree((char *) pendingPtr);
	}
    }

}

/*
 *---------------------------------------------------------------------------
 *
 * TkBindDeadWindow --
 *







|
|
















>
>
>
>
>
>
|

|
|
|
|
|
|
>





>







1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
	winPtr->flags = (winPtr->flags & (unsigned int) ~TK_DEFER_MODAL) 
	    | (flags & TK_DEFER_MODAL);
	if (deferModal) {
	    (*winPtr->classProcsPtr->modalProc)(tkwin, eventPtr);
	}
    }

    if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0)
	    && ((oldDispPtr != screenPtr->curDispPtr)
                    || (oldScreen != screenPtr->curScreenIndex))) {

	/*
	 * Some other binding script is currently executing, but its
	 * screen is no longer current.  Change the current display
	 * back again.
	 */

	screenPtr->curDispPtr = oldDispPtr;
	screenPtr->curScreenIndex = oldScreen;
	ChangeScreen(interp, oldDispPtr->name, oldScreen);
    }
    Tcl_DStringResult(interp, &savedResult);
    Tcl_DStringFree(&scripts);

    if (matchCount > 0) {
	if (!bindInfoPtr->deleted) {
	    /*
	     * Delete the pending list from the list of pending scripts
	     * for this window.
	     */
	     
	    PendingBinding **curPtrPtr;

	    for (curPtrPtr = &bindInfoPtr->pendingList; ; ) {
		if (*curPtrPtr == pendingPtr) {
		    *curPtrPtr = pendingPtr->nextPtr;
		    break;
		}
		curPtrPtr = &(*curPtrPtr)->nextPtr;
	    }
	}
	if (pendingPtr != &staticPending) {
	    ckfree((char *) pendingPtr);
	}
    }
    Tcl_Release((ClientData) bindInfoPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkBindDeadWindow --
 *
2160
2161
2162
2163
2164
2165
2166
2167

2168
2169
2170
2171
2172
2173
2174

	    goto nextSequence;	
	}
	newBest:
	bestPtr = matchPtr;
	bestSourcePtr = sourcePtr;

	nextSequence: continue;

    }

    *sourcePtrPtr = bestSourcePtr;
    return bestPtr;
}

/*







|
>







2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240

	    goto nextSequence;	
	}
	newBest:
	bestPtr = matchPtr;
	bestSourcePtr = sourcePtr;

	nextSequence:
	continue;
    }

    *sourcePtrPtr = bestSourcePtr;
    return bestPtr;
}

/*
2204
2205
2206
2207
2208
2209
2210

2211


2212
2213
2214
2215
2216
2217
2218
				 * command. */
{
    int spaceNeeded, cvtFlags;	/* Used to substitute string as proper Tcl
				 * list element. */
    int number, flags, length;
#define NUM_SIZE 40
    char *string;

    char numStorage[NUM_SIZE+1];



    if (eventPtr->type < TK_LASTEVENT) {
	flags = flagArray[eventPtr->type];
    } else {
	flags = 0;
    }
    while (1) {







>

>
>







2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
				 * command. */
{
    int spaceNeeded, cvtFlags;	/* Used to substitute string as proper Tcl
				 * list element. */
    int number, flags, length;
#define NUM_SIZE 40
    char *string;
    Tcl_DString buf;
    char numStorage[NUM_SIZE+1];

    Tcl_DStringInit(&buf);

    if (eventPtr->type < TK_LASTEVENT) {
	flags = flagArray[eventPtr->type];
    } else {
	flags = 0;
    }
    while (1) {
2239
2240
2241
2242
2243
2244
2245

2246
2247

2248
2249
2250
2251
2252
2253
2254
	number = 0;
	string = "??";
	switch (before[1]) {
	    case '#':
		number = eventPtr->xany.serial;
		goto doNumber;
	    case 'a':

		TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
		string = numStorage;

		goto doString;
	    case 'b':
		number = eventPtr->xbutton.button;
		goto doNumber;
	    case 'c':
		if (flags & EXPOSE) {
		    number = eventPtr->xexpose.count;







>
|
|
>







2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
	number = 0;
	string = "??";
	switch (before[1]) {
	    case '#':
		number = eventPtr->xany.serial;
		goto doNumber;
	    case 'a':
		if (flags & CONFIG) {
		    TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
		    string = numStorage;
		}
		goto doString;
	    case 'b':
		number = eventPtr->xbutton.button;
		goto doNumber;
	    case 'c':
		if (flags & EXPOSE) {
		    number = eventPtr->xexpose.count;
2354
2355
2356
2357
2358
2359
2360
2361

2362





2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
		} else if (flags & CROSSING) {
		    number = eventPtr->xcrossing.y;

		}
		goto doNumber;
	    case 'A':
		if (flags & KEY) {
		    int numChars;







		    /*
		     * If we're using input methods and this is a keypress
		     * event, invoke XmbTkFindStateString.  Otherwise just use
		     * the older XTkFindStateString.
		     */

#ifdef TK_USE_INPUT_METHODS
		    Status status;
		    if ((winPtr->inputContext != NULL)
			    && (eventPtr->type == KeyPress)) {
                        numChars = XmbLookupString(winPtr->inputContext,
                                &eventPtr->xkey, numStorage, NUM_SIZE,
                                (KeySym *) NULL, &status);
			if ((status != XLookupChars)
				&& (status != XLookupBoth)) {
			    numChars = 0;
			}
                    } else {
                        numChars = XLookupString(&eventPtr->xkey, numStorage,
                                NUM_SIZE, (KeySym *) NULL,
                                (XComposeStatus *) NULL);
		    }
#else /* TK_USE_INPUT_METHODS */
		    numChars = XLookupString(&eventPtr->xkey, numStorage,
			    NUM_SIZE, (KeySym *) NULL,
			    (XComposeStatus *) NULL);
#endif /* TK_USE_INPUT_METHODS */
		    numStorage[numChars] = '\0';
		    string = numStorage;
		}
		goto doString;
	    case 'B':
		number = eventPtr->xcreatewindow.border_width;
		goto doNumber;
	    case 'E':
		number = (int) eventPtr->xany.send_event;
		goto doNumber;
	    case 'K':
		if (flags & KEY) {
		    char *name;








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








2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441


2442
2443


























2444
2445
2446
2447
2448
2449
2450
2451
2452
		} else if (flags & CROSSING) {
		    number = eventPtr->xcrossing.y;

		}
		goto doNumber;
	    case 'A':
		if (flags & KEY) {
		    Tcl_DStringFree(&buf);
		    string = TkpGetString(winPtr, eventPtr, &buf);
		}
		goto doString;
	    case 'B':
		number = eventPtr->xcreatewindow.border_width;
		goto doNumber;
	    case 'D':
		/*
		 * This is used only by the MouseWheel event.


		 */
		    


























		number = eventPtr->xkey.keycode;
		goto doNumber;
	    case 'E':
		number = (int) eventPtr->xany.send_event;
		goto doNumber;
	    case 'K':
		if (flags & KEY) {
		    char *name;

2478
2479
2480
2481
2482
2483
2484

2485
2486
2487
2488
2489
2490
2491
	Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
	spaceNeeded = Tcl_ConvertElement(string,
		Tcl_DStringValue(dsPtr) + length,
		cvtFlags | TCL_DONT_USE_BRACES);
	Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
	before += 2;
    }

}

/*
 *----------------------------------------------------------------------
 *
 * ChangeScreen --
 *







>







2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
	Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
	spaceNeeded = Tcl_ConvertElement(string,
		Tcl_DStringValue(dsPtr) + length,
		cvtFlags | TCL_DONT_USE_BRACES);
	Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
	before += 2;
    }
    Tcl_DStringFree(&buf);
}

/*
 *----------------------------------------------------------------------
 *
 * ChangeScreen --
 *
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
    Tcl_Interp *interp;			/* Interpreter in which to invoke
					 * command. */
    char *dispName;			/* Name of new display. */
    int screenIndex;			/* Index of new screen. */
{
    Tcl_DString cmd;
    int code;
    char screen[30];

    Tcl_DStringInit(&cmd);
    Tcl_DStringAppend(&cmd, "tkScreenChanged ", 16);
    Tcl_DStringAppend(&cmd, dispName, -1);
    sprintf(screen, ".%d", screenIndex);
    Tcl_DStringAppend(&cmd, screen, -1);
    code = Tcl_GlobalEval(interp, Tcl_DStringValue(&cmd));







|







2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
    Tcl_Interp *interp;			/* Interpreter in which to invoke
					 * command. */
    char *dispName;			/* Name of new display. */
    int screenIndex;			/* Index of new screen. */
{
    Tcl_DString cmd;
    int code;
    char screen[TCL_INTEGER_SPACE];

    Tcl_DStringInit(&cmd);
    Tcl_DStringAppend(&cmd, "tkScreenChanged ", 16);
    Tcl_DStringAppend(&cmd, dispName, -1);
    sprintf(screen, ".%d", screenIndex);
    Tcl_DStringAppend(&cmd, screen, -1);
    code = Tcl_GlobalEval(interp, Tcl_DStringValue(&cmd));
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574

2575
2576
2577
2578
2579
2580








2581





2582
2583
2584
2585
2586

2587

2588
2589
2590
2591
2592





2593
2594
2595
2596
2597
2598
2599

2600
2601
2602
2603

2604
2605
2606
2607
2608
2609


2610
2611
2612
2613
2614
2615
2616


2617
2618
2619
2620
2621

2622
2623
2624
2625
2626
2627
2628
2629
2630
2631

2632
2633
2634
2635
2636
2637
2638
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tk_EventCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    int i;
    size_t length;
    char *option;
    Tk_Window tkwin;
    VirtualEventTable *vetPtr;
    TkBindInfo bindInfo;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option ?arg1?\"", (char *) NULL);
	return TCL_ERROR;
    }

    option = argv[1];
    length = strlen(option);
    if (length == 0) {
	goto badopt;

    }

    tkwin = (Tk_Window) clientData;
    bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
    vetPtr = &((BindInfo *) bindInfo)->virtualEventTable;









    if (strncmp(option, "add", length) == 0) {





	if (argc < 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " add virtual sequence ?sequence ...?\"", (char *) NULL);
	    return TCL_ERROR;
	}

	for (i = 3; i < argc; i++) {

	    if (CreateVirtualEvent(interp, vetPtr, argv[2], argv[i])
		    != TCL_OK) {
		return TCL_ERROR;
	    }
	}





    } else if (strncmp(option, "delete", length) == 0) {
	if (argc < 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " delete virtual ?sequence sequence ...?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}

	if (argc == 3) {
	    return DeleteVirtualEvent(interp, vetPtr, argv[2], NULL);
	}
	for (i = 3; i < argc; i++) {

	    if (DeleteVirtualEvent(interp, vetPtr, argv[2], argv[i])
		    != TCL_OK) {
		return TCL_ERROR;
	    }
	}
    } else if (strncmp(option, "generate", length) == 0) {


	if (argc < 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " generate window event ?options?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	return HandleEventGenerate(interp, tkwin, argc - 2, argv + 2);
    } else if (strncmp(option, "info", length) == 0) {


	if (argc == 2) {
	    GetAllVirtualEvents(interp, vetPtr);
	    return TCL_OK;
	} else if (argc == 3) {	
	    return GetVirtualEvent(interp, vetPtr, argv[2]);

	} else {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " info ?virtual?\"", (char *) NULL);
	    return TCL_ERROR;
	}
    } else {
	badopt:
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be add, delete, generate, info", (char *) NULL);
	return TCL_ERROR;

    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *







|
|
<

|
|

|
<
<



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





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







2594
2595
2596
2597
2598
2599
2600
2601
2602

2603
2604
2605
2606
2607


2608
2609
2610
2611
2612

2613

2614

2615



2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645

2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657

2658
2659
2660
2661
2662
2663
2664
2665
2666

2667
2668
2669
2670
2671
2672
2673

2674
2675
2676
2677

2678
2679
2680
2681
2682
2683
2684
2685
2686

2687
2688
2689





2690
2691
2692
2693
2694
2695
2696
2697
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tk_EventObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window associated with interpreter. */

    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    int index;


    Tk_Window tkwin;
    VirtualEventTable *vetPtr;
    TkBindInfo bindInfo;
    static char *optionStrings[] = {
	"add",		"delete",	"generate",	"info",

	NULL

    };

    enum options {



	EVENT_ADD,	EVENT_DELETE,	EVENT_GENERATE,	EVENT_INFO
    };

    tkwin = (Tk_Window) clientData;
    bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
    vetPtr = &((BindInfo *) bindInfo)->virtualEventTable;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum options) index) {
	case EVENT_ADD: {
	    int i;
	    char *name, *event;
	    
	    if (objc < 4) {
		Tcl_WrongNumArgs(interp, 2, objv,
			"virtual sequence ?sequence ...?");
		return TCL_ERROR;
	    }
	    name = Tcl_GetStringFromObj(objv[2], NULL);
	    for (i = 3; i < objc; i++) {
		event = Tcl_GetStringFromObj(objv[i], NULL);
		if (CreateVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {

		    return TCL_ERROR;
		}
	    }
	    break;
	}
	case EVENT_DELETE: {
	    int i;
	    char *name, *event;
	    
	    if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv,
			"virtual ?sequence sequence ...?");

		return TCL_ERROR;
	    }
	    name = Tcl_GetStringFromObj(objv[2], NULL);
	    if (objc == 3) {
		return DeleteVirtualEvent(interp, vetPtr, name, NULL);
	    }
	    for (i = 3; i < objc; i++) {
		event = Tcl_GetStringFromObj(objv[i], NULL);
		if (DeleteVirtualEvent(interp, vetPtr, name, event) != TCL_OK) {

		    return TCL_ERROR;
		}
	    }
	    break;
	}
	case EVENT_GENERATE: {
	    if (objc < 4) {

		Tcl_WrongNumArgs(interp, 2, objv, "window event ?options?");
		return TCL_ERROR;
	    }
	    return HandleEventGenerate(interp, tkwin, objc - 2, objv + 2);

	}
	case EVENT_INFO: {
	    if (objc == 2) {
		GetAllVirtualEvents(interp, vetPtr);
		return TCL_OK;
	    } else if (objc == 3) {	
		return GetVirtualEvent(interp, vetPtr,
			Tcl_GetStringFromObj(objv[2], NULL));
	    } else {

		Tcl_WrongNumArgs(interp, 2, objv, "?virtual?");
		return TCL_ERROR;
	    }





	}
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
 *	Add a new definition for a virtual event.  If the virtual event
 *	is already defined, the new definition augments those that
 *	already exist.
 *
 * Results:
 *	The return value is TCL_ERROR if an error occured while
 *	creating the virtual binding.  In this case, an error message
 *	will be left in interp->result.  If all went well then the return
 *	value is TCL_OK.
 *
 * Side effects:
 *	The virtual event may cause future calls to Tk_BindEvent to
 *	behave differently than they did previously.
 *
 *----------------------------------------------------------------------
 */







|
|







2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
 *	Add a new definition for a virtual event.  If the virtual event
 *	is already defined, the new definition augments those that
 *	already exist.
 *
 * Results:
 *	The return value is TCL_ERROR if an error occured while
 *	creating the virtual binding.  In this case, an error message
 *	will be left in the interp's result.  If all went well then the
 *	return value is TCL_OK.
 *
 * Side effects:
 *	The virtual event may cause future calls to Tk_BindEvent to
 *	behave differently than they did previously.
 *
 *----------------------------------------------------------------------
 */
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
 *	Remove the definition of a given virtual event.  If the 
 *	event string is NULL, all definitions of the virtual event
 *	will be removed.  Otherwise, just the specified definition
 *	of the virtual event will be removed.
 *
 * Results:
 *	The result is a standard Tcl return value.  If an error
 *	occurs then interp->result will contain an error message.
 *	It is not an error to attempt to delete a virtual event that
 *	does not exist or a definition that does not exist.
 *
 * Side effects:
 *	The virtual event given by virtString may be removed from the
 *	virtual event table.  
 *







|







2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
 *	Remove the definition of a given virtual event.  If the 
 *	event string is NULL, all definitions of the virtual event
 *	will be removed.  Otherwise, just the specified definition
 *	of the virtual event will be removed.
 *
 * Results:
 *	The result is a standard Tcl return value.  If an error
 *	occurs then the interp's result will contain an error message.
 *	It is not an error to attempt to delete a virtual event that
 *	does not exist or a definition that does not exist.
 *
 * Side effects:
 *	The virtual event given by virtString may be removed from the
 *	virtual event table.  
 *
2869
2870
2871
2872
2873
2874
2875



2876
2877
2878
2879
2880
2881
2882
2883
	 * the virtual event doesn't own that physical event, return w/o
	 * doing anything.
	 */

	eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL,
		eventString, 0, 0, &eventMask);
	if (eventPSPtr == NULL) {



	    return (interp->result[0] != '\0') ? TCL_ERROR : TCL_OK;
	}
    }

    for (iPhys = poPtr->numOwned; --iPhys >= 0; ) {
	PatSeq *psPtr = poPtr->patSeqs[iPhys];
	if ((eventPSPtr == NULL) || (psPtr == eventPSPtr)) {
	    int iVirt;







>
>
>
|







2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
	 * the virtual event doesn't own that physical event, return w/o
	 * doing anything.
	 */

	eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL,
		eventString, 0, 0, &eventMask);
	if (eventPSPtr == NULL) {
	    char *string;

	    string = Tcl_GetStringResult(interp); 
	    return (string[0] != '\0') ? TCL_ERROR : TCL_OK;
	}
    }

    for (iPhys = poPtr->numOwned; --iPhys >= 0; ) {
	PatSeq *psPtr = poPtr->patSeqs[iPhys];
	if ((eventPSPtr == NULL) || (psPtr == eventPSPtr)) {
	    int iVirt;
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
 *
 * GetVirtualEvent --
 *
 *	Return the list of physical events that can invoke the
 *	given virtual event.
 *
 * Results:
 *	The return value is TCL_OK and interp->result is filled with the
 *	string representation of the physical events associated with the
 *	virtual event; if there are no physical events for the given virtual
 *	event, interp->result is filled with and empty string.  If the
 *	virtual event string is improperly formed, then TCL_ERROR is
 *	returned and an error message is left in interp->result.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */








|


|

|







3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
 *
 * GetVirtualEvent --
 *
 *	Return the list of physical events that can invoke the
 *	given virtual event.
 *
 * Results:
 *	The return value is TCL_OK and the interp's result is filled with the
 *	string representation of the physical events associated with the
 *	virtual event; if there are no physical events for the given virtual
 *	event, the interp's result is filled with and empty string.  If the
 *	virtual event string is improperly formed, then TCL_ERROR is
 *	returned and an error message is left in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
 *
 * GetAllVirtualEvents --
 *
 *	Return a list that contains the names of all the virtual
 *	event defined.
 *
 * Results:
 *	There is no return value.  Interp->result is modified to
 *	hold a Tcl list with one entry for each virtual event in 
 *	nameTable.  
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------







|







3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
 *
 * GetAllVirtualEvents --
 *
 *	Return a list that contains the names of all the virtual
 *	event defined.
 *
 * Results:
 *	There is no return value.  The interp's result is modified to
 *	hold a Tcl list with one entry for each virtual event in 
 *	nameTable.  
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115



3116
3117
3118






3119
3120
3121
3122
3123









3124
3125
3126
3127
3128
3129

3130
3131



3132
3133
3134
3135
3136

3137
3138

3139
3140
3141
3142
3143
3144

3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219

3220



3221
3222



3223


3224
3225
3226

3227
3228
3229

3230
3231
3232
3233
3234

3235
3236

3237
3238
3239
3240
3241
3242

3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255


3256
3257
3258
3259
3260
3261
3262
3263


3264
3265
3266
3267
3268
3269
3270
3271
3272


3273
3274
3275
3276
3277
3278
3279
3280
3281








3282





3283

3284
3285
3286
3287
3288
3289
3290
3291
3292
3293


3294
3295
3296
3297
3298
3299
3300
3301
3302


3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314


3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333

3334
3335
3336
3337
3338



3339
3340
3341
3342
3343
3344
3345
3346
3347



3348
3349
3350
3351

3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362

3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373


3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387


3388
3389

3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405

3406
3407
3408
3409
3410
3411
3412
3413


3414
3415
3416
3417
3418
3419
3420
3421
3422


3423
3424
3425
3426
3427
3428
3429
3430
3431




3432

3433
3434
3435
3436
3437
3438

3439
3440
3441
3442

3443
3444
3445
3446
3447


3448
3449
3450
3451
3452


3453
3454

3455
3456
3457
3458
3459
3460
3461
3462
3463
3464

3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479

3480
3481
3482
3483
3484
3485
3486
3487


3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498


3499
3500

3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517

3518
3519
3520
3521
3522
3523
3524
3525
3526


3527
3528
3529


3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545


3546
3547
3548


3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564




3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579









































































3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
 *	The event may be handled sychronously or asynchronously, depending
 *	on the value specified by the optional "-when" option.  The
 *	default setting is synchronous.
 *
 *---------------------------------------------------------------------------
 */
static int
HandleEventGenerate(interp, main, argc, argv)
    Tcl_Interp *interp;	    /* Interp for error messages and name lookup. */
    Tk_Window main;	    /* Main window associated with interp. */
    int argc;		    /* Number of arguments. */
    char **argv;	    /* Argument strings. */
{
    Pattern pat;
    Tk_Window tkwin;
    char *p;
    unsigned long eventMask;
    int count, i, state, flags, synch;
    Tcl_QueuePosition pos;



    XEvent event;    

    if (argv[0][0] == '.') {






	tkwin = Tk_NameToWindow(interp, argv[0], main);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
    } else {









	if (TkpScanWindowId(NULL, argv[0], &i) != TCL_OK) {
	    Tcl_AppendResult(interp, "bad window name/identifier \"",
		    argv[0], "\"", (char *) NULL);
	    return TCL_ERROR;
	}
	tkwin = Tk_IdToWindow(Tk_Display(main), (Window) i);

	if ((tkwin == NULL) || (((TkWindow *) main)->mainPtr
		!= ((TkWindow *) tkwin)->mainPtr)) {



	    Tcl_AppendResult(interp, "window id \"", argv[0],
		    "\" doesn't exist in this application", (char *) NULL);
	    return TCL_ERROR;
	}
    }


    p = argv[1];

    count = ParseEventDescription(interp, &p, &pat, &eventMask);
    if (count == 0) {
	return TCL_ERROR;
    }
    if (count != 1) {
	interp->result = "Double or Triple modifier not allowed";

	return TCL_ERROR;
    }
    if (*p != '\0') {
	interp->result = "only one event specification allowed";
	return TCL_ERROR;
    }
    if (argc & 1) {
        Tcl_AppendResult(interp, "value for \"", argv[argc - 1],
		"\" missing", (char *) NULL);
	return TCL_ERROR;
    }

    memset((VOID *) &event, 0, sizeof(event));
    event.xany.type = pat.eventType;
    event.xany.serial = NextRequest(Tk_Display(tkwin));
    event.xany.send_event = False;
    event.xany.window = Tk_WindowId(tkwin);
    event.xany.display = Tk_Display(tkwin);

    flags = flagArray[event.xany.type];
    if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
	event.xkey.state = pat.needMods;
	if (flags & KEY) {
	    /*
	     * When mapping from a keysym to a keycode, need information about
	     * the modifier state that should be used so that when they call 
	     * XKeycodeToKeysym	taking into account the xkey.state, they will
	     * get back the original keysym.  
	     */

	    if (pat.detail.keySym == NoSymbol) {
	        event.xkey.keycode = 0;
	    } else {
		event.xkey.keycode = XKeysymToKeycode(event.xany.display,
			pat.detail.keySym);
	    }
	    if (event.xkey.keycode != 0) {
		for (state = 0; state < 4; state++) {
		    if (XKeycodeToKeysym(event.xany.display,
			    event.xkey.keycode, state) == pat.detail.keySym) {
			if (state & 1) {
			    event.xkey.state |= ShiftMask;
			}
			if (state & 2) {
			    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; 
			    event.xkey.state |= dispPtr->modeModMask;
			}
			break;
		    }
		}
	    }
	} else if (flags & BUTTON) {
	    event.xbutton.button = pat.detail.button;
	} else if (flags & VIRTUAL) {
	    ((XVirtualEvent *) &event)->name = pat.detail.name;
	}
    }
    if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) {
	event.xcreatewindow.window = event.xany.window;
    }

    /*
     * Process the remaining arguments to fill in additional fields
     * of the event.
     */

    synch = 1;
    pos = TCL_QUEUE_TAIL;
    for (i = 2; i < argc; i += 2) {
	char *field, *value;
	Tk_Window tkwin2;
	int number;
	KeySym keysym;
	
	field = argv[i];

	value = argv[i+1];




	if (strcmp(field, "-when") == 0) {



	    if (strcmp(value, "now") == 0) {


		synch = 1;
	    } else if (strcmp(value, "head") == 0) {
		pos = TCL_QUEUE_HEAD;

		synch = 0;
	    } else if (strcmp(value, "mark") == 0) {
		pos = TCL_QUEUE_MARK;

		synch = 0;
	    } else if (strcmp(value, "tail") == 0) {
		pos = TCL_QUEUE_TAIL;
		synch = 0;
	    } else {

		Tcl_AppendResult(interp, "bad position \"", value,
			"\": should be now, head, mark, tail", (char *) NULL);

		return TCL_ERROR;
	    }
	} else if (strcmp(field, "-above") == 0) {
	    if (value[0] == '.') {
		tkwin2 = Tk_NameToWindow(interp, value, main);
		if (tkwin2 == NULL) {

		    return TCL_ERROR;
		}
		number = Tk_WindowId(tkwin2);
	    } else if (TkpScanWindowId(interp, value, &number)
		    != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (flags & CONFIG) {
		event.xconfigure.above = number;
	    } else {
		goto badopt;
	    }
	} else if (strcmp(field, "-borderwidth") == 0) {


	    if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (flags & (CREATE|CONFIG)) {
		event.xcreatewindow.border_width = number;
	    } else {
		goto badopt;
	    }


	} else if (strcmp(field, "-button") == 0) {
	    if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (flags & BUTTON) {
	        event.xbutton.button = number;
	    } else {
		goto badopt;
	    }


	} else if (strcmp(field, "-count") == 0) {
	    if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (flags & EXPOSE) {
		event.xexpose.count = number;
	    } else {
		goto badopt;
	    }








	} else if (strcmp(field, "-detail") == 0) {





	    number = TkFindStateNum(interp, field, notifyDetail, value);

	    if (number < 0) {
		return TCL_ERROR;
	    }
	    if (flags & FOCUS) {
		event.xfocus.detail = number;
	    } else if (flags & CROSSING) {
		event.xcrossing.detail = number;
	    } else {
		goto badopt;
	    }


	} else if (strcmp(field, "-focus") == 0) {
	    if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (flags & CROSSING) {
		event.xcrossing.focus = number;
	    } else {
		goto badopt;
	    }


	} else if (strcmp(field, "-height") == 0) {
	    if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (flags & EXPOSE) {
		 event.xexpose.height = number;
	    } else if (flags & CONFIG) {
		event.xconfigure.height = number;
	    } else {
		goto badopt;
	    }
	} else if (strcmp(field, "-keycode") == 0) {


	    if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (flags & KEY) {
	        event.xkey.keycode = number;
	    } else {
		goto badopt;
	    }
	} else if (strcmp(field, "-keysym") == 0) {
	    keysym = TkStringToKeysym(value);
	    if (keysym == NoSymbol) {
		Tcl_AppendResult(interp, "unknown keysym \"", value,
			"\"", (char *) NULL);
		return TCL_ERROR;
	    }
	    /*
	     * When mapping from a keysym to a keycode, need information about
	     * the modifier state that should be used so that when they call 
	     * XKeycodeToKeysym	taking into account the xkey.state, they will

	     * get back the original keysym.  
	     */

	    number = XKeysymToKeycode(event.xany.display, keysym);
	    if (number == 0) {



		Tcl_AppendResult(interp, "no keycode for keysym \"", value,
			"\"", (char *) NULL);
		return TCL_ERROR;
	    }
	    for (state = 0; state < 4; state++) {
		if (XKeycodeToKeysym(event.xany.display, (unsigned) number,
			state) == keysym) {
		    if (state & 1) {
			event.xkey.state |= ShiftMask;



		    }
		    if (state & 2) {
			TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; 
			event.xkey.state |= dispPtr->modeModMask;

		    }
		    break;
		}
	    }	    
	    if (flags & KEY) {
		event.xkey.keycode = number;
	    } else {
		goto badopt;
	    }
	} else if (strcmp(field, "-mode") == 0) {
	    number = TkFindStateNum(interp, field, notifyMode, value);

	    if (number < 0) {
		return TCL_ERROR;
	    }
	    if (flags & CROSSING) {
		event.xcrossing.mode = number;
	    } else if (flags & FOCUS) {
		event.xfocus.mode = number;
	    } else {
		goto badopt;
	    }
	} else if (strcmp(field, "-override") == 0) {


	    if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (flags & CREATE) {
		event.xcreatewindow.override_redirect = number;
	    } else if (flags & MAP) {
		event.xmap.override_redirect = number;
	    } else if (flags & REPARENT) {
		event.xreparent.override_redirect = number;
	    } else if (flags & CONFIG) {
		event.xconfigure.override_redirect = number;
	    } else {
		goto badopt;
	    }


	} else if (strcmp(field, "-place") == 0) {
	    number = TkFindStateNum(interp, field, circPlace, value);

	    if (number < 0) {
		return TCL_ERROR;
	    }
	    if (flags & CIRC) {
		event.xcirculate.place = number;
	    } else {
		goto badopt;
	    }
	} else if (strcmp(field, "-root") == 0) {
	    if (value[0] == '.') {
		tkwin2 = Tk_NameToWindow(interp, value, main);
		if (tkwin2 == NULL) {
		    return TCL_ERROR;
		}
		number = Tk_WindowId(tkwin2);
	    } else if (TkpScanWindowId(interp, value, &number)

		    != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
		event.xkey.root = number;
	    } else {
		goto badopt;
	    }


	} else if (strcmp(field, "-rootx") == 0) {
	    if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
		event.xkey.x_root = number;
	    } else {
		goto badopt;
	    }


	} else if (strcmp(field, "-rooty") == 0) {
	    if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
		event.xkey.y_root = number;
	    } else {
		goto badopt;
	    }




	} else if (strcmp(field, "-sendevent") == 0) {

	    if (isdigit(UCHAR(value[0]))) {
		/*
		 * Allow arbitrary integer values for the field; they
		 * are needed by a few of the tests in the Tk test suite.
		 */


		if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
	    } else {

		if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    event.xany.send_event = number;


	} else if (strcmp(field, "-serial") == 0) {
	    if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
		return TCL_ERROR;
	    }
	    event.xany.serial = number;


	} else if (strcmp(field, "-state") == 0) {
	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {

		if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
		    event.xkey.state = number;
		} else {
		    event.xcrossing.state = number;
		}
	    } else if (flags & VISIBILITY) {
		number = TkFindStateNum(interp, field, visNotify, value);

		if (number < 0) {
		    return TCL_ERROR;
		}
		event.xvisibility.state = number;
	    } else {
		goto badopt;
	    }	    
	} else if (strcmp(field, "-subwindow") == 0) {
	    if (value[0] == '.') {
		tkwin2 = Tk_NameToWindow(interp, value, main);
		if (tkwin2 == NULL) {
		    return TCL_ERROR;
		}
		number = Tk_WindowId(tkwin2);
	    } else if (TkpScanWindowId(interp, value, &number)

		    != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
		event.xkey.subwindow = number;
	    } else {
		goto badopt;
	    }


	} else if (strcmp(field, "-time") == 0) {
	    if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
		event.xkey.time = (Time) number;
	    } else if (flags & PROP) {
		event.xproperty.time = (Time) number;
	    } else {
		goto badopt;
	    }


	} else if (strcmp(field, "-width") == 0) {
	    if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {

		return TCL_ERROR;
	    }
	    if (flags & EXPOSE) {
		event.xexpose.width = number;
	    } else if (flags & (CREATE|CONFIG)) {
		event.xcreatewindow.width = number;
	    } else {
		goto badopt;
	    }
	} else if (strcmp(field, "-window") == 0) {
	    if (value[0] == '.') {
		tkwin2 = Tk_NameToWindow(interp, value, main);
		if (tkwin2 == NULL) {
		    return TCL_ERROR;
		}
		number = Tk_WindowId(tkwin2);
	    } else if (TkpScanWindowId(interp, value, &number)

		    != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG
		    |GRAVITY|CIRC)) {
		event.xcreatewindow.window = number;
	    } else {
		goto badopt;
	    }


	} else if (strcmp(field, "-x") == 0) {
	    int rootX, rootY;
	    if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {


		return TCL_ERROR;
	    }
	    Tk_GetRootCoords(tkwin, &rootX, &rootY);
	    rootX += number;
	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {	
		event.xkey.x = number;
		event.xkey.x_root = rootX;
	    } else if (flags & EXPOSE) {
		event.xexpose.x = number;
	    } else if (flags & (CREATE|CONFIG|GRAVITY)) { 
		event.xcreatewindow.x = number;
	    } else if (flags & REPARENT) {		
		event.xreparent.x = number;
	    } else {
		goto badopt;
	    }


	} else if (strcmp(field, "-y") == 0) {
	    int rootX, rootY;
	    if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {


		return TCL_ERROR;
	    }
	    Tk_GetRootCoords(tkwin, &rootX, &rootY);
	    rootY += number;
	    if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
		event.xkey.y = number;
		event.xkey.y_root = rootY;
	    } else if (flags & EXPOSE) {
		event.xexpose.y = number;
	    } else if (flags & (CREATE|CONFIG|GRAVITY)) {
		event.xcreatewindow.y = number;
	    } else if (flags & REPARENT) {
		event.xreparent.y = number;
	    } else {
		goto badopt;
	    }




	} else {
	    badopt:
	    Tcl_AppendResult(interp, "bad option to ", argv[1],
		    " event: \"", field, "\"", (char *) NULL);
	    return TCL_ERROR;
	}
    }

    if (synch != 0) {
	Tk_HandleEvent(&event);
    } else {
	Tk_QueueWindowEvent(&event, pos);
    }
    Tcl_ResetResult(interp);
    return TCL_OK;









































































}

/*
 *-------------------------------------------------------------------------
 *
 * GetVirtualEventUid --
 *
 *	Determine if the given string is in the proper format for a
 *	virtual event.
 *
 * Results:
 *	The return value is NULL if the virtual event string was
 *	not in the proper format.  In this case, an error message
 *	will be left in interp->result.  Otherwise the return
 *	value is a Tk_Uid that represents the virtual event.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */







|
|
|
|
|

|
<
|
<
|

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

|
>





|
>



|
|
<
<
<
<













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

















|
|
<
|
<

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

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

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







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













|







3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172

3173

3174
3175
3176
3177
3178
3179
3180

3181
3182
3183
3184
3185
3186
3187
3188

3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200

3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231




3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244







3245




3246
















3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265

3266

3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283

3284
3285

3286
3287
3288


3289
3290
3291
3292

3293
3294
3295
3296
3297

3298
3299
3300
3301

3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404





3405
3406




3407
3408

3409

3410
3411
3412
3413
3414
3415
3416
3417
3418

3419

3420
3421
3422
3423
3424


3425
3426
3427
3428
3429



3430



3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472




3473
3474


3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558




3559
3560


3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596




3597
3598


3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664


3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
 *	The event may be handled sychronously or asynchronously, depending
 *	on the value specified by the optional "-when" option.  The
 *	default setting is synchronous.
 *
 *---------------------------------------------------------------------------
 */
static int
HandleEventGenerate(interp, mainWin, objc, objv)
    Tcl_Interp *interp;		/* Interp for errors return and name lookup. */
    Tk_Window mainWin;		/* Main window associated with interp. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    XEvent event;    

    char *name, *p;

    int count, flags, synch, i, number;
    Tcl_QueuePosition pos;
    Pattern pat;
    Tk_Window tkwin, tkwin2;
    TkWindow *mainPtr;
    unsigned long eventMask;
    static char *fieldStrings[] = {

	"-when",	"-above",	"-borderwidth",	"-button",
	"-count",	"-delta",	"-detail",	"-focus",
	"-height",
	"-keycode",	"-keysym",	"-mode",	"-override",
	"-place",	"-root",	"-rootx",	"-rooty",
	"-sendevent",	"-serial",	"-state",	"-subwindow",
	"-time",	"-width",	"-window",	"-x",
	"-y",		NULL

    };
    enum field {
	EVENT_WHEN,	EVENT_ABOVE,	EVENT_BORDER,	EVENT_BUTTON,
	EVENT_COUNT,	EVENT_DELTA,	EVENT_DETAIL,	EVENT_FOCUS,
	EVENT_HEIGHT,
	EVENT_KEYCODE,	EVENT_KEYSYM,	EVENT_MODE,	EVENT_OVERRIDE,
	EVENT_PLACE,	EVENT_ROOT,	EVENT_ROOTX,	EVENT_ROOTY,
	EVENT_SEND,	EVENT_SERIAL,	EVENT_STATE,	EVENT_SUBWINDOW,
	EVENT_TIME,	EVENT_WIDTH,	EVENT_WINDOW,	EVENT_X,
	EVENT_Y
    };


    if (NameToWindow(interp, mainWin, objv[0], &tkwin) != TCL_OK) {
	return TCL_ERROR;
    }

    mainPtr = (TkWindow *) mainWin;
    if ((tkwin == NULL)
	    || (mainPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
	char *name;

	name = Tcl_GetStringFromObj(objv[0], NULL);
	Tcl_AppendResult(interp, "window id \"", name, 		
		"\" doesn't exist in this application", (char *) NULL);
	return TCL_ERROR;
    }

    name = Tcl_GetStringFromObj(objv[1], NULL);

    p = name;
    eventMask = 0;
    count = ParseEventDescription(interp, &p, &pat, &eventMask);
    if (count == 0) {
	return TCL_ERROR;
    }
    if (count != 1) {
	Tcl_SetResult(interp, "Double or Triple modifier not allowed",
		TCL_STATIC);
	return TCL_ERROR;
    }
    if (*p != '\0') {
	Tcl_SetResult(interp, "only one event specification allowed",
		TCL_STATIC);




	return TCL_ERROR;
    }

    memset((VOID *) &event, 0, sizeof(event));
    event.xany.type = pat.eventType;
    event.xany.serial = NextRequest(Tk_Display(tkwin));
    event.xany.send_event = False;
    event.xany.window = Tk_WindowId(tkwin);
    event.xany.display = Tk_Display(tkwin);

    flags = flagArray[event.xany.type];
    if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
	event.xkey.state = pat.needMods;







	if ((flags & KEY) && (event.xany.type != MouseWheelEvent)) {




	    SetKeycodeAndState(tkwin, pat.detail.keySym, &event);
















	} else if (flags & BUTTON) {
	    event.xbutton.button = pat.detail.button;
	} else if (flags & VIRTUAL) {
	    ((XVirtualEvent *) &event)->name = pat.detail.name;
	}
    }
    if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG|GRAVITY|CIRC)) {
	event.xcreatewindow.window = event.xany.window;
    }

    /*
     * Process the remaining arguments to fill in additional fields
     * of the event.
     */

    synch = 1;
    pos = TCL_QUEUE_TAIL;
    for (i = 2; i < objc; i += 2) {
	Tcl_Obj *optionPtr, *valuePtr;

	int index;

	
	optionPtr = objv[i];
	valuePtr = objv[i + 1];

	if (Tcl_GetIndexFromObj(interp, optionPtr, fieldStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc & 1) {
	    /*
	     * This test occurs after Tcl_GetIndexFromObj() so that
	     * "event generate <Button> -xyz" will return the error message
	     * that "-xyz" is a bad option, rather than that the value
	     * for "-xyz" is missing.
	     */

	    Tcl_AppendResult(interp, "value for \"",

		    Tcl_GetStringFromObj(optionPtr, NULL), "\" missing",
		    (char *) NULL);

	    return TCL_ERROR;
	}



	switch ((enum field) index) {
	    case EVENT_WHEN: {
		pos = (Tcl_QueuePosition) TkFindStateNumObj(interp, optionPtr, 
			queuePosition, valuePtr);

		if ((int) pos < -1) {
		    return TCL_ERROR;
		}
		synch = 0;
		if ((int) pos == -1) {

		    synch = 1;
		}
		break;
	    }

	    case EVENT_ABOVE: {
		if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & CONFIG) {
		    event.xconfigure.above = Tk_WindowId(tkwin2);
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_BORDER: {
		if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & (CREATE|CONFIG)) {
		    event.xcreatewindow.border_width = number;
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_BUTTON: {
		if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & BUTTON) {
		    event.xbutton.button = number;
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_COUNT: {
		if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & EXPOSE) {
		    event.xexpose.count = number;
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_DELTA: {
		if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
		if ((flags & KEY) && (event.xkey.type == MouseWheelEvent)) {
		    event.xkey.keycode = number;
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_DETAIL: {
		number = TkFindStateNumObj(interp, optionPtr, notifyDetail,
			valuePtr);
		if (number < 0) {
		    return TCL_ERROR;
		}
		if (flags & FOCUS) {
		    event.xfocus.detail = number;
		} else if (flags & CROSSING) {
		    event.xcrossing.detail = number;
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_FOCUS: {
		if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & CROSSING) {
		    event.xcrossing.focus = number;
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_HEIGHT: {
		if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & EXPOSE) {
		     event.xexpose.height = number;
		} else if (flags & CONFIG) {
		    event.xconfigure.height = number;
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_KEYCODE: {
		if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
		if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) {
		    event.xkey.keycode = number;
		} else {
		    goto badopt;
		}





		break;
	    }




	    case EVENT_KEYSYM: {
		KeySym keysym;

		char *value;


		value = Tcl_GetStringFromObj(valuePtr, NULL);
		keysym = TkStringToKeysym(value);
		if (keysym == NoSymbol) {
		    Tcl_AppendResult(interp, "unknown keysym \"", value, "\"",
			    (char *) NULL);
		    return TCL_ERROR;
		}


		SetKeycodeAndState(tkwin, keysym, &event);

		if (event.xkey.keycode == 0) {
		    Tcl_AppendResult(interp, "no keycode for keysym \"", value,
			    "\"", (char *) NULL);
		    return TCL_ERROR;
		}


		if (!(flags & KEY) || (event.xkey.type == MouseWheelEvent)) {
		    goto badopt;
		}
		break;
	    }



	    case EVENT_MODE: {



		number = TkFindStateNumObj(interp, optionPtr, notifyMode,
			valuePtr);
		if (number < 0) {
		    return TCL_ERROR;
		}
		if (flags & CROSSING) {
		    event.xcrossing.mode = number;
		} else if (flags & FOCUS) {
		    event.xfocus.mode = number;
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_OVERRIDE: {
		if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & CREATE) {
		    event.xcreatewindow.override_redirect = number;
		} else if (flags & MAP) {
		    event.xmap.override_redirect = number;
		} else if (flags & REPARENT) {
		    event.xreparent.override_redirect = number;
		} else if (flags & CONFIG) {
		    event.xconfigure.override_redirect = number;
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_PLACE: {
		number = TkFindStateNumObj(interp, optionPtr, circPlace,
			valuePtr);
		if (number < 0) {
		    return TCL_ERROR;
		}
		if (flags & CIRC) {
		    event.xcirculate.place = number;
		} else {
		    goto badopt;
		}




		break;
	    }


	    case EVENT_ROOT: {
		if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
		    event.xkey.root = Tk_WindowId(tkwin2);
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_ROOTX: {
		if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
		    event.xkey.x_root = number;
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_ROOTY: {
		if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
		    event.xkey.y_root = number;
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_SEND: {
		CONST char *value;

		value = Tcl_GetStringFromObj(valuePtr, NULL);
		if (isdigit(UCHAR(value[0]))) {
		    /*
		     * Allow arbitrary integer values for the field; they
		     * are needed by a few of the tests in the Tk test suite.
		     */

		    if (Tcl_GetIntFromObj(interp, valuePtr, &number)
			    != TCL_OK) {
			return TCL_ERROR;
		    }
		} else {
		    if (Tcl_GetBooleanFromObj(interp, valuePtr, &number)
			    != TCL_OK) {
			return TCL_ERROR;
		    }
		}
		event.xany.send_event = number;
		break;
	    }
	    case EVENT_SERIAL: {
		if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
		event.xany.serial = number;
		break;
	    }
	    case EVENT_STATE: {
		if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
		    if (Tcl_GetIntFromObj(interp, valuePtr, &number)
			    != TCL_OK) {
			return TCL_ERROR;
		    }
		    if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
			event.xkey.state = number;
		    } else {
			event.xcrossing.state = number;
		    }
		} else if (flags & VISIBILITY) {
		    number = TkFindStateNumObj(interp, optionPtr, visNotify,
			    valuePtr);
		    if (number < 0) {
			return TCL_ERROR;
		    }
		    event.xvisibility.state = number;
		} else {
		    goto badopt;
		}




		break;
	    }


	    case EVENT_SUBWINDOW: {
		if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
		    event.xkey.subwindow = Tk_WindowId(tkwin2);
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_TIME: {
		if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
		    event.xkey.time = (Time) number;
		} else if (flags & PROP) {
		    event.xproperty.time = (Time) number;
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_WIDTH: {
		if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
			!= TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & EXPOSE) {
		    event.xexpose.width = number;
		} else if (flags & (CREATE|CONFIG)) {
		    event.xcreatewindow.width = number;
		} else {
		    goto badopt;
		}




		break;
	    }


	    case EVENT_WINDOW: {
		if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG
			|GRAVITY|CIRC)) {
		    event.xcreatewindow.window = Tk_WindowId(tkwin2);
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_X: {
		int rootX, rootY;

		if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
			!= TCL_OK) {
		    return TCL_ERROR;
		}
		Tk_GetRootCoords(tkwin, &rootX, &rootY);
		rootX += number;
		if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {	
		    event.xkey.x = number;
		    event.xkey.x_root = rootX;
		} else if (flags & EXPOSE) {
		    event.xexpose.x = number;
		} else if (flags & (CREATE|CONFIG|GRAVITY)) { 
		    event.xcreatewindow.x = number;
		} else if (flags & REPARENT) {		
		    event.xreparent.x = number;
		} else {
		    goto badopt;
		}
		break;
	    }
	    case EVENT_Y: {
		int rootX, rootY;

		if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &number)
			!= TCL_OK) {
		    return TCL_ERROR;
		}
		Tk_GetRootCoords(tkwin, &rootX, &rootY);
		rootY += number;
		if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
		    event.xkey.y = number;
		    event.xkey.y_root = rootY;
		} else if (flags & EXPOSE) {
		    event.xexpose.y = number;
		} else if (flags & (CREATE|CONFIG|GRAVITY)) {
		    event.xcreatewindow.y = number;
		} else if (flags & REPARENT) {
		    event.xreparent.y = number;
		} else {
		    goto badopt;
		}
		break;
	    }
	}
	continue;
	
	badopt:
	Tcl_AppendResult(interp, name, " event doesn't accept \"",
		Tcl_GetStringFromObj(optionPtr, NULL), "\" option", NULL);
	return TCL_ERROR;
    }


    if (synch != 0) {
	Tk_HandleEvent(&event);
    } else {
	Tk_QueueWindowEvent(&event, pos);
    }
    Tcl_ResetResult(interp);
    return TCL_OK;
		
}
static int
NameToWindow(interp, mainWin, objPtr, tkwinPtr)
    Tcl_Interp *interp;		/* Interp for error return and name lookup. */
    Tk_Window mainWin;		/* Main window of application. */
    Tcl_Obj *objPtr;		/* Contains name or id string of window. */
    Tk_Window *tkwinPtr;	/* Filled with token for window. */
{
    char *name;
    Tk_Window tkwin;
    int id;
    
    name = Tcl_GetStringFromObj(objPtr, NULL);
    if (name[0] == '.') {
	tkwin = Tk_NameToWindow(interp, name, mainWin);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
	*tkwinPtr = tkwin;
    } else {
	if (TkpScanWindowId(NULL, name, &id) != TCL_OK) {
	    Tcl_AppendResult(interp, "bad window name/identifier \"",
		    name, "\"", (char *) NULL);
	    return TCL_ERROR;
	}
	*tkwinPtr = Tk_IdToWindow(Tk_Display(mainWin), (Window) id);
    }
    return TCL_OK;
}

/*
 * When mapping from a keysym to a keycode, need
 * information about the modifier state that should be used
 * so that when they call XKeycodeToKeysym taking into
 * account the xkey.state, they will get back the original
 * keysym.
 */

static void
SetKeycodeAndState(tkwin, keySym, eventPtr)
    Tk_Window tkwin;
    KeySym keySym;
    XEvent *eventPtr;
{
    Display *display;
    int state;
    KeyCode keycode;
    
    display = Tk_Display(tkwin);
    
    if (keySym == NoSymbol) {
	keycode = 0;
    } else {
	keycode = XKeysymToKeycode(display, keySym);
    }
    if (keycode != 0) {
	for (state = 0; state < 4; state++) {
	    if (XKeycodeToKeysym(display, keycode, state) == keySym) {
		if (state & 1) {
		    eventPtr->xkey.state |= ShiftMask;
		}
		if (state & 2) {
		    TkDisplay *dispPtr;

		    dispPtr = ((TkWindow *) tkwin)->dispPtr; 
		    eventPtr->xkey.state |= dispPtr->modeModMask;
		}
		break;
	    }
	}
    }
    eventPtr->xkey.keycode = keycode;
}

/*
 *-------------------------------------------------------------------------
 *
 * GetVirtualEventUid --
 *
 *	Determine if the given string is in the proper format for a
 *	virtual event.
 *
 * Results:
 *	The return value is NULL if the virtual event string was
 *	not in the proper format.  In this case, an error message
 *	will be left in the interp's result.  Otherwise the return
 *	value is a Tk_Uid that represents the virtual event.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
 *	entry.
 *
 * Results:
 *	The return value is normally a pointer to the PatSeq
 *	in patternTable that corresponds to eventString.  If an error
 *	was found while parsing eventString, or if "create" is 0 and
 *	no pattern sequence previously existed, then NULL is returned
 *	and interp->result contains a message describing the problem.
 *	If no pattern sequence previously existed for eventString, then
 *	a new one is created with a NULL command field.  In a successful
 *	return, *maskPtr is filled in with a mask of the event types
 *	on which the pattern sequence depends.
 *
 * Side effects:
 *	A new pattern sequence may be allocated.







|







3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
 *	entry.
 *
 * Results:
 *	The return value is normally a pointer to the PatSeq
 *	in patternTable that corresponds to eventString.  If an error
 *	was found while parsing eventString, or if "create" is 0 and
 *	no pattern sequence previously existed, then NULL is returned
 *	and the interp's result contains a message describing the problem.
 *	If no pattern sequence previously existed for eventString, then
 *	a new one is created with a NULL command field.  In a successful
 *	return, *maskPtr is filled in with a mask of the event types
 *	on which the pattern sequence depends.
 *
 * Side effects:
 *	A new pattern sequence may be allocated.
3708
3709
3710
3711
3712
3713
3714
3715
3716

3717
3718
3719
3720
3721
3722
3723
	count = ParseEventDescription(interp, &p, patPtr, &eventMask);
	if (count == 0) {
	    return NULL;
	}

	if (eventMask & VirtualEventMask) {
	    if (allowVirtual == 0) {
		interp->result =
			"virtual event not allowed in definition of another virtual event";

		return NULL;
	    }
	    virtualFound = 1;
	}

	/*
	 * Replicate events for DOUBLE and TRIPLE.







|
|
>







3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
	count = ParseEventDescription(interp, &p, patPtr, &eventMask);
	if (count == 0) {
	    return NULL;
	}

	if (eventMask & VirtualEventMask) {
	    if (allowVirtual == 0) {
		Tcl_SetResult(interp, 
			"virtual event not allowed in definition of another virtual event",
			TCL_STATIC);
		return NULL;
	    }
	    virtualFound = 1;
	}

	/*
	 * Replicate events for DOUBLE and TRIPLE.
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751

3752
3753
3754
3755
3756
3757
3758
     *-------------------------------------------------------------
     * Step 2: find the sequence in the binding table if it exists,
     * and add a new sequence to the table if it doesn't.
     *-------------------------------------------------------------
     */

    if (numPats == 0) {
	interp->result = "no events specified in binding";
	return NULL;
    }
    if ((numPats > 1) && (virtualFound != 0)) {
        interp->result = "virtual events may not be composed";

	return NULL;
    }
    
    patPtr = &pats[EVENT_BUFFER_SIZE-numPats];
    memset(&key, 0, sizeof(key));
    key.object = object;
    key.type = patPtr->eventType;







|



|
>







3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
     *-------------------------------------------------------------
     * Step 2: find the sequence in the binding table if it exists,
     * and add a new sequence to the table if it doesn't.
     *-------------------------------------------------------------
     */

    if (numPats == 0) {
	Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC);
	return NULL;
    }
    if ((numPats > 1) && (virtualFound != 0)) {
	Tcl_SetResult(interp, "virtual events may not be composed",
		TCL_STATIC);
	return NULL;
    }
    
    patPtr = &pats[EVENT_BUFFER_SIZE-numPats];
    memset(&key, 0, sizeof(key));
    key.object = object;
    key.type = patPtr->eventType;
3770
3771
3772
3773
3774
3775
3776








3777
3778
3779
3780
3781
3782
3783
	    }
	}
    }
    if (!create) {
	if (new) {
	    Tcl_DeleteHashEntry(hPtr);
	}








	return NULL;
    }
    psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq)
	    + (numPats-1)*sizeof(Pattern)));
    psPtr->numPats = numPats;
    psPtr->eventProc = NULL;
    psPtr->freeProc = NULL;







>
>
>
>
>
>
>
>







3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
	    }
	}
    }
    if (!create) {
	if (new) {
	    Tcl_DeleteHashEntry(hPtr);
	}
	/*
	 * No binding exists for the sequence, so return an empty error.
	 * This is a special error that the caller will check for in order
	 * to silently ignore this case.  This is a hack that maintains
	 * backward compatibility for Tk_GetBinding but the various "bind"
	 * commands silently ignore missing bindings.
	 */
	
	return NULL;
    }
    psPtr = (PatSeq *) ckalloc((unsigned) (sizeof(PatSeq)
	    + (numPats-1)*sizeof(Pattern)));
    psPtr->numPats = numPats;
    psPtr->eventProc = NULL;
    psPtr->freeProc = NULL;
3859
3860
3861
3862
3863
3864
3865

3866
3867

3868
3869
3870
3871
3872
3873
3874
	string[0] = *p;
	string[1] = 0;
	patPtr->detail.keySym = TkStringToKeysym(string);
	if (patPtr->detail.keySym == NoSymbol) {
	    if (isprint(UCHAR(*p))) {
		patPtr->detail.keySym = *p;
	    } else {

		sprintf(interp->result,
			"bad ASCII character 0x%x", (unsigned char) *p);

		return 0;
	    }
	}
	p++;
	goto end;
    }








>
|
|
>







4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
	string[0] = *p;
	string[1] = 0;
	patPtr->detail.keySym = TkStringToKeysym(string);
	if (patPtr->detail.keySym == NoSymbol) {
	    if (isprint(UCHAR(*p))) {
		patPtr->detail.keySym = *p;
	    } else {
		char buf[64];
		
		sprintf(buf, "bad ASCII character 0x%x", (unsigned char) *p);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
		return 0;
	    }
	}
	p++;
	goto end;
    }

3900
3901
3902
3903
3904
3905
3906
3907

3908
3909
3910
3911

3912
3913
3914
3915
3916
3917
3918
	 * This is a virtual event: soak up all the characters up to
	 * the next '>'.
	 */

	char *field = p + 1;	    
	p = strchr(field, '>');
	if (p == field) {
	    interp->result = "virtual event \"<<>>\" is badly formed";

	    return 0;
	}	    
	if ((p == NULL) || (p[1] != '>')) {
	    interp->result = "missing \">\" in virtual binding";

	    return 0;
	}
	*p = '\0';
	patPtr->eventType = VirtualEvent;
	eventMask = VirtualEventMask;
	patPtr->detail.name = Tk_GetUid(field);
	*p = '>';







|
>



|
>







4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
	 * This is a virtual event: soak up all the characters up to
	 * the next '>'.
	 */

	char *field = p + 1;	    
	p = strchr(field, '>');
	if (p == field) {
	    Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed",
		    TCL_STATIC);
	    return 0;
	}	    
	if ((p == NULL) || (p[1] != '>')) {
	    Tcl_SetResult(interp, "missing \">\" in virtual binding",
		    TCL_STATIC);
	    return 0;
	}
	*p = '\0';
	patPtr->eventType = VirtualEvent;
	eventMask = VirtualEventMask;
	patPtr->detail.name = Tk_GetUid(field);
	*p = '>';
3991
3992
3993
3994
3995
3996
3997
3998

3999
4000
4001
4002
4003
4004
4005
4006
4007
4008

4009

4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
	    } else if ((eventFlags & KEY) == 0) {
		Tcl_AppendResult(interp, "specified keysym \"", field,
			"\" for non-key event", (char *) NULL);
		return 0;
	    }
	}
    } else if (eventFlags == 0) {
	interp->result = "no event type or button # or keysym";

	return 0;
    }

    while ((*p == '-') || isspace(UCHAR(*p))) {
	p++;
    }
    if (*p != '>') {
	while (*p != '\0') {
	    p++;
	    if (*p == '>') {

		interp->result = "extra characters after detail in binding";

		return 0;
	    }
	}
	interp->result = "missing \">\" in binding";
	return 0;
    }
    p++;

end:
    *eventStringPtr = p;
    *eventMaskPtr |= eventMask;







|
>










>
|
>



|







4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
	    } else if ((eventFlags & KEY) == 0) {
		Tcl_AppendResult(interp, "specified keysym \"", field,
			"\" for non-key event", (char *) NULL);
		return 0;
	    }
	}
    } else if (eventFlags == 0) {
	Tcl_SetResult(interp, "no event type or button # or keysym",
		TCL_STATIC);
	return 0;
    }

    while ((*p == '-') || isspace(UCHAR(*p))) {
	p++;
    }
    if (*p != '>') {
	while (*p != '\0') {
	    p++;
	    if (*p == '>') {
		Tcl_SetResult(interp,
			"extra characters after detail in binding",
			TCL_STATIC);
		return 0;
	    }
	}
	Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC);
	return 0;
    }
    p++;

end:
    *eventStringPtr = p;
    *eventMaskPtr |= eventMask;
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
 */
static void
GetPatternString(psPtr, dsPtr)
    PatSeq *psPtr;
    Tcl_DString *dsPtr;
{
    Pattern *patPtr;
    char c, buffer[10];
    int patsLeft, needMods;
    ModInfo *modPtr;
    EventInfo *eiPtr;

    /*
     * The order of the patterns in the sequence is backwards from the order
     * in which they must be output.







|







4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
 */
static void
GetPatternString(psPtr, dsPtr)
    PatSeq *psPtr;
    Tcl_DString *dsPtr;
{
    Pattern *patPtr;
    char c, buffer[TCL_INTEGER_SPACE];
    int patsLeft, needMods;
    ModInfo *modPtr;
    EventInfo *eiPtr;

    /*
     * The order of the patterns in the sequence is backwards from the order
     * in which they must be output.
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
 *
 *	This procedure makes a copy of a script then calls Tcl_GlobalEval
 *	to evaluate it.  It's used in situations where the execution of
 *	a command may cause the original command string to be reallocated.
 *
 * Results:
 *	Returns the result of evaluating script, including both a standard
 *	Tcl completion code and a string in interp->result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */








|







4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
 *
 *	This procedure makes a copy of a script then calls Tcl_GlobalEval
 *	to evaluate it.  It's used in situations where the execution of
 *	a command may cause the original command string to be reallocated.
 *
 * Results:
 *	Returns the result of evaluating script, including both a standard
 *	Tcl completion code and a string in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Changes to generic/tkBitmap.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkBitmap.c --
 *
 *	This file maintains a database of read-only bitmaps for the Tk
 *	toolkit.  This allows bitmaps to be shared between widgets and
 *	also avoids interactions with the X server.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkBitmap.c 1.45 97/07/24 17:27:38
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * The includes below are for pre-defined bitmaps.








|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkBitmap.c --
 *
 *	This file maintains a database of read-only bitmaps for the Tk
 *	toolkit.  This allows bitmaps to be shared between widgets and
 *	also avoids interactions with the X server.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkBitmap.c,v 1.1.4.6 1999/03/30 23:56:54 stanton Exp $
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * The includes below are for pre-defined bitmaps.
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

/*
 * One of the following data structures exists for each bitmap that is
 * currently in use.  Each structure is indexed with both "idTable" and
 * "nameTable".
 */

typedef struct {
    Pixmap bitmap;		/* X identifier for bitmap.  None means this
				 * bitmap was created by Tk_DefineBitmap
				 * and it isn't currently in use. */
    int width, height;		/* Dimensions of bitmap. */
    Display *display;		/* Display for which bitmap is valid. */
    int refCount;		/* Number of active uses of bitmap. */











    Tcl_HashEntry *hashPtr;	/* Entry in nameTable for this structure
				 * (needed when deleting). */







} TkBitmap;

/*
 * Hash table to map from a textual description of a bitmap to the
 * TkBitmap record for the bitmap, and key structure used in that
 * hash table:
 */

static Tcl_HashTable nameTable;
typedef struct {
    Tk_Uid name;		/* Textual name for desired bitmap. */
    Screen *screen;		/* Screen on which bitmap will be used. */
} NameKey;

/*
 * Hash table that maps from <display + bitmap id> to the TkBitmap structure
 * for the bitmap.  This table is used by Tk_FreeBitmap.
 */

static Tcl_HashTable idTable;
typedef struct {

    Display *display;		/* Display for which bitmap was allocated. */
    Pixmap pixmap;		/* X identifier for pixmap. */
} IdKey;

/*
 * Hash table create by Tk_DefineBitmap to map from a name to a
 * collection of in-core data about a bitmap.  The table is

 * indexed by the address of the data for the bitmap, and the entries
 * contain pointers to TkPredefBitmap structures.
 */

Tcl_HashTable tkPredefBitmapTable;

/*
 * Hash table used by Tk_GetBitmapFromData to map from a collection
 * of in-core data about a bitmap to a Tk_Uid giving an automatically-
 * generated name for the bitmap:
 */

static Tcl_HashTable dataTable;
typedef struct {
    char *source;		/* Bitmap bits. */
    int width, height;		/* Dimensions of bitmap. */
} DataKey;

static int initialized = 0;	/* 0 means static structures haven't been
				 * initialized yet. */

/*
 * Forward declarations for procedures defined in this file:
 */

static void		BitmapInit _ANSI_ARGS_((void));






















































































































/*
 *----------------------------------------------------------------------
 *
 * Tk_GetBitmap --
 *
 *	Given a string describing a bitmap, locate (or create if necessary)
 *	a bitmap that fits the description.
 *
 * Results:
 *	The return value is the X identifer for the desired bitmap
 *	(i.e. a Pixmap with a single plane), unless string couldn't be
 *	parsed correctly.  In this case, None is returned and an error
 *	message is left in interp->result.  The caller should never
 *	modify the bitmap that is returned, and should eventually call
 *	Tk_FreeBitmap when the bitmap is no longer needed.
 *
 * Side effects:
 *	The bitmap is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call
 *	to Tk_FreeBitmap, so that the database can be cleaned up when bitmaps
 *	aren't needed anymore.
 *
 *----------------------------------------------------------------------
 */

Pixmap
Tk_GetBitmap(interp, tkwin, string)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting,
				 * this may be NULL. */
    Tk_Window tkwin;		/* Window in which bitmap will be used. */
    Tk_Uid string;		/* Description of bitmap.  See manual entry
				 * for details on legal syntax. */
{






    NameKey nameKey;


























    IdKey idKey;








    Tcl_HashEntry *nameHashPtr, *idHashPtr, *predefHashPtr;
    register TkBitmap *bitmapPtr;
    TkPredefBitmap *predefPtr;
    int new;
    Pixmap bitmap;
    int width, height;
    int dummy2;




    if (!initialized) {
	BitmapInit();
    }

    nameKey.name = string;
    nameKey.screen = Tk_Screen(tkwin);
    nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &nameKey, &new);
    if (!new) {
	bitmapPtr = (TkBitmap *) Tcl_GetHashValue(nameHashPtr);



	bitmapPtr->refCount++;
	return bitmapPtr->bitmap;




    }

    /*
     * No suitable bitmap exists.  Create a new bitmap from the
     * information contained in the string.  If the string starts
     * with "@" then the rest of the string is a file name containing
     * the bitmap.  Otherwise the string must refer to a bitmap
     * defined by a call to Tk_DefineBitmap.
     */

    if (*string == '@') {
	Tcl_DString buffer;
	int result;

        if (Tcl_IsSafe(interp)) {
            Tcl_AppendResult(interp, "can't specify bitmap with '@' in a",
                    " safe interpreter", (char *) NULL);
            goto error;
        }
        






	string = Tcl_TranslateFileName(interp, string + 1, &buffer);
	if (string == NULL) {
	    goto error;
	}
	result = XReadBitmapFile(Tk_Display(tkwin),
		RootWindowOfScreen(nameKey.screen), string,
		(unsigned int *) &width, (unsigned int *) &height,
		&bitmap, &dummy2, &dummy2);
	if (result != BitmapSuccess) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "error reading bitmap file \"", string,
		    "\"", (char *) NULL);
	    }
	    Tcl_DStringFree(&buffer);
	    goto error;
	}
	Tcl_DStringFree(&buffer);
    } else {
	predefHashPtr = Tcl_FindHashEntry(&tkPredefBitmapTable, string);

	if (predefHashPtr == NULL) {
	    /*
	     * The following platform specific call allows the user to
	     * define bitmaps that may only exist during run time.  If
	     * it returns None nothing was found and we return the error.
	     */
	    bitmap = TkpGetNativeAppBitmap(Tk_Display(tkwin), string,







|





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

>
>
>
>
>
>
>


|
|
|
<


<

|
|
|

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





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













|

















|


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





>
>
>

|
|


<
<
|

|
>
>
>
|
|
>
>
>
>










|








|
>
>
>
>
>
>
|



|
|












|
>







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

86
87

88
89
90
91
92






93
94
95


96

97
98
99
100
101











102


103
104


105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318


319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383

/*
 * One of the following data structures exists for each bitmap that is
 * currently in use.  Each structure is indexed with both "idTable" and
 * "nameTable".
 */

typedef struct TkBitmap {
    Pixmap bitmap;		/* X identifier for bitmap.  None means this
				 * bitmap was created by Tk_DefineBitmap
				 * and it isn't currently in use. */
    int width, height;		/* Dimensions of bitmap. */
    Display *display;		/* Display for which bitmap is valid. */
    int resourceRefCount;	/* Number of active uses of this bitmap (each
				 * active use corresponds to a call to
				 * Tk_AllocBitmapFromObj or Tk_GetBitmap).
				 * If this count is 0, then this TkBitmap
				 * structure is no longer valid and it isn't
				 * present in nameTable: it is being kept
				 * around only because there are objects
				 * referring to it.  The structure is freed
				 * when resourceRefCount and objRefCount
				 * are both 0. */
    int objRefCount;		/* Number of Tcl_Obj's that reference
				 * this structure. */
    Tcl_HashEntry *nameHashPtr;	/* Entry in nameTable for this structure
				 * (needed when deleting). */
    Tcl_HashEntry *idHashPtr;	/* Entry in idTable for this structure
				 * (needed when deleting). */
    struct TkBitmap *nextPtr;	/* Points to the next TkBitmap structure with
				 * the same name.  All bitmaps with the
				 * same name (but different displays) are
				 * chained together off a single entry in
				 * nameTable. */
} TkBitmap;

/* 
 * Used in bitmapDataTable, stored in the TkDisplay structure, to map
 * between in-core data about a bitmap to its TkBitmap structure.

 */


typedef struct {
    char *source;		/* Bitmap bits. */
    int width, height;		/* Dimensions of bitmap. */
} DataKey;







typedef struct ThreadSpecificData {
    int initialized;            /* 0 means table below needs initializing. */
    Tcl_HashTable predefBitmapTable;


                                /* Hash table created by Tk_DefineBitmap 

				 * to map from a name to a collection 
				 * of in-core data about a bitmap.  The 
				 * table is indexed by the address of the 
				 * data for the bitmap, and the entries
				 * contain pointers to TkPredefBitmap 











				 * structures. */


} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;



/*
 * Forward declarations for procedures defined in this file:
 */

static void		BitmapInit _ANSI_ARGS_((TkDisplay *dispPtr));
static void		DupBitmapObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
			    Tcl_Obj *dupObjPtr));
static void		FreeBitmap _ANSI_ARGS_((TkBitmap *bitmapPtr));
static void		FreeBitmapObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
static TkBitmap *	GetBitmap _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, CONST char *name));
static TkBitmap *	GetBitmapFromObj _ANSI_ARGS_((Tk_Window tkwin,
			    Tcl_Obj *objPtr));
static void		InitBitmapObj _ANSI_ARGS_((Tcl_Obj *objPtr));

/*
 * The following structure defines the implementation of the "bitmap" Tcl
 * object, which maps a string bitmap name to a TkBitmap object.  The
 * ptr1 field of the Tcl_Obj points to a TkBitmap object.
 */

static Tcl_ObjType bitmapObjType = {
    "bitmap",			/* name */
    FreeBitmapObjProc,		/* freeIntRepProc */
    DupBitmapObjProc,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL			/* setFromAnyProc */
};

/*
 *----------------------------------------------------------------------
 *
 * Tk_AllocBitmapFromObj --
 *
 *	Given a Tcl_Obj *, map the value to a corresponding
 *	Pixmap structure based on the tkwin given.
 *
 * Results:
 *	The return value is the X identifer for the desired bitmap
 *	(i.e. a Pixmap with a single plane), unless string couldn't be
 *	parsed correctly.  In this case, None is returned and an error
 *	message is left in the interp's result.  The caller should never
 *	modify the bitmap that is returned, and should eventually call
 *	Tk_FreeBitmapFromObj when the bitmap is no longer needed.
 *
 * Side effects:
 *	The bitmap is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call
 *	to Tk_FreeBitmapFromObj, so that the database can be cleaned up 
 *	when bitmaps aren't needed anymore.
 *
 *----------------------------------------------------------------------
 */

Pixmap
Tk_AllocBitmapFromObj(interp, tkwin, objPtr)
    Tcl_Interp *interp;		/* Interp for error results. This may 
				 * be NULL. */
    Tk_Window tkwin;		/* Need the screen the bitmap is used on.*/
    Tcl_Obj *objPtr;		/* Object describing bitmap; see manual
				 * entry for legal syntax of string value. */
{
    TkBitmap *bitmapPtr;

    if (objPtr->typePtr != &bitmapObjType) {
	InitBitmapObj(objPtr);
    }
    bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1;

    /*
     * If the object currently points to a TkBitmap, see if it's the
     * one we want.  If so, increment its reference count and return.
     */

    if (bitmapPtr != NULL) {
	if (bitmapPtr->resourceRefCount == 0) {
	    /*
	     * This is a stale reference: it refers to a TkBitmap that's
	     * no longer in use.  Clear the reference.
	     */

	    FreeBitmapObjProc(objPtr);
	    bitmapPtr = NULL;
	} else if (Tk_Display(tkwin) == bitmapPtr->display) {
	    bitmapPtr->resourceRefCount++;
	    return bitmapPtr->bitmap;
	}
    }

    /*
     * The object didn't point to the TkBitmap that we wanted.  Search
     * the list of TkBitmaps with the same name to see if one of the
     * others is the right one.
     */

    if (bitmapPtr != NULL) {
	TkBitmap *firstBitmapPtr =
		(TkBitmap *) Tcl_GetHashValue(bitmapPtr->nameHashPtr);
	FreeBitmapObjProc(objPtr);
	for (bitmapPtr = firstBitmapPtr; bitmapPtr != NULL;
		bitmapPtr = bitmapPtr->nextPtr) {
	    if (Tk_Display(tkwin) == bitmapPtr->display) {
		bitmapPtr->resourceRefCount++;
		bitmapPtr->objRefCount++;
		objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;
		return bitmapPtr->bitmap;
	    }
	}
    }

    /*
     * Still no luck.  Call GetBitmap to allocate a new TkBitmap object.
     */

    bitmapPtr = GetBitmap(interp, tkwin, Tcl_GetString(objPtr));
    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;
    if (bitmapPtr == NULL) {
	return None;
    }
    bitmapPtr->objRefCount++;
    return bitmapPtr->bitmap;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetBitmap --
 *
 *	Given a string describing a bitmap, locate (or create if necessary)
 *	a bitmap that fits the description.
 *
 * Results:
 *	The return value is the X identifer for the desired bitmap
 *	(i.e. a Pixmap with a single plane), unless string couldn't be
 *	parsed correctly.  In this case, None is returned and an error
 *	message is left in the interp's result.  The caller should never
 *	modify the bitmap that is returned, and should eventually call
 *	Tk_FreeBitmap when the bitmap is no longer needed.
 *
 * Side effects:
 *	The bitmap is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call
 *	to Tk_FreeBitmap, so that the database can be cleaned up when bitmaps
 *	aren't needed anymore.
 *
 *----------------------------------------------------------------------
 */

Pixmap
Tk_GetBitmap(interp, tkwin, string)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting,
				 * this may be NULL. */
    Tk_Window tkwin;		/* Window in which bitmap will be used. */
    CONST char *string;		/* Description of bitmap.  See manual entry
				 * for details on legal syntax. */
{
    TkBitmap *bitmapPtr = GetBitmap(interp, tkwin, string);
    if (bitmapPtr == NULL) {
	return None;
    }
    return bitmapPtr->bitmap;
}

/*
 *----------------------------------------------------------------------
 *
 * GetBitmap --
 *
 *	Given a string describing a bitmap, locate (or create if necessary)
 *	a bitmap that fits the description. This routine returns the
 *	internal data structure for the bitmap. This avoids extra
 *	hash table lookups in Tk_AllocBitmapFromObj.
 *
 * Results:
 *	The return value is the X identifer for the desired bitmap
 *	(i.e. a Pixmap with a single plane), unless string couldn't be
 *	parsed correctly.  In this case, None is returned and an error
 *	message is left in the interp's result.  The caller should never
 *	modify the bitmap that is returned, and should eventually call
 *	Tk_FreeBitmap when the bitmap is no longer needed.
 *
 * Side effects:
 *	The bitmap is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call
 *	to Tk_FreeBitmap or Tk_FreeBitmapFromObj, so that the database can
 *	be cleaned up when bitmaps aren't needed anymore.
 *
 *----------------------------------------------------------------------
 */

static TkBitmap *
GetBitmap(interp, tkwin, string)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting,
				 * this may be NULL. */
    Tk_Window tkwin;		/* Window in which bitmap will be used. */
    CONST char *string;		/* Description of bitmap.  See manual entry
				 * for details on legal syntax. */
{
    Tcl_HashEntry *nameHashPtr, *predefHashPtr;
    TkBitmap *bitmapPtr, *existingBitmapPtr;
    TkPredefBitmap *predefPtr;
    int new;
    Pixmap bitmap;
    int width, height;
    int dummy2;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (!dispPtr->bitmapInit) {
	BitmapInit(dispPtr);
    }



    nameHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapNameTable, string, &new);
    if (!new) {
	existingBitmapPtr = (TkBitmap *) Tcl_GetHashValue(nameHashPtr);
	for (bitmapPtr = existingBitmapPtr; bitmapPtr != NULL;
		bitmapPtr = bitmapPtr->nextPtr) {
	    if (Tk_Display(tkwin) == bitmapPtr->display) {
		bitmapPtr->resourceRefCount++;
		return bitmapPtr;
	    }
	}
    } else {
	existingBitmapPtr = NULL;
    }

    /*
     * No suitable bitmap exists.  Create a new bitmap from the
     * information contained in the string.  If the string starts
     * with "@" then the rest of the string is a file name containing
     * the bitmap.  Otherwise the string must refer to a bitmap
     * defined by a call to Tk_DefineBitmap.
     */

    if (*string == '@') {	/* INTL: ISO char */
	Tcl_DString buffer;
	int result;

        if (Tcl_IsSafe(interp)) {
            Tcl_AppendResult(interp, "can't specify bitmap with '@' in a",
                    " safe interpreter", (char *) NULL);
            goto error;
        }

	/*
	 * Note that we need to cast away the CONST from the string because
	 * Tcl_TranslateFileName is non const, even though it doesn't modify
	 * the string.
	 */

	string = Tcl_TranslateFileName(interp, (char *) string + 1, &buffer);
	if (string == NULL) {
	    goto error;
	}
	result = TkReadBitmapFile(Tk_Display(tkwin),
		RootWindowOfScreen(Tk_Screen(tkwin)), string,
		(unsigned int *) &width, (unsigned int *) &height,
		&bitmap, &dummy2, &dummy2);
	if (result != BitmapSuccess) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "error reading bitmap file \"", string,
		    "\"", (char *) NULL);
	    }
	    Tcl_DStringFree(&buffer);
	    goto error;
	}
	Tcl_DStringFree(&buffer);
    } else {
	predefHashPtr = Tcl_FindHashEntry(&tsdPtr->predefBitmapTable, 
                string);
	if (predefHashPtr == NULL) {
	    /*
	     * The following platform specific call allows the user to
	     * define bitmaps that may only exist during run time.  If
	     * it returns None nothing was found and we return the error.
	     */
	    bitmap = TkpGetNativeAppBitmap(Tk_Display(tkwin), string,
232
233
234
235
236
237
238
239

240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262

263
264
265
266
267

268

269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303


304








305
306
307
308
309

310
311
312
313
314
315
316
		bitmap = TkpCreateNativeBitmap(Tk_Display(tkwin),
		    predefPtr->source);
		if (bitmap == None) {
		    panic("native bitmap creation failed");
		}
	    } else {
		bitmap = XCreateBitmapFromData(Tk_Display(tkwin),
		    RootWindowOfScreen(nameKey.screen), predefPtr->source,

		    (unsigned) width, (unsigned) height);
	    }
	}
    }

    /*
     * Add information about this bitmap to our database.
     */

    bitmapPtr = (TkBitmap *) ckalloc(sizeof(TkBitmap));
    bitmapPtr->bitmap = bitmap;
    bitmapPtr->width = width;
    bitmapPtr->height = height;
    bitmapPtr->display = Tk_Display(tkwin);
    bitmapPtr->refCount = 1;
    bitmapPtr->hashPtr = nameHashPtr;
    idKey.display = bitmapPtr->display;
    idKey.pixmap = bitmap;
    idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey,
	    &new);
    if (!new) {
	panic("bitmap already registered in Tk_GetBitmap");
    }

    Tcl_SetHashValue(nameHashPtr, bitmapPtr);
    Tcl_SetHashValue(idHashPtr, bitmapPtr);
    return bitmapPtr->bitmap;

    error:

    Tcl_DeleteHashEntry(nameHashPtr);

    return None;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_DefineBitmap --
 *
 *	This procedure associates a textual name with a binary bitmap
 *	description, so that the name may be used to refer to the
 *	bitmap in future calls to Tk_GetBitmap.
 *
 * Results:
 *	A standard Tcl result.  If an error occurs then TCL_ERROR is
 *	returned and a message is left in interp->result.
 *
 * Side effects:
 *	"Name" is entered into the bitmap table and may be used from
 *	here on to refer to the given bitmap.
 *
 *----------------------------------------------------------------------
 */

int
Tk_DefineBitmap(interp, name, source, width, height)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
    Tk_Uid name;		/* Name to use for bitmap.  Must not already
				 * be defined as a bitmap. */
    char *source;		/* Address of bits for bitmap. */
    int width;			/* Width of bitmap. */
    int height;			/* Height of bitmap. */
{
    int new;
    Tcl_HashEntry *predefHashPtr;
    TkPredefBitmap *predefPtr;











    if (!initialized) {
	BitmapInit();
    }

    predefHashPtr = Tcl_CreateHashEntry(&tkPredefBitmapTable, name, &new);

    if (!new) {
        Tcl_AppendResult(interp, "bitmap \"", name,
		"\" is already defined", (char *) NULL);
	return TCL_ERROR;
    }
    predefPtr = (TkPredefBitmap *) ckalloc(sizeof(TkPredefBitmap));
    predefPtr->source = source;







|
>














|
|
|
<
|
|



>

|
|


>
|
>
|













|











|








>
>

>
>
>
>
>
>
>
>
|
|


|
>







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
		bitmap = TkpCreateNativeBitmap(Tk_Display(tkwin),
		    predefPtr->source);
		if (bitmap == None) {
		    panic("native bitmap creation failed");
		}
	    } else {
		bitmap = XCreateBitmapFromData(Tk_Display(tkwin),
		    RootWindowOfScreen(Tk_Screen(tkwin)), 
		    predefPtr->source,
		    (unsigned) width, (unsigned) height);
	    }
	}
    }

    /*
     * Add information about this bitmap to our database.
     */

    bitmapPtr = (TkBitmap *) ckalloc(sizeof(TkBitmap));
    bitmapPtr->bitmap = bitmap;
    bitmapPtr->width = width;
    bitmapPtr->height = height;
    bitmapPtr->display = Tk_Display(tkwin);
    bitmapPtr->resourceRefCount = 1;
    bitmapPtr->objRefCount = 0;
    bitmapPtr->nameHashPtr = nameHashPtr;

    bitmapPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapIdTable, 
            (char *) bitmap, &new);
    if (!new) {
	panic("bitmap already registered in Tk_GetBitmap");
    }
    bitmapPtr->nextPtr = existingBitmapPtr;
    Tcl_SetHashValue(nameHashPtr, bitmapPtr);
    Tcl_SetHashValue(bitmapPtr->idHashPtr, bitmapPtr);
    return bitmapPtr;

    error:
    if (new) {
	Tcl_DeleteHashEntry(nameHashPtr);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_DefineBitmap --
 *
 *	This procedure associates a textual name with a binary bitmap
 *	description, so that the name may be used to refer to the
 *	bitmap in future calls to Tk_GetBitmap.
 *
 * Results:
 *	A standard Tcl result.  If an error occurs then TCL_ERROR is
 *	returned and a message is left in the interp's result.
 *
 * Side effects:
 *	"Name" is entered into the bitmap table and may be used from
 *	here on to refer to the given bitmap.
 *
 *----------------------------------------------------------------------
 */

int
Tk_DefineBitmap(interp, name, source, width, height)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
    CONST char *name;		/* Name to use for bitmap.  Must not already
				 * be defined as a bitmap. */
    char *source;		/* Address of bits for bitmap. */
    int width;			/* Width of bitmap. */
    int height;			/* Height of bitmap. */
{
    int new;
    Tcl_HashEntry *predefHashPtr;
    TkPredefBitmap *predefPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /* 
     * Initialize the Bitmap module if not initialized already for this
     * thread.  Since the current TkDisplay structure cannot be 
     * introspected from here, pass a NULL pointer to BitmapInit,
     * which will know to initialize only the data in the 
     * ThreadSpecificData structure for the current thread.
     */ 

    if (!tsdPtr->initialized) {
	BitmapInit((TkDisplay *) NULL);
    }

    predefHashPtr = Tcl_CreateHashEntry(&tsdPtr->predefBitmapTable, 
            name, &new);
    if (!new) {
        Tcl_AppendResult(interp, "bitmap \"", name,
		"\" is already defined", (char *) NULL);
	return TCL_ERROR;
    }
    predefPtr = (TkPredefBitmap *) ckalloc(sizeof(TkPredefBitmap));
    predefPtr->source = source;
334
335
336
337
338
339
340
341

342
343
344
345
346
347
348
349

350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

Tk_Uid

Tk_NameOfBitmap(display, bitmap)
    Display *display;			/* Display for which bitmap was
					 * allocated. */
    Pixmap bitmap;			/* Bitmap whose name is wanted. */
{
    IdKey idKey;
    Tcl_HashEntry *idHashPtr;
    TkBitmap *bitmapPtr;


    if (!initialized) {
	unknown:
	panic("Tk_NameOfBitmap received unknown bitmap argument");
    }

    idKey.display = display;
    idKey.pixmap = bitmap;
    idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
    if (idHashPtr == NULL) {
	goto unknown;
    }
    bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr);
    return ((NameKey *) bitmapPtr->hashPtr->key.words)->name;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_SizeOfBitmap --
 *







<
>





<


>

|




<
<
|




|







514
515
516
517
518
519
520

521
522
523
524
525
526

527
528
529
530
531
532
533
534
535


536
537
538
539
540
541
542
543
544
545
546
547
548
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */


char *
Tk_NameOfBitmap(display, bitmap)
    Display *display;			/* Display for which bitmap was
					 * allocated. */
    Pixmap bitmap;			/* Bitmap whose name is wanted. */
{

    Tcl_HashEntry *idHashPtr;
    TkBitmap *bitmapPtr;
    TkDisplay *dispPtr = TkGetDisplay(display);

    if (dispPtr == NULL || !dispPtr->bitmapInit) {
	unknown:
	panic("Tk_NameOfBitmap received unknown bitmap argument");
    }



    idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
    if (idHashPtr == NULL) {
	goto unknown;
    }
    bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr);
    return bitmapPtr->nameHashPtr->key.string;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_SizeOfBitmap --
 *
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
Tk_SizeOfBitmap(display, bitmap, widthPtr, heightPtr)
    Display *display;			/* Display for which bitmap was
					 * allocated. */
    Pixmap bitmap;			/* Bitmap whose size is wanted. */
    int *widthPtr;			/* Store bitmap width here. */
    int *heightPtr;			/* Store bitmap height here. */
{
    IdKey idKey;
    Tcl_HashEntry *idHashPtr;
    TkBitmap *bitmapPtr;


    if (!initialized) {
	unknownBitmap:
	panic("Tk_SizeOfBitmap received unknown bitmap argument");
    }

    idKey.display = display;
    idKey.pixmap = bitmap;
    idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
    if (idHashPtr == NULL) {
	goto unknownBitmap;
    }
    bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr);
    *widthPtr = bitmapPtr->width;
    *heightPtr = bitmapPtr->height;
}



















































/*
 *----------------------------------------------------------------------
 *
 * Tk_FreeBitmap --
 *
 *	This procedure is called to release a bitmap allocated by







<


>

|




<
<
|







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







564
565
566
567
568
569
570

571
572
573
574
575
576
577
578
579


580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
Tk_SizeOfBitmap(display, bitmap, widthPtr, heightPtr)
    Display *display;			/* Display for which bitmap was
					 * allocated. */
    Pixmap bitmap;			/* Bitmap whose size is wanted. */
    int *widthPtr;			/* Store bitmap width here. */
    int *heightPtr;			/* Store bitmap height here. */
{

    Tcl_HashEntry *idHashPtr;
    TkBitmap *bitmapPtr;
    TkDisplay *dispPtr = TkGetDisplay(display);

    if (!dispPtr->bitmapInit) {
	unknownBitmap:
	panic("Tk_SizeOfBitmap received unknown bitmap argument");
    }



    idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
    if (idHashPtr == NULL) {
	goto unknownBitmap;
    }
    bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr);
    *widthPtr = bitmapPtr->width;
    *heightPtr = bitmapPtr->height;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeBitmap --
 *
 *	This procedure does all the work of releasing a bitmap allocated by
 *	Tk_GetBitmap or TkGetBitmapFromData.  It is invoked by both
 *	Tk_FreeBitmap and Tk_FreeBitmapFromObj
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The reference count associated with bitmap is decremented, and
 *	it is officially deallocated if no-one is using it anymore.
 *
 *----------------------------------------------------------------------
 */

static void
FreeBitmap(bitmapPtr)
    TkBitmap *bitmapPtr;			/* Bitmap to be released. */
{
    TkBitmap *prevPtr;

    bitmapPtr->resourceRefCount--;
    if (bitmapPtr->resourceRefCount > 0) {
	return;
    }

    Tk_FreePixmap(bitmapPtr->display, bitmapPtr->bitmap);
    Tcl_DeleteHashEntry(bitmapPtr->idHashPtr);
    prevPtr = (TkBitmap *) Tcl_GetHashValue(bitmapPtr->nameHashPtr);
    if (prevPtr == bitmapPtr) {
	if (bitmapPtr->nextPtr == NULL) {
	    Tcl_DeleteHashEntry(bitmapPtr->nameHashPtr);
	} else {
	    Tcl_SetHashValue(bitmapPtr->nameHashPtr, bitmapPtr->nextPtr);
	}
    } else {
	while (prevPtr->nextPtr != bitmapPtr) {
	    prevPtr = prevPtr->nextPtr;
	}
	prevPtr->nextPtr = bitmapPtr->nextPtr;
    }
    if (bitmapPtr->objRefCount == 0) {
	ckfree((char *) bitmapPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_FreeBitmap --
 *
 *	This procedure is called to release a bitmap allocated by
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
void
Tk_FreeBitmap(display, bitmap)
    Display *display;			/* Display for which bitmap was
					 * allocated. */
    Pixmap bitmap;			/* Bitmap to be released. */
{
    Tcl_HashEntry *idHashPtr;
    register TkBitmap *bitmapPtr;
    IdKey idKey;

    if (!initialized) {
	panic("Tk_FreeBitmap called before Tk_GetBitmap");
    }

    idKey.display = display;
    idKey.pixmap = bitmap;
    idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
    if (idHashPtr == NULL) {
	panic("Tk_FreeBitmap received unknown bitmap argument");
    }
    bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr);

    bitmapPtr->refCount--;




















    if (bitmapPtr->refCount == 0) {








	Tk_FreePixmap(bitmapPtr->display, bitmapPtr->bitmap);



















	Tcl_DeleteHashEntry(idHashPtr);







	Tcl_DeleteHashEntry(bitmapPtr->hashPtr);


	ckfree((char *) bitmapPtr);



































    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetBitmapFromData --
 *
 *	Given a description of the bits for a bitmap, make a bitmap that
 *	has the given properties. *** NOTE:  this procedure is obsolete
 *	and really shouldn't be used anymore. ***
 *
 * Results:
 *	The return value is the X identifer for the desired bitmap
 *	(a one-plane Pixmap), unless it couldn't be created properly.
 *	In this case, None is returned and an error message is left in
 *	interp->result.  The caller should never modify the bitmap that
 *	is returned, and should eventually call Tk_FreeBitmap when the
 *	bitmap is no longer needed.
 *
 * Side effects:
 *	The bitmap is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call
 *	to Tk_FreeBitmap, so that the database can be cleaned up when bitmaps







|
<

|



<
<
|



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
















|







657
658
659
660
661
662
663
664

665
666
667
668
669


670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
void
Tk_FreeBitmap(display, bitmap)
    Display *display;			/* Display for which bitmap was
					 * allocated. */
    Pixmap bitmap;			/* Bitmap to be released. */
{
    Tcl_HashEntry *idHashPtr;
    TkDisplay *dispPtr = TkGetDisplay(display);


    if (!dispPtr->bitmapInit) {
	panic("Tk_FreeBitmap called before Tk_GetBitmap");
    }



    idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
    if (idHashPtr == NULL) {
	panic("Tk_FreeBitmap received unknown bitmap argument");
    }
    FreeBitmap((TkBitmap *) Tcl_GetHashValue(idHashPtr));
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_FreeBitmapFromObj --
 *
 *	This procedure is called to release a bitmap allocated by
 *	Tk_AllocBitmapFromObj. It does not throw away the Tcl_Obj *;
 *	it only gets rid of the hash table entry for this bitmap
 *	and clears the cached value that is normally stored in the object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The reference count associated with the bitmap represented by
 *	objPtr is decremented, and the bitmap is released to X if there are 
 *	no remaining uses for it.
 *
 *----------------------------------------------------------------------
 */

void
Tk_FreeBitmapFromObj(tkwin, objPtr)
    Tk_Window tkwin;		/* The window this bitmap lives in. Needed
				 * for the display value. */
    Tcl_Obj *objPtr;		/* The Tcl_Obj * to be freed. */
{
    FreeBitmap(GetBitmapFromObj(tkwin, objPtr));
}

/*
 *---------------------------------------------------------------------------
 *
 * FreeBitmapObjProc -- 
 *
 *	This proc is called to release an object reference to a bitmap.
 *	Called when the object's internal rep is released or when
 *	the cached bitmapPtr needs to be changed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object reference count is decremented. When both it
 *	and the hash ref count go to zero, the color's resources
 *	are released.
 *
 *---------------------------------------------------------------------------
 */

static void
FreeBitmapObjProc(objPtr)
    Tcl_Obj *objPtr;		/* The object we are releasing. */
{
    TkBitmap *bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1;

    if (bitmapPtr != NULL) {
	bitmapPtr->objRefCount--;
	if ((bitmapPtr->objRefCount == 0)
		&& (bitmapPtr->resourceRefCount == 0)) {
	    ckfree((char *) bitmapPtr);
	}
	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * DupBitmapObjProc -- 
 *
 *	When a cached bitmap object is duplicated, this is called to
 *	update the internal reps.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The color's objRefCount is incremented and the internal rep
 *	of the copy is set to point to it.
 *
 *---------------------------------------------------------------------------
 */

static void
DupBitmapObjProc(srcObjPtr, dupObjPtr)
    Tcl_Obj *srcObjPtr;		/* The object we are copying from. */
    Tcl_Obj *dupObjPtr;		/* The object we are copying to. */
{
    TkBitmap *bitmapPtr = (TkBitmap *) srcObjPtr->internalRep.twoPtrValue.ptr1;
    
    dupObjPtr->typePtr = srcObjPtr->typePtr;
    dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;

    if (bitmapPtr != NULL) {
	bitmapPtr->objRefCount++;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetBitmapFromData --
 *
 *	Given a description of the bits for a bitmap, make a bitmap that
 *	has the given properties. *** NOTE:  this procedure is obsolete
 *	and really shouldn't be used anymore. ***
 *
 * Results:
 *	The return value is the X identifer for the desired bitmap
 *	(a one-plane Pixmap), unless it couldn't be created properly.
 *	In this case, None is returned and an error message is left in
 *	the interp's result.  The caller should never modify the bitmap that
 *	is returned, and should eventually call Tk_FreeBitmap when the
 *	bitmap is no longer needed.
 *
 * Side effects:
 *	The bitmap is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call
 *	to Tk_FreeBitmap, so that the database can be cleaned up when bitmaps
490
491
492
493
494
495
496
497
498
499
500

501
502
503
504
505
506
507
508
509

510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527


















































528




529



530















531





























532
533
534







































535
536
537
538
539
540
541
542



543
544


545




546

547

548
549




















550


551

552
553
554
555


556
557



558
559






























560
561
562
563
564
565

566
567
568
569
570


571
572
573
574


575

576
577
578
579



580






581











582





583




584














































585
    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
    Tk_Window tkwin;		/* Window in which bitmap will be used. */
    char *source;		/* Bitmap data for bitmap shape. */
    int width, height;		/* Dimensions of bitmap. */
{
    DataKey nameKey;
    Tcl_HashEntry *dataHashPtr;
    Tk_Uid name;
    int new;
    char string[20];
    static int autoNumber = 0;


    if (!initialized) {
	BitmapInit();
    }

    nameKey.source = source;
    nameKey.width = width;
    nameKey.height = height;
    dataHashPtr = Tcl_CreateHashEntry(&dataTable, (char *) &nameKey, &new);

    if (!new) {
	name = (Tk_Uid) Tcl_GetHashValue(dataHashPtr);
    } else {
	autoNumber++;
	sprintf(string, "_tk%d", autoNumber);
	name = Tk_GetUid(string);
	Tcl_SetHashValue(dataHashPtr, name);
	if (Tk_DefineBitmap(interp, name, source, width, height) != TCL_OK) {
	    Tcl_DeleteHashEntry(dataHashPtr);
	    return TCL_ERROR;
	}
    }
    return Tk_GetBitmap(interp, tkwin, name);
}

/*
 *----------------------------------------------------------------------
 *


















































 * BitmapInit --




 *



 *	Initialize the structures used for bitmap management.















 *





























 * Results:
 *	None.
 *







































 * Side effects:
 *	Read the code.
 *
 *----------------------------------------------------------------------
 */

static void
BitmapInit()



{
    Tcl_Interp *dummy;







    dummy = Tcl_CreateInterp();

    initialized = 1;

    Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(int));
    Tcl_InitHashTable(&dataTable, sizeof(DataKey)/sizeof(int));




















    Tcl_InitHashTable(&tkPredefBitmapTable, TCL_ONE_WORD_KEYS);




    /*
     * The call below is tricky:  can't use sizeof(IdKey) because it
     * gets padded with extra unpredictable bytes on some 64-bit
     * machines.


     */




    Tcl_InitHashTable(&idTable, (sizeof(Display *) + sizeof(Pixmap))
	    /sizeof(int));































    Tk_DefineBitmap(dummy, Tk_GetUid("error"), (char *) error_bits,
	    error_width, error_height);
    Tk_DefineBitmap(dummy, Tk_GetUid("gray75"), (char *) gray75_bits,
	    gray75_width, gray75_height);
    Tk_DefineBitmap(dummy, Tk_GetUid("gray50"), (char *) gray50_bits,

	    gray50_width, gray50_height);
    Tk_DefineBitmap(dummy, Tk_GetUid("gray25"), (char *) gray25_bits,
	    gray25_width, gray25_height);
    Tk_DefineBitmap(dummy, Tk_GetUid("gray12"), (char *) gray12_bits,
	    gray12_width, gray12_height);


    Tk_DefineBitmap(dummy, Tk_GetUid("hourglass"), (char *) hourglass_bits,
	    hourglass_width, hourglass_height);
    Tk_DefineBitmap(dummy, Tk_GetUid("info"), (char *) info_bits,
	    info_width, info_height);


    Tk_DefineBitmap(dummy, Tk_GetUid("questhead"), (char *) questhead_bits,

	    questhead_width, questhead_height);
    Tk_DefineBitmap(dummy, Tk_GetUid("question"), (char *) question_bits,
	    question_width, question_height);
    Tk_DefineBitmap(dummy, Tk_GetUid("warning"), (char *) warning_bits,



	    warning_width, warning_height);


















    TkpDefineNativeBitmaps();










    Tcl_DeleteInterp(dummy);














































}







<

|
|
>

<
|
<




|
>

|

|
|
|












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



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







|
>
>
>


>
>

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

<
<
<
>
>


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

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

805
806
807
808
809
810
811

812
813
814
815
816

817

818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040



1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087

1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
    Tk_Window tkwin;		/* Window in which bitmap will be used. */
    char *source;		/* Bitmap data for bitmap shape. */
    int width, height;		/* Dimensions of bitmap. */
{
    DataKey nameKey;
    Tcl_HashEntry *dataHashPtr;

    int new;
    char string[16 + TCL_INTEGER_SPACE];
    char *name;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;


    BitmapInit(dispPtr);


    nameKey.source = source;
    nameKey.width = width;
    nameKey.height = height;
    dataHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapDataTable, 
            (char *) &nameKey, &new);
    if (!new) {
	name = (char *) Tcl_GetHashValue(dataHashPtr);
    } else {
	dispPtr->bitmapAutoNumber++;
	sprintf(string, "_tk%d", dispPtr->bitmapAutoNumber);
	name = string;
	Tcl_SetHashValue(dataHashPtr, name);
	if (Tk_DefineBitmap(interp, name, source, width, height) != TCL_OK) {
	    Tcl_DeleteHashEntry(dataHashPtr);
	    return TCL_ERROR;
	}
    }
    return Tk_GetBitmap(interp, tkwin, name);
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetBitmapFromObj --
 *
 *	Returns the bitmap referred to by a Tcl object.  The bitmap must
 *	already have been allocated via a call to Tk_AllocBitmapFromObj
 *	or Tk_GetBitmap.
 *
 * Results:
 *	Returns the Pixmap that matches the tkwin and the string rep
 *	of objPtr.
 *
 * Side effects:
 *	If the object is not already a bitmap, the conversion will free
 *	any old internal representation. 
 *
 *----------------------------------------------------------------------
 */

Pixmap
Tk_GetBitmapFromObj(tkwin, objPtr)
    Tk_Window tkwin;
    Tcl_Obj *objPtr;		/* The object from which to get pixels. */
{
    TkBitmap *bitmapPtr = GetBitmapFromObj(tkwin, objPtr);
    return bitmapPtr->bitmap;
}

/*
 *----------------------------------------------------------------------
 *
 * GetBitmapFromObj --
 *
 *	Returns the bitmap referred to by a Tcl object.  The bitmap must
 *	already have been allocated via a call to Tk_AllocBitmapFromObj
 *	or Tk_GetBitmap.
 *
 * Results:
 *	Returns the TkBitmap * that matches the tkwin and the string rep
 *	of  objPtr.
 *
 * Side effects:
 *	If the object is not already a bitmap, the conversion will free
 *	any old internal representation. 
 *
 *----------------------------------------------------------------------
 */

static TkBitmap *
GetBitmapFromObj(tkwin, objPtr)
    Tk_Window tkwin;		/* Window in which the bitmap will be used. */
    Tcl_Obj *objPtr;		/* The object that describes the desired
				 * bitmap. */
{
    TkBitmap *bitmapPtr; 
    Tcl_HashEntry *hashPtr;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    if (objPtr->typePtr != &bitmapObjType) {
	InitBitmapObj(objPtr);
    }

    bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1;
    if (bitmapPtr != NULL) { 
	if ((bitmapPtr->resourceRefCount > 0)
		&& (Tk_Display(tkwin) == bitmapPtr->display)) {
	    return bitmapPtr;
	}
	hashPtr = bitmapPtr->nameHashPtr;
	FreeBitmapObjProc(objPtr);
    } else {
	hashPtr = Tcl_FindHashEntry(&dispPtr->bitmapNameTable, 
                Tcl_GetString(objPtr));
	if (hashPtr == NULL) {
	    goto error;
	}
    } 

    /*
     * At this point we've got a hash table entry, off of which hang
     * one or more TkBitmap structures.  See if any of them will work.
     */

    for (bitmapPtr = (TkBitmap *) Tcl_GetHashValue(hashPtr);
	    bitmapPtr != NULL;  bitmapPtr = bitmapPtr->nextPtr) {
	if (Tk_Display(tkwin) == bitmapPtr->display) {
	    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;
	    bitmapPtr->objRefCount++;
	    return bitmapPtr;
	}
    }

    error:
    panic("GetBitmapFromObj called with non-existent bitmap!");
    /*
     * The following code isn't reached; it's just there to please compilers.
     */
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * InitBitmapObj --
 *
 *	Bookeeping procedure to change an objPtr to a bitmap type.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The old internal rep of the object is freed. The internal
 *	rep is cleared. The final form of the object is set
 *	by either Tk_AllocBitmapFromObj or GetBitmapFromObj.
 *
 *----------------------------------------------------------------------
 */

static void
InitBitmapObj(objPtr)
    Tcl_Obj *objPtr;		/* The object to convert. */
{
    Tcl_ObjType *typePtr;

    /*
     * Free the old internalRep before setting the new one. 
     */

    Tcl_GetString(objPtr);
    typePtr = objPtr->typePtr;
    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	(*typePtr->freeIntRepProc)(objPtr);
    }
    objPtr->typePtr = &bitmapObjType;
    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * BitmapInit --
 *	Initializes hash tables used by this module.  Initializes 
 *      tables stored in TkDisplay structure if a TkDisplay pointer
 *      is passed in.  Iinitializes the thread-local data
 *      in the current thread's ThreadSpecificData structure.
 *
 * Results:
 *      None.
 *  
 * Side effects:
 *	Read the code.
 *
 *----------------------------------------------------------------------
 */

static void
BitmapInit(dispPtr)
    TkDisplay *dispPtr;         /* TkDisplay structure encapsulating 
				 * thread-specific data used by this 
				 * module, or NULL if unavailable. */
{
    Tcl_Interp *dummy;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /* 
     * First initialize the data in the ThreadSpecificData strucuture,
     * if needed.
     */

    if (!tsdPtr->initialized) {
	tsdPtr->initialized = 1;
        dummy = Tcl_CreateInterp();
	Tcl_InitHashTable(&tsdPtr->predefBitmapTable, TCL_STRING_KEYS);

        Tk_DefineBitmap(dummy, "error", (char *) error_bits,
		error_width, error_height);
        Tk_DefineBitmap(dummy, "gray75", (char *) gray75_bits,
                gray75_width, gray75_height);
        Tk_DefineBitmap(dummy, "gray50", (char *) gray50_bits,
                gray50_width, gray50_height);
        Tk_DefineBitmap(dummy, "gray25", (char *) gray25_bits,
                gray25_width, gray25_height);
        Tk_DefineBitmap(dummy, "gray12", (char *) gray12_bits,
                gray12_width, gray12_height);
        Tk_DefineBitmap(dummy, "hourglass", (char *) hourglass_bits,
                hourglass_width, hourglass_height);
        Tk_DefineBitmap(dummy, "info", (char *) info_bits,
	        info_width, info_height);
        Tk_DefineBitmap(dummy, "questhead", (char *) questhead_bits,
	        questhead_width, questhead_height);
        Tk_DefineBitmap(dummy, "question", (char *) question_bits,
	        question_width, question_height);
        Tk_DefineBitmap(dummy, "warning", (char *) warning_bits,
	        warning_width, warning_height);

        TkpDefineNativeBitmaps();
        Tcl_DeleteInterp(dummy);
    }

    /*



     * Was a valid TkDisplay pointer passed?  If so, initialize the
     * Bitmap module tables in that structure.
     */

    if (dispPtr != NULL) {
        dispPtr->bitmapInit = 1;
	Tcl_InitHashTable(&dispPtr->bitmapNameTable, TCL_STRING_KEYS);
	Tcl_InitHashTable(&dispPtr->bitmapDataTable, sizeof(DataKey)
                /sizeof(int));

	/*
	 * The call below is tricky:  can't use sizeof(IdKey) because it
	 * gets padded with extra unpredictable bytes on some 64-bit
	 * machines.
	 */

	/*
	 * The comment above doesn't make sense...
	 */
	Tcl_InitHashTable(&dispPtr->bitmapIdTable, TCL_ONE_WORD_KEYS);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkReadBitmapFile --
 *
 *	Loads a bitmap image in X bitmap format into the specified
 *	drawable.  This is equivelent to the XReadBitmapFile in X.
 *
 * Results:
 *	Sets the size, hotspot, and bitmap on success.
 *
 * Side effects:
 *	Creates a new bitmap from the file data.
 *
 *----------------------------------------------------------------------
 */

int
TkReadBitmapFile(display, d, filename, width_return, height_return,
	bitmap_return, x_hot_return, y_hot_return) 
    Display* display;
    Drawable d;
    CONST char* filename;
    unsigned int* width_return;

    unsigned int* height_return;
    Pixmap* bitmap_return;
    int* x_hot_return;
    int* y_hot_return;
{
    char *data;

    data = TkGetBitmapData(NULL, NULL, (char *) filename,
	    (int *) width_return, (int *) height_return, x_hot_return,
	    y_hot_return);
    if (data == NULL) {
	return BitmapFileInvalid;
    }

    *bitmap_return = XCreateBitmapFromData(display, d, data, *width_return,
	    *height_return);

    ckfree(data);
    return BitmapSuccess;
  }

/*
 *----------------------------------------------------------------------
 *
 * TkDebugBitmap --
 *
 *	This procedure returns debugging information about a bitmap.
 *
 * Results:
 *	The return value is a list with one sublist for each TkBitmap
 *	corresponding to "name".  Each sublist has two elements that
 *	contain the resourceRefCount and objRefCount fields from the
 *	TkBitmap structure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TkDebugBitmap(tkwin, name)
    Tk_Window tkwin;		/* The window in which the bitmap will be
				 * used (not currently used). */
    char *name;			/* Name of the desired color. */
{
    TkBitmap *bitmapPtr;
    Tcl_HashEntry *hashPtr;
    Tcl_Obj *resultPtr, *objPtr;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    resultPtr = Tcl_NewObj();
    hashPtr = Tcl_FindHashEntry(&dispPtr->bitmapNameTable, name);
    if (hashPtr != NULL) {
	bitmapPtr = (TkBitmap *) Tcl_GetHashValue(hashPtr);
	if (bitmapPtr == NULL) {
	    panic("TkDebugBitmap found empty hash table entry");
	}
	for ( ; (bitmapPtr != NULL); bitmapPtr = bitmapPtr->nextPtr) {
	    objPtr = Tcl_NewObj();
	    Tcl_ListObjAppendElement(NULL, objPtr,
		    Tcl_NewIntObj(bitmapPtr->resourceRefCount));
	    Tcl_ListObjAppendElement(NULL, objPtr,
		    Tcl_NewIntObj(bitmapPtr->objRefCount)); 
	    Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
	}
    }
    return resultPtr;
}


/*
 *----------------------------------------------------------------------
 *
 * TkGetBitmapPredefTable --
 *      This procedure is used by tkMacBitmap.c to access the thread-
 *      specific predefBitmap table that maps from the names of 
 *      the predefined bitmaps to data associated with those 
 *      bitmaps.  It is required because the table is allocated in 
 *      thread-local storage and is not visible outside this file.

 * Results:
 *      Returns a pointer to the predefined bitmap hash table for 
 *      the current thread.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
Tcl_HashTable *
TkGetBitmapPredefTable()
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    return &tsdPtr->predefBitmapTable;
}

Changes to generic/tkButton.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

23
24
25
26
27
28

29
30



31




32



33
34
35

36
37















38







39































40






41






42

43
44
45
46
47
48


49
50











51




52





53































54























55



56



57
58
59
60
61
62
63
64
65
66
67
68
69















































70



































71



















72
73

74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104

105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121

122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158

159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184

185
186
































187
188
189

190
191
192
193

194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225

226
227
228
229
230
231
232
233
234
235
236
237
/* 
 * tkButton.c --
 *
 *	This module implements a collection of button-like
 *	widgets for the Tk toolkit.  The widgets implemented
 *	include labels, buttons, check buttons, and radio
 *	buttons.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkButton.c 1.144 97/07/31 09:04:57
 */

#include "tkButton.h"
#include "default.h"

/*
 * Class names for buttons, indexed by one of the type values above.

 */

static char *classNames[] = {"Label", "Button", "Checkbutton", "Radiobutton"};

/*
 * The class procedure table for the button widget.

 */




static int configFlags[] = {LABEL_MASK, BUTTON_MASK,




	CHECK_BUTTON_MASK, RADIO_BUTTON_MASK};




/*
 * Information used for parsing configuration specs:

 */
















Tk_ConfigSpec tkpButtonConfigSpecs[] = {







    {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",































	DEF_BUTTON_ACTIVE_BG_COLOR, Tk_Offset(TkButton, activeBorder),






	BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK






	|TK_CONFIG_COLOR_ONLY},

    {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
	DEF_BUTTON_ACTIVE_BG_MONO, Tk_Offset(TkButton, activeBorder),
	BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK
	|TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
	DEF_BUTTON_ACTIVE_FG_COLOR, Tk_Offset(TkButton, activeFg), 


	BUTTON_MASK|TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",











	DEF_CHKRAD_ACTIVE_FG_COLOR, Tk_Offset(TkButton, activeFg), 




	CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_COLOR_ONLY},





    {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",































	DEF_BUTTON_ACTIVE_FG_MONO, Tk_Offset(TkButton, activeFg), 























	BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK



	|TK_CONFIG_MONO_ONLY},



    {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor",
	DEF_BUTTON_ANCHOR, Tk_Offset(TkButton, anchor), ALL_MASK},
    {TK_CONFIG_BORDER, "-background", "background", "Background",
	DEF_BUTTON_BG_COLOR, Tk_Offset(TkButton, normalBorder),
	ALL_MASK | TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_BORDER, "-background", "background", "Background",
	DEF_BUTTON_BG_MONO, Tk_Offset(TkButton, normalBorder),
	ALL_MASK | TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
	(char *) NULL, 0, ALL_MASK},
    {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
	(char *) NULL, 0, ALL_MASK},
    {TK_CONFIG_BITMAP, "-bitmap", "bitmap", "Bitmap",















































	DEF_BUTTON_BITMAP, Tk_Offset(TkButton, bitmap),



































	ALL_MASK|TK_CONFIG_NULL_OK},



















    {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidth), ALL_MASK},

    {TK_CONFIG_STRING, "-command", "command", "Command",
	DEF_BUTTON_COMMAND, Tk_Offset(TkButton, command),
	BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
    {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
	DEF_BUTTON_CURSOR, Tk_Offset(TkButton, cursor),
	ALL_MASK|TK_CONFIG_NULL_OK},
    {TK_CONFIG_UID, "-default", "default", "Default",
        DEF_BUTTON_DEFAULT, Tk_Offset(TkButton, defaultState), BUTTON_MASK},
    {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
	"DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
	Tk_Offset(TkButton, disabledFg), BUTTON_MASK|CHECK_BUTTON_MASK
	|RADIO_BUTTON_MASK|TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
    {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
	"DisabledForeground", DEF_BUTTON_DISABLED_FG_MONO,
	Tk_Offset(TkButton, disabledFg), BUTTON_MASK|CHECK_BUTTON_MASK
	|RADIO_BUTTON_MASK|TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
    {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
	(char *) NULL, 0, ALL_MASK},
    {TK_CONFIG_FONT, "-font", "font", "Font",
	DEF_BUTTON_FONT, Tk_Offset(TkButton, tkfont),
	ALL_MASK},
    {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
	DEF_BUTTON_FG, Tk_Offset(TkButton, normalFg), LABEL_MASK|BUTTON_MASK},
    {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
	DEF_CHKRAD_FG, Tk_Offset(TkButton, normalFg), CHECK_BUTTON_MASK
	|RADIO_BUTTON_MASK},
    {TK_CONFIG_STRING, "-height", "height", "Height",
	DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightString), ALL_MASK},
    {TK_CONFIG_BORDER, "-highlightbackground", "highlightBackground",
	"HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG,
	Tk_Offset(TkButton, highlightBorder), ALL_MASK},

    {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
	DEF_BUTTON_HIGHLIGHT, Tk_Offset(TkButton, highlightColorPtr),
	ALL_MASK},
    {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
	"HighlightThickness",
	DEF_LABEL_HIGHLIGHT_WIDTH, Tk_Offset(TkButton, highlightWidth),
	LABEL_MASK},
    {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
	"HighlightThickness",
	DEF_BUTTON_HIGHLIGHT_WIDTH, Tk_Offset(TkButton, highlightWidth),
	BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
    {TK_CONFIG_STRING, "-image", "image", "Image",
	DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imageString),
	ALL_MASK|TK_CONFIG_NULL_OK},
    {TK_CONFIG_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
	DEF_BUTTON_INDICATOR, Tk_Offset(TkButton, indicatorOn),
	CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},

    {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify",
	DEF_BUTTON_JUSTIFY, Tk_Offset(TkButton, justify), ALL_MASK},
    {TK_CONFIG_STRING, "-offvalue", "offValue", "Value",
	DEF_BUTTON_OFF_VALUE, Tk_Offset(TkButton, offValue),
	CHECK_BUTTON_MASK},
    {TK_CONFIG_STRING, "-onvalue", "onValue", "Value",
	DEF_BUTTON_ON_VALUE, Tk_Offset(TkButton, onValue),
	CHECK_BUTTON_MASK},
    {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
	DEF_BUTTON_PADX, Tk_Offset(TkButton, padX), BUTTON_MASK},
    {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
	DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padX),
	LABEL_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
    {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
	DEF_BUTTON_PADY, Tk_Offset(TkButton, padY), BUTTON_MASK},
    {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
	DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padY),
	LABEL_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
    {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
	DEF_BUTTON_RELIEF, Tk_Offset(TkButton, relief), BUTTON_MASK},
    {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
	DEF_LABCHKRAD_RELIEF, Tk_Offset(TkButton, relief),
	LABEL_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
    {TK_CONFIG_BORDER, "-selectcolor", "selectColor", "Background",
	DEF_BUTTON_SELECT_COLOR, Tk_Offset(TkButton, selectBorder),
	CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_COLOR_ONLY
	|TK_CONFIG_NULL_OK},
    {TK_CONFIG_BORDER, "-selectcolor", "selectColor", "Background",
	DEF_BUTTON_SELECT_MONO, Tk_Offset(TkButton, selectBorder),
	CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_MONO_ONLY
	|TK_CONFIG_NULL_OK},
    {TK_CONFIG_STRING, "-selectimage", "selectImage", "SelectImage",
	DEF_BUTTON_SELECT_IMAGE, Tk_Offset(TkButton, selectImageString),
	CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
    {TK_CONFIG_UID, "-state", "state", "State",
	DEF_BUTTON_STATE, Tk_Offset(TkButton, state),
	BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},

    {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
	DEF_LABEL_TAKE_FOCUS, Tk_Offset(TkButton, takeFocus),
	LABEL_MASK|TK_CONFIG_NULL_OK},
    {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
	DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocus),
	BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
    {TK_CONFIG_STRING, "-text", "text", "Text",
	DEF_BUTTON_TEXT, Tk_Offset(TkButton, text), ALL_MASK},
    {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable",
	DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarName),
	ALL_MASK|TK_CONFIG_NULL_OK},
    {TK_CONFIG_INT, "-underline", "underline", "Underline",
	DEF_BUTTON_UNDERLINE, Tk_Offset(TkButton, underline), ALL_MASK},
    {TK_CONFIG_STRING, "-value", "value", "Value",
	DEF_BUTTON_VALUE, Tk_Offset(TkButton, onValue),
	RADIO_BUTTON_MASK},
    {TK_CONFIG_STRING, "-variable", "variable", "Variable",
	DEF_RADIOBUTTON_VARIABLE, Tk_Offset(TkButton, selVarName),
	RADIO_BUTTON_MASK},
    {TK_CONFIG_STRING, "-variable", "variable", "Variable",
	DEF_CHECKBUTTON_VARIABLE, Tk_Offset(TkButton, selVarName),
	CHECK_BUTTON_MASK|TK_CONFIG_NULL_OK},
    {TK_CONFIG_STRING, "-width", "width", "Width",
	DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthString), ALL_MASK},
    {TK_CONFIG_PIXELS, "-wraplength", "wrapLength", "WrapLength",
	DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLength), ALL_MASK},

    {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, 0}
































};

/*

 * String to print out in error messages, identifying options for
 * widget commands for different types of labels or buttons:
 */


static char *optionStrings[] = {
    "cget or configure",
    "cget, configure, flash, or invoke",
    "cget, configure, deselect, flash, invoke, select, or toggle",
    "cget, configure, deselect, flash, invoke, or select"
};

/*
 * Forward declarations for procedures defined later in this file:
 */

static void		ButtonCmdDeletedProc _ANSI_ARGS_((
			    ClientData clientData));
static int		ButtonCreate _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv,
			    int type));
static void		ButtonEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		ButtonImageProc _ANSI_ARGS_((ClientData clientData,
			    int x, int y, int width, int height,
			    int imgWidth, int imgHeight));
static void		ButtonSelectImageProc _ANSI_ARGS_((
			    ClientData clientData, int x, int y, int width,
			    int height, int imgWidth, int imgHeight));
static char *		ButtonTextVarProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, char *name1, char *name2,
			    int flags));
static char *		ButtonVarProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, char *name1, char *name2,
			    int flags));
static int		ButtonWidgetCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));

static int		ConfigureButton _ANSI_ARGS_((Tcl_Interp *interp,
			    TkButton *butPtr, int argc, char **argv,
			    int flags));
static void		DestroyButton _ANSI_ARGS_((TkButton *butPtr));


/*
 *--------------------------------------------------------------
 *
 * Tk_ButtonCmd, Tk_CheckbuttonCmd, Tk_LabelCmd, Tk_RadiobuttonCmd --
 *
 *	These procedures are invoked to process the "button", "label",





|
<


|




|






|
>





|
>


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


|
>


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

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

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









|
|














|
|
>

|
|

<







1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123

124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219


220

221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337


338
339
340


341


342
343
344
345

346


347

348
349
350
351
352
353
354
355
356
357
358
359



360

361
362
363
364
365

366
367
368






369
370

371

372


373


374
375
376

377
378



379


380
381
382
383
384

385
386



387
388
389
390
391
392
393
394
395
396
397

398
399
400



401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441

442
443
444

445
446
447




448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479

480
481
482
483
484
485
486
/* 
 * tkButton.c --
 *
 *	This module implements a collection of button-like
 *	widgets for the Tk toolkit.  The widgets implemented
 *	include labels, buttons, checkbuttons, and radiobuttons.

 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkButton.c,v 1.1.4.6 1999/03/30 23:56:55 stanton Exp $
 */

#include "tkButton.h"
#include "default.h"

/*
 * Class names for buttons, indexed by one of the type values defined
 * in tkButton.h.
 */

static char *classNames[] = {"Label", "Button", "Checkbutton", "Radiobutton"};

/*
 * The following table defines the legal values for the -default option.
 * It is used together with the "enum defaultValue" declaration in tkButton.h.
 */

static char *defaultStrings[] = {
    "active", "disabled", "normal", (char *) NULL
};

/*
 * The following table defines the legal values for the -state option.
 * It is used together with the "enum state" declaration in tkButton.h.
 */

static char *stateStrings[] = {
    "active", "disabled", "normal", (char *) NULL
};

/*
 * Information used for parsing configuration options.  There is a
 * separate table for each of the four widget classes.
 */

static Tk_OptionSpec labelOptionSpecs[] = {
    {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
	DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0},
    {TK_OPTION_BORDER, "-background", "background", "Background",
	DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder),
	0, (ClientData) DEF_BUTTON_BG_MONO, 0},
    {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
    {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
    {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
	DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr),
	Tk_Offset(TkButton, borderWidth), 0, 0, 0},
    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
	DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
    {TK_OPTION_FONT, "-font", "font", "Font",
	DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},
    {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
	DEF_BUTTON_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},
    {TK_OPTION_STRING, "-height", "height", "Height",
	DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
    {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
	"HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
	-1, Tk_Offset(TkButton, highlightBorder), 0,
	(ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
    {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
	DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
	0, 0, 0},
    {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
	"HighlightThickness", DEF_LABEL_HIGHLIGHT_WIDTH,
	Tk_Offset(TkButton, highlightWidthPtr),
	Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
    {TK_OPTION_STRING, "-image", "image", "Image",
	DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
	DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
    {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
	DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padXPtr),
	Tk_Offset(TkButton, padX), 0, 0, 0},
    {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
	DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padYPtr),
	Tk_Offset(TkButton, padY), 0, 0, 0},
    {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
	DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0},
    {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
	DEF_LABEL_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_STRING, "-text", "text", "Text",
	DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
    {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
	DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_INT, "-underline", "underline", "Underline",
	DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
    {TK_OPTION_STRING, "-width", "width", "Width",
	DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
    {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
	DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
	Tk_Offset(TkButton, wrapLength), 0, 0, 0},
    {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, 0, 0, 0}
};

static Tk_OptionSpec buttonOptionSpecs[] = {
    {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
	DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
	0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},

    {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
	DEF_BUTTON_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg),
	TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0},
    {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
	DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0},
    {TK_OPTION_BORDER, "-background", "background", "Background",
	DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder),
	0, (ClientData) DEF_BUTTON_BG_MONO, 0},
    {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
    {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
    {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
	DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr),
	Tk_Offset(TkButton, borderWidth), 0, 0, 0},
    {TK_OPTION_STRING, "-command", "command", "Command",
	DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
	DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_STRING_TABLE, "-default", "default", "Default",
        DEF_BUTTON_DEFAULT, -1, Tk_Offset(TkButton, defaultState),
	0, (ClientData) defaultStrings, 0},
    {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
	"DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
	-1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
	(ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
    {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
    {TK_OPTION_FONT, "-font", "font", "Font",
	DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},
    {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
	DEF_BUTTON_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},
    {TK_OPTION_STRING, "-height", "height", "Height",
	DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
    {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
	"HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
	-1, Tk_Offset(TkButton, highlightBorder), 0,
	(ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
    {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
	DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
	0, 0, 0},
    {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
	"HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH,
	Tk_Offset(TkButton, highlightWidthPtr),
	Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
    {TK_OPTION_STRING, "-image", "image", "Image",
	DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
	DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
    {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
	DEF_BUTTON_PADX, Tk_Offset(TkButton, padXPtr),
	Tk_Offset(TkButton, padX), 0, 0, 0},
    {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
	DEF_BUTTON_PADY, Tk_Offset(TkButton, padYPtr),
	Tk_Offset(TkButton, padY), 0, 0, 0},
    {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
	DEF_BUTTON_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0},
    {TK_OPTION_STRING_TABLE, "-state", "state", "State",
	DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),
	0, (ClientData) stateStrings, 0},
    {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
	DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_STRING, "-text", "text", "Text",
	DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
    {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
	DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_INT, "-underline", "underline", "Underline",
	DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
    {TK_OPTION_STRING, "-width", "width", "Width",
	DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
    {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
	DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
	Tk_Offset(TkButton, wrapLength), 0, 0, 0},
    {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, 0, 0}
};

static Tk_OptionSpec checkbuttonOptionSpecs[] = {
    {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
	DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
	0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},
    {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
	DEF_CHKRAD_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg),
	TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0},
    {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
	DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0},
    {TK_OPTION_BORDER, "-background", "background", "Background",
	DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder),


	0, (ClientData) DEF_BUTTON_BG_MONO, 0},

    {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
    {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
    {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
	DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr),
	Tk_Offset(TkButton, borderWidth), 0, 0, 0},
    {TK_OPTION_STRING, "-command", "command", "Command",
	DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
	DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
	"DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
	-1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
	(ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
    {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
    {TK_OPTION_FONT, "-font", "font", "Font",
	DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},
    {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
	DEF_CHKRAD_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},
    {TK_OPTION_STRING, "-height", "height", "Height",
	DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
    {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
	"HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
	-1, Tk_Offset(TkButton, highlightBorder), 0,
	(ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
    {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
	DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
	0, 0, 0},
    {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
	"HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH,
	Tk_Offset(TkButton, highlightWidthPtr),
	Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
    {TK_OPTION_STRING, "-image", "image", "Image",
	DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
	DEF_BUTTON_INDICATOR, -1, Tk_Offset(TkButton, indicatorOn), 0, 0, 0},
    {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
	DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
    {TK_OPTION_STRING, "-offvalue", "offValue", "Value",
	DEF_BUTTON_OFF_VALUE, Tk_Offset(TkButton, offValuePtr), -1, 0, 0, 0},
    {TK_OPTION_STRING, "-onvalue", "onValue", "Value",
	DEF_BUTTON_ON_VALUE, Tk_Offset(TkButton, onValuePtr), -1, 0, 0, 0},
    {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
	DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padXPtr),
	Tk_Offset(TkButton, padX), 0, 0, 0},
    {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
	DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padYPtr),
	Tk_Offset(TkButton, padY), 0, 0, 0},
    {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
	DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0},
    {TK_OPTION_BORDER, "-selectcolor", "selectColor", "Background",
	DEF_BUTTON_SELECT_COLOR, -1, Tk_Offset(TkButton, selectBorder),
	TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_SELECT_MONO, 0},
    {TK_OPTION_STRING, "-selectimage", "selectImage", "SelectImage",
	DEF_BUTTON_SELECT_IMAGE, Tk_Offset(TkButton, selectImagePtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_STRING_TABLE, "-state", "state", "State",
	DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),
	0, (ClientData) stateStrings, 0},
    {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
	DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_STRING, "-text", "text", "Text",
	DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
    {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
	DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_INT, "-underline", "underline", "Underline",
	DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
    {TK_OPTION_STRING, "-variable", "variable", "Variable",
	DEF_CHECKBUTTON_VARIABLE, Tk_Offset(TkButton, selVarNamePtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_STRING, "-width", "width", "Width",
	DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
    {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
	DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
	Tk_Offset(TkButton, wrapLength), 0, 0, 0},
    {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, 0, 0}
};

static Tk_OptionSpec radiobuttonOptionSpecs[] = {
    {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
	DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
	0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},
    {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
	DEF_CHKRAD_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg),
	TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0},
    {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
	DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0},
    {TK_OPTION_BORDER, "-background", "background", "Background",
	DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder),
	0, (ClientData) DEF_BUTTON_BG_MONO, 0},
    {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
    {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
    {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
	DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr),
	Tk_Offset(TkButton, borderWidth), 0, 0, 0},
    {TK_OPTION_STRING, "-command", "command", "Command",
	DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
	DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
	TK_OPTION_NULL_OK, 0, 0},


    {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
	"DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
	-1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,


	(ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},


    {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
    {TK_OPTION_FONT, "-font", "font", "Font",
	DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},

    {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",


	DEF_CHKRAD_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},

    {TK_OPTION_STRING, "-height", "height", "Height",
	DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
    {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
	"HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
	-1, Tk_Offset(TkButton, highlightBorder), 0,
	(ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
    {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
	DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
	0, 0, 0},
    {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
	"HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH,
	Tk_Offset(TkButton, highlightWidthPtr),



	Tk_Offset(TkButton, highlightWidth), 0, 0, 0},

    {TK_OPTION_STRING, "-image", "image", "Image",
	DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
	DEF_BUTTON_INDICATOR, -1, Tk_Offset(TkButton, indicatorOn),

	0, 0, 0},
    {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
	DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},






    {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
	DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padXPtr),

	Tk_Offset(TkButton, padX), 0, 0, 0},

    {TK_OPTION_PIXELS, "-pady", "padY", "Pad",


	DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padYPtr),


	Tk_Offset(TkButton, padY), 0, 0, 0},
    {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
	DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0},

    {TK_OPTION_BORDER, "-selectcolor", "selectColor", "Background",
	DEF_BUTTON_SELECT_COLOR, -1, Tk_Offset(TkButton, selectBorder),



	TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_SELECT_MONO, 0},


    {TK_OPTION_STRING, "-selectimage", "selectImage", "SelectImage",
	DEF_BUTTON_SELECT_IMAGE, Tk_Offset(TkButton, selectImagePtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_STRING_TABLE, "-state", "state", "State",
	DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),

	0, (ClientData) stateStrings, 0},
    {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",



	DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_STRING, "-text", "text", "Text",
	DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
    {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
	DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_INT, "-underline", "underline", "Underline",
	DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
    {TK_OPTION_STRING, "-value", "value", "Value",
	DEF_BUTTON_VALUE, Tk_Offset(TkButton, onValuePtr), -1, 0, 0, 0},

    {TK_OPTION_STRING, "-variable", "variable", "Variable",
	DEF_RADIOBUTTON_VARIABLE, Tk_Offset(TkButton, selVarNamePtr), -1,
	0, 0, 0},



    {TK_OPTION_STRING, "-width", "width", "Width",
	DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
    {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
	DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
	Tk_Offset(TkButton, wrapLength), 0, 0, 0},
    {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, 0, 0}
};

/*
 * The following table maps from one of the type values defined in
 * tkButton.h, such as TYPE_LABEL, to the option template for that
 * class of widgets.
 */

static Tk_OptionSpec *optionSpecs[] = {
    labelOptionSpecs,
    buttonOptionSpecs,
    checkbuttonOptionSpecs,
    radiobuttonOptionSpecs
};

/*
 * The following tables define the widget commands supported by
 * each of the classes, and map the indexes into the string tables
 * into a single enumerated type used to dispatch the widget command.
 */

static char *commandNames[][8] = {
    {"cget", "configure", (char *) NULL},
    {"cget", "configure", "flash", "invoke", (char *) NULL},
    {"cget", "configure", "deselect", "flash", "invoke", "select",
	    "toggle", (char *) NULL},
    {"cget", "configure", "deselect", "flash", "invoke", "select",
	    (char *) NULL}
};
enum command {
    COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,
    COMMAND_INVOKE, COMMAND_SELECT, COMMAND_TOGGLE
};
static enum command map[][8] = {

    {COMMAND_CGET, COMMAND_CONFIGURE},
    {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_FLASH, COMMAND_INVOKE},
    {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,

	    COMMAND_INVOKE, COMMAND_SELECT, COMMAND_TOGGLE},
    {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,
	    COMMAND_INVOKE, COMMAND_SELECT}




};

/*
 * Forward declarations for procedures defined later in this file:
 */

static void		ButtonCmdDeletedProc _ANSI_ARGS_((
			    ClientData clientData));
static int		ButtonCreate _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[], int type));
static void		ButtonEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		ButtonImageProc _ANSI_ARGS_((ClientData clientData,
			    int x, int y, int width, int height,
			    int imgWidth, int imgHeight));
static void		ButtonSelectImageProc _ANSI_ARGS_((
			    ClientData clientData, int x, int y, int width,
			    int height, int imgWidth, int imgHeight));
static char *		ButtonTextVarProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, char *name1, char *name2,
			    int flags));
static char *		ButtonVarProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, char *name1, char *name2,
			    int flags));
static int		ButtonWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
static int		ConfigureButton _ANSI_ARGS_((Tcl_Interp *interp,
			    TkButton *butPtr, int objc,
			    Tcl_Obj *CONST objv[]));
static void		DestroyButton _ANSI_ARGS_((TkButton *butPtr));


/*
 *--------------------------------------------------------------
 *
 * Tk_ButtonCmd, Tk_CheckbuttonCmd, Tk_LabelCmd, Tk_RadiobuttonCmd --
 *
 *	These procedures are invoked to process the "button", "label",
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
 *	See the user documentation.  These procedures are just wrappers;
 *	they call ButtonCreate to do all of the real work.
 *
 *--------------------------------------------------------------
 */

int
Tk_ButtonCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    return ButtonCreate(clientData, interp, argc, argv, TYPE_BUTTON);
}

int
Tk_CheckbuttonCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    return ButtonCreate(clientData, interp, argc, argv, TYPE_CHECK_BUTTON);
}

int
Tk_LabelCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    return ButtonCreate(clientData, interp, argc, argv, TYPE_LABEL);
}

int
Tk_RadiobuttonCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    return ButtonCreate(clientData, interp, argc, argv, TYPE_RADIO_BUTTON);
}

/*
 *--------------------------------------------------------------
 *
 * ButtonCreate --
 *







|
|
<

|
|

|



|
|
<

|
|

|



|
|
<

|
|

|



|
|
<

|
|

|







494
495
496
497
498
499
500
501
502

503
504
505
506
507
508
509
510
511
512

513
514
515
516
517
518
519
520
521
522

523
524
525
526
527
528
529
530
531
532

533
534
535
536
537
538
539
540
541
542
543
544
 *	See the user documentation.  These procedures are just wrappers;
 *	they call ButtonCreate to do all of the real work.
 *
 *--------------------------------------------------------------
 */

int
Tk_ButtonObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Either NULL or pointer to option table. */

    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument values. */
{
    return ButtonCreate(clientData, interp, objc, objv, TYPE_BUTTON);
}

int
Tk_CheckbuttonObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Either NULL or pointer to option table. */

    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument values. */
{
    return ButtonCreate(clientData, interp, objc, objv, TYPE_CHECK_BUTTON);
}

int
Tk_LabelObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Either NULL or pointer to option table. */

    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument values. */
{
    return ButtonCreate(clientData, interp, objc, objv, TYPE_LABEL);
}

int
Tk_RadiobuttonObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Either NULL or pointer to option table. */

    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument values. */
{
    return ButtonCreate(clientData, interp, objc, objv, TYPE_RADIO_BUTTON);
}

/*
 *--------------------------------------------------------------
 *
 * ButtonCreate --
 *
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324

325
326




327






328







329

330
331
332
333
334
335
336
337
338

339
340
341
342
343
344
345
346
347
348
349
350
351
352
353

354
355
356
357

358
359
360
361
362
363
364
365
366
367
368

369
370

371
372
373
374
375
376
377
378
379
380
381
382

383
384
385
386

387

388

389

390
391
392
393
394
395



396
397
398
399
400
401
402
403
404

405
406
407
408
409
410





411
412
413
414
415
416
417

418
419
420
421
422
423
424
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
ButtonCreate(clientData, interp, argc, argv, type)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
    int type;			/* Type of button to create: TYPE_LABEL,
				 * TYPE_BUTTON, TYPE_CHECK_BUTTON, or
				 * TYPE_RADIO_BUTTON. */
{
    register TkButton *butPtr;

    Tk_Window tkwin = (Tk_Window) clientData;
    Tk_Window new;











    if (argc < 2) {







	Tcl_AppendResult(interp, "wrong # args: should be \"",

		argv[0], " pathName ?options?\"", (char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Create the new window.
     */

    new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);

    if (new == NULL) {
	return TCL_ERROR;
    }

    Tk_SetClass(new, classNames[type]);
    butPtr = TkpCreateButton(new);

    TkSetClassProcs(new, &tkpButtonProcs, (ClientData) butPtr);

    /*
     * Initialize the data structure for the button.
     */

    butPtr->tkwin = new;
    butPtr->display = Tk_Display(new);

    butPtr->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(butPtr->tkwin),
	    ButtonWidgetCmd, (ClientData) butPtr, ButtonCmdDeletedProc);
    butPtr->interp = interp;
    butPtr->type = type;

    butPtr->text = NULL;
    butPtr->underline = -1;
    butPtr->textVarName = NULL;
    butPtr->bitmap = None;
    butPtr->imageString = NULL;
    butPtr->image = NULL;
    butPtr->selectImageString = NULL;
    butPtr->selectImage = NULL;
    butPtr->state = tkNormalUid;
    butPtr->normalBorder = NULL;
    butPtr->activeBorder = NULL;

    butPtr->borderWidth = 0;
    butPtr->relief = TK_RELIEF_FLAT;

    butPtr->highlightWidth = 0;
    butPtr->highlightBorder = NULL;
    butPtr->highlightColorPtr = NULL;
    butPtr->inset = 0;
    butPtr->tkfont = NULL;
    butPtr->normalFg = NULL;
    butPtr->activeFg = NULL;
    butPtr->disabledFg = NULL;
    butPtr->normalTextGC = None;
    butPtr->activeTextGC = None;
    butPtr->gray = None;
    butPtr->disabledGC = None;

    butPtr->copyGC = None;
    butPtr->widthString = NULL;
    butPtr->heightString = NULL;
    butPtr->width = 0;

    butPtr->height = 0;

    butPtr->wrapLength = 0;

    butPtr->padX = 0;

    butPtr->padY = 0;
    butPtr->anchor = TK_ANCHOR_CENTER;
    butPtr->justify = TK_JUSTIFY_CENTER;
    butPtr->textLayout = NULL;
    butPtr->indicatorOn = 0;
    butPtr->selectBorder = NULL;



    butPtr->indicatorSpace = 0;
    butPtr->indicatorDiameter = 0;
    butPtr->defaultState = tkDisabledUid;
    butPtr->selVarName = NULL;
    butPtr->onValue = NULL;
    butPtr->offValue = NULL;
    butPtr->cursor = None;
    butPtr->command = NULL;
    butPtr->takeFocus = NULL;

    butPtr->flags = 0;

    Tk_CreateEventHandler(butPtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    ButtonEventProc, (ClientData) butPtr);






    if (ConfigureButton(interp, butPtr, argc - 2, argv + 2,
	    configFlags[type]) != TCL_OK) {
	Tk_DestroyWindow(butPtr->tkwin);
	return TCL_ERROR;
    }

    interp->result = Tk_PathName(butPtr->tkwin);

    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ButtonWidgetCmd --







|
|
|

|
|




|
>
|
|
>
>
>
>

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







|
>
|



|
|

|





|
|
>
|
|
<

>
|

|

|

|

|


>


>










<

>

|
<

>

>

>

>



<


>
>
>


|
|
|
|

<
|
>






>
>
>
>
>
|
<




|
>







552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621

622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648

649
650
651
652

653
654
655
656
657
658
659
660
661
662
663

664
665
666
667
668
669
670
671
672
673
674
675

676
677
678
679
680
681
682
683
684
685
686
687
688
689

690
691
692
693
694
695
696
697
698
699
700
701
702
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
ButtonCreate(clientData, interp, objc, objv, type)
    ClientData clientData;	/* Option table for this widget class, or
				 * NULL if not created yet. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument values. */
    int type;			/* Type of button to create: TYPE_LABEL,
				 * TYPE_BUTTON, TYPE_CHECK_BUTTON, or
				 * TYPE_RADIO_BUTTON. */
{
    TkButton *butPtr;
    Tk_OptionTable optionTable;
    Tk_Window tkwin;

    optionTable = (Tk_OptionTable) clientData;
    if (optionTable == NULL) {
	Tcl_CmdInfo info;
	char *name;

	/*
	 * We haven't created the option table for this widget class
	 * yet.  Do it now and save the table as the clientData for
	 * the command, so we'll have access to it in future
	 * invocations of the command.
	 */

	TkpButtonSetDefaults(optionSpecs[type]);
	optionTable = Tk_CreateOptionTable(interp, optionSpecs[type]);
	name = Tcl_GetString(objv[0]);
	Tcl_GetCommandInfo(interp, name, &info);
	info.objClientData = (ClientData) optionTable;
	Tcl_SetCommandInfo(interp, name, &info);
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
	return TCL_ERROR;
    }

    /*
     * Create the new window.
     */

    tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
	    Tcl_GetString(objv[1]), (char *) NULL);
    if (tkwin == NULL) {
	return TCL_ERROR;
    }

    Tk_SetClass(tkwin, classNames[type]);
    butPtr = TkpCreateButton(tkwin);

    TkSetClassProcs(tkwin, &tkpButtonProcs, (ClientData) butPtr);

    /*
     * Initialize the data structure for the button.
     */

    butPtr->tkwin = tkwin;
    butPtr->display = Tk_Display(tkwin);
    butPtr->interp = interp;
    butPtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(tkwin),
	    ButtonWidgetObjCmd, (ClientData) butPtr, ButtonCmdDeletedProc);

    butPtr->type = type;
    butPtr->optionTable = optionTable;
    butPtr->textPtr = NULL;
    butPtr->underline = -1;
    butPtr->textVarNamePtr = NULL;
    butPtr->bitmap = None;
    butPtr->imagePtr = NULL;
    butPtr->image = NULL;
    butPtr->selectImagePtr = NULL;
    butPtr->selectImage = NULL;
    butPtr->state = STATE_NORMAL;
    butPtr->normalBorder = NULL;
    butPtr->activeBorder = NULL;
    butPtr->borderWidthPtr = NULL;
    butPtr->borderWidth = 0;
    butPtr->relief = TK_RELIEF_FLAT;
    butPtr->highlightWidthPtr = NULL;
    butPtr->highlightWidth = 0;
    butPtr->highlightBorder = NULL;
    butPtr->highlightColorPtr = NULL;
    butPtr->inset = 0;
    butPtr->tkfont = NULL;
    butPtr->normalFg = NULL;
    butPtr->activeFg = NULL;
    butPtr->disabledFg = NULL;
    butPtr->normalTextGC = None;
    butPtr->activeTextGC = None;

    butPtr->disabledGC = None;
    butPtr->gray = None;
    butPtr->copyGC = None;
    butPtr->widthPtr = NULL;

    butPtr->width = 0;
    butPtr->heightPtr = NULL;
    butPtr->height = 0;
    butPtr->wrapLengthPtr = NULL;
    butPtr->wrapLength = 0;
    butPtr->padXPtr = NULL;
    butPtr->padX = 0;
    butPtr->padYPtr = NULL;
    butPtr->padY = 0;
    butPtr->anchor = TK_ANCHOR_CENTER;
    butPtr->justify = TK_JUSTIFY_CENTER;

    butPtr->indicatorOn = 0;
    butPtr->selectBorder = NULL;
    butPtr->textWidth = 0;
    butPtr->textHeight = 0;
    butPtr->textLayout = NULL;
    butPtr->indicatorSpace = 0;
    butPtr->indicatorDiameter = 0;
    butPtr->defaultState = DEFAULT_DISABLED;
    butPtr->selVarNamePtr = NULL;
    butPtr->onValuePtr = NULL;
    butPtr->offValuePtr = NULL;
    butPtr->cursor = None;

    butPtr->takeFocusPtr = NULL;
    butPtr->commandPtr = NULL;
    butPtr->flags = 0;

    Tk_CreateEventHandler(butPtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    ButtonEventProc, (ClientData) butPtr);

    if (Tk_InitOptions(interp, (char *) butPtr, optionTable, tkwin)
	    != TCL_OK) {
	Tk_DestroyWindow(butPtr->tkwin);
	return TCL_ERROR;
    }
    if (ConfigureButton(interp, butPtr, objc - 2, objv + 2) != TCL_OK) {

	Tk_DestroyWindow(butPtr->tkwin);
	return TCL_ERROR;
    }

    Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(butPtr->tkwin),
	    -1);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ButtonWidgetCmd --
433
434
435
436
437
438
439
440
441
442
443
444
445
446

447
448
449
450
451
452
453
454
455





456
457
458
459
460
461
462


463
464
465
466
467
468
469
470


471




472

473
474
475


476


477
478
479
480

481
482
483
484


485
486

487
488
489
490
491
492
493
494
495
496

497
498

499
500




501
502
503
504
505

506


507
508
509
510
511
512
513
514
515

516
517
518
519



520

521
522
523
524
525
526
527
528
529
530
531
532
533
534

535

536
537
538
539
540
541
542
543
544
545

546

547
548
549
550
551
552
553
554



555
556
557
558
559
560
561
562
563
564

565
566
567
568
569
570
571
572
573

574

575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611







612
613
614
615
616
617

618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634



635
636
637
638
639
640
641
642
643



644
645
646
647
648
649
650
651

652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684



685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701






702





703
704
705








706



707
708
709
710
711
712
713
714

715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755

756
757
758
759
760
761
762
763
764
765
766

767
768
769
770
771
772

773
774


775
776
777
778
779
780
781
782
783
784
785
786
787
788
789

790
791
792

793
794
795
796
797
798
799
800
801
802
803
804
805
806

807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826

827
828
829
830


831
832
833
834
835
836
837
838

839





840

841



842










843
844
845
846
847
848
849
850
851
852
853
854


855
856
857
858
859
860

861
862



863
864



865




866
867
868





869

870
871
872
873
874
875
876
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
ButtonWidgetCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Information about button widget. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    register TkButton *butPtr = (TkButton *) clientData;

    int result = TCL_OK;
    size_t length;
    int c;

    if (argc < 2) {
	sprintf(interp->result,
		"wrong # args: should be \"%.50s option ?arg arg ...?\"",
		argv[0]);
	return TCL_ERROR;





    }
    Tcl_Preserve((ClientData) butPtr);
    c = argv[1][0];
    length = strlen(argv[1]);

    if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
	    && (length >= 2)) {


	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " cget option\"",
		    (char *) NULL);
	    goto error;
	}
	result = Tk_ConfigureValue(interp, butPtr->tkwin, tkpButtonConfigSpecs,
		(char *) butPtr, argv[2], configFlags[butPtr->type]);


    } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)




	    && (length >= 2)) {

	if (argc == 2) {
	    result = Tk_ConfigureInfo(interp, butPtr->tkwin,
		    tkpButtonConfigSpecs, (char *) butPtr, (char *) NULL,


		    configFlags[butPtr->type]);


	} else if (argc == 3) {
	    result = Tk_ConfigureInfo(interp, butPtr->tkwin,
		    tkpButtonConfigSpecs, (char *) butPtr, argv[2],
		    configFlags[butPtr->type]);

	} else {
	    result = ConfigureButton(interp, butPtr, argc-2, argv+2,
		    configFlags[butPtr->type] | TK_CONFIG_ARGV_ONLY);
	}


    } else if ((c == 'd') && (strncmp(argv[1], "deselect", length) == 0)
	    && (butPtr->type >= TYPE_CHECK_BUTTON)) {

	if (argc > 2) {
	    sprintf(interp->result,
		    "wrong # args: should be \"%.50s deselect\"",
		    argv[0]);
	    goto error;
	}
	if (butPtr->type == TYPE_CHECK_BUTTON) {
	    if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->offValue,
		    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
		result = TCL_ERROR;

	    }
	} else if (butPtr->flags & SELECTED) {

	    if (Tcl_SetVar(interp, butPtr->selVarName, "",
		    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {




		result = TCL_ERROR;
	    };
	}
    } else if ((c == 'f') && (strncmp(argv[1], "flash", length) == 0)
	    && (butPtr->type != TYPE_LABEL)) {

	int i;



	if (argc > 2) {
	    sprintf(interp->result,
		    "wrong # args: should be \"%.50s flash\"",
		    argv[0]);
	    goto error;
	}
	if (butPtr->state != tkDisabledUid) {
	    for (i = 0; i < 4; i++) {

		butPtr->state = (butPtr->state == tkNormalUid)
			? tkActiveUid : tkNormalUid;
		Tk_SetBackgroundFromBorder(butPtr->tkwin,
			(butPtr->state == tkActiveUid) ? butPtr->activeBorder



			: butPtr->normalBorder);

		TkpDisplayButton((ClientData) butPtr);

		/*
		 * Special note: must cancel any existing idle handler
		 * for TkpDisplayButton;  it's no longer needed, and TkpDisplayButton
		 * cleared the REDRAW_PENDING flag.
		 */

		Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr);
		XFlush(butPtr->display);
		Tcl_Sleep(50);
	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "invoke", length) == 0)

	    && (butPtr->type > TYPE_LABEL)) {

	if (argc > 2) {
	    sprintf(interp->result,
		    "wrong # args: should be \"%.50s invoke\"",
		    argv[0]);
	    goto error;
	}
	if (butPtr->state != tkDisabledUid) {
	    result = TkInvokeButton(butPtr);
	}
    } else if ((c == 's') && (strncmp(argv[1], "select", length) == 0)

	    && (butPtr->type >= TYPE_CHECK_BUTTON)) {

	if (argc > 2) {
	    sprintf(interp->result,
		    "wrong # args: should be \"%.50s select\"",
		    argv[0]);
	    goto error;
	}
	if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->onValue,
		TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {



	    result = TCL_ERROR;
	}
    } else if ((c == 't') && (strncmp(argv[1], "toggle", length) == 0)
	    && (length >= 2) && (butPtr->type == TYPE_CHECK_BUTTON)) {
	if (argc > 2) {
	    sprintf(interp->result,
		    "wrong # args: should be \"%.50s toggle\"",
		    argv[0]);
	    goto error;
	}

	if (butPtr->flags & SELECTED) {
	    if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->offValue,
		    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
		result = TCL_ERROR;
	    }
	} else {
	    if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->onValue,
		    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
		result = TCL_ERROR;

	    }

	}
    } else {
	sprintf(interp->result,
		"bad option \"%.50s\": must be %s", argv[1],
		optionStrings[butPtr->type]);
	goto error;
    }
    Tcl_Release((ClientData) butPtr);
    return result;

    error:
    Tcl_Release((ClientData) butPtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * DestroyButton --
 *
 *	This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
 *	to clean up the internal structure of a button at a safe time
 *	(when no-one is using it anymore).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Everything associated with the widget is freed up.
 *
 *----------------------------------------------------------------------
 */

static void
DestroyButton(butPtr)
    TkButton *butPtr;		/* Info about button widget. */
{







    /*
     * Free up all the stuff that requires special handling, then
     * let Tk_FreeOptions handle all the standard option-related
     * stuff.
     */


    if (butPtr->textVarName != NULL) {
	Tcl_UntraceVar(butPtr->interp, butPtr->textVarName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ButtonTextVarProc, (ClientData) butPtr);
    }
    if (butPtr->image != NULL) {
	Tk_FreeImage(butPtr->image);
    }
    if (butPtr->selectImage != NULL) {
	Tk_FreeImage(butPtr->selectImage);
    }
    if (butPtr->normalTextGC != None) {
	Tk_FreeGC(butPtr->display, butPtr->normalTextGC);
    }
    if (butPtr->activeTextGC != None) {
	Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
    }



    if (butPtr->gray != None) {
	Tk_FreeBitmap(butPtr->display, butPtr->gray);
    }
    if (butPtr->disabledGC != None) {
	Tk_FreeGC(butPtr->display, butPtr->disabledGC);
    }
    if (butPtr->copyGC != None) {
	Tk_FreeGC(butPtr->display, butPtr->copyGC);
    }



    if (butPtr->selVarName != NULL) {
	Tcl_UntraceVar(butPtr->interp, butPtr->selVarName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ButtonVarProc, (ClientData) butPtr);
    }
    Tk_FreeTextLayout(butPtr->textLayout);
    Tk_FreeOptions(tkpButtonConfigSpecs, (char *) butPtr, butPtr->display,
	    configFlags[butPtr->type]);

    Tcl_EventuallyFree((ClientData)butPtr, TCL_DYNAMIC);
}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureButton --
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a button widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as text string, colors, font,
 *	etc. get set for butPtr;  old resources get freed, if there
 *	were any.  The button is redisplayed.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureButton(interp, butPtr, argc, argv, flags)
    Tcl_Interp *interp;		/* Used for error reporting. */
    register TkButton *butPtr;	/* Information about widget;  may or may
				 * not already have values for some fields. */
    int argc;			/* Number of valid entries in argv. */
    char **argv;		/* Arguments. */
    int flags;			/* Flags to pass to Tk_ConfigureWidget. */
{



    Tk_Image image;

    /*
     * Eliminate any existing trace on variables monitored by the button.
     */

    if (butPtr->textVarName != NULL) {
	Tcl_UntraceVar(interp, butPtr->textVarName, 
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ButtonTextVarProc, (ClientData) butPtr);
    }
    if (butPtr->selVarName != NULL) {
	Tcl_UntraceVar(interp, butPtr->selVarName, 
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ButtonVarProc, (ClientData) butPtr);
    }







    






    if (Tk_ConfigureWidget(interp, butPtr->tkwin, tkpButtonConfigSpecs,
	    argc, argv, (char *) butPtr, flags) != TCL_OK) {








	return TCL_ERROR;



    }

    /*
     * A few options need special processing, such as setting the
     * background from a 3-D border, or filling in complicated
     * defaults that couldn't be specified to Tk_ConfigureWidget.
     */


    if ((butPtr->state == tkActiveUid) && !Tk_StrictMotif(butPtr->tkwin)) {
	Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->activeBorder);
    } else {
	Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->normalBorder);
	if ((butPtr->state != tkNormalUid) && (butPtr->state != tkActiveUid)
		&& (butPtr->state != tkDisabledUid)) {
	    Tcl_AppendResult(interp, "bad state value \"", butPtr->state,
		    "\": must be normal, active, or disabled", (char *) NULL);
	    butPtr->state = tkNormalUid;
	    return TCL_ERROR;
	}
    }

    if ((butPtr->defaultState != tkActiveUid)
	    && (butPtr->defaultState != tkDisabledUid)
	    && (butPtr->defaultState != tkNormalUid)) {
	Tcl_AppendResult(interp, "bad -default value \"", butPtr->defaultState,
		"\": must be normal, active, or disabled", (char *) NULL);
	butPtr->defaultState = tkDisabledUid;
	return TCL_ERROR;
    }

    if (butPtr->highlightWidth < 0) {
	butPtr->highlightWidth = 0;
    }

    if (butPtr->padX < 0) {
	butPtr->padX = 0;
    }
    if (butPtr->padY < 0) {
	butPtr->padY = 0;
    }

    if (butPtr->type >= TYPE_CHECK_BUTTON) {
	char *value;

	if (butPtr->selVarName == NULL) {
	    butPtr->selVarName = (char *) ckalloc((unsigned)
		    (strlen(Tk_Name(butPtr->tkwin)) + 1));
	    strcpy(butPtr->selVarName, Tk_Name(butPtr->tkwin));
	}


	/*
	 * Select the button if the associated variable has the
	 * appropriate value, initialize the variable if it doesn't
	 * exist, then set a trace on the variable to monitor future
	 * changes to its value.
	 */

	value = Tcl_GetVar(interp, butPtr->selVarName, TCL_GLOBAL_ONLY);
	butPtr->flags &= ~SELECTED;
	if (value != NULL) {

	    if (strcmp(value, butPtr->onValue) == 0) {
		butPtr->flags |= SELECTED;
	    }
	} else {
	    if (Tcl_SetVar(interp, butPtr->selVarName,
		    (butPtr->type == TYPE_CHECK_BUTTON) ? butPtr->offValue : "",

		    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;


	    }
	}
	Tcl_TraceVar(interp, butPtr->selVarName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ButtonVarProc, (ClientData) butPtr);
    }

    /*
     * Get the images for the widget, if there are any.  Allocate the
     * new images before freeing the old ones, so that the reference
     * counts don't go to zero and cause image data to be discarded.
     */

    if (butPtr->imageString != NULL) {
	image = Tk_GetImage(butPtr->interp, butPtr->tkwin,

		butPtr->imageString, ButtonImageProc, (ClientData) butPtr);
	if (image == NULL) {
	    return TCL_ERROR;

	}
    } else {
	image = NULL;
    }
    if (butPtr->image != NULL) {
	Tk_FreeImage(butPtr->image);
    }
    butPtr->image = image;
    if (butPtr->selectImageString != NULL) {
	image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
		butPtr->selectImageString, ButtonSelectImageProc,
		(ClientData) butPtr);
	if (image == NULL) {
	    return TCL_ERROR;

	}
    } else {
	image = NULL;
    }
    if (butPtr->selectImage != NULL) {
	Tk_FreeImage(butPtr->selectImage);
    }
    butPtr->selectImage = image;

    if ((butPtr->image == NULL) && (butPtr->bitmap == None)
	    && (butPtr->textVarName != NULL)) {
	/*
	 * The button must display the value of a variable: set up a trace
	 * on the variable's value, create the variable if it doesn't
	 * exist, and fetch its current value.
	 */

	char *value;

	value = Tcl_GetVar(interp, butPtr->textVarName, TCL_GLOBAL_ONLY);

	if (value == NULL) {
	    if (Tcl_SetVar(interp, butPtr->textVarName, butPtr->text,
		    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;


	    }
	} else {
	    if (butPtr->text != NULL) {
		ckfree(butPtr->text);
	    }
	    butPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
	    strcpy(butPtr->text, value);
	}

	Tcl_TraceVar(interp, butPtr->textVarName,





		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,

		ButtonTextVarProc, (ClientData) butPtr);



    }











    if ((butPtr->bitmap != None) || (butPtr->image != NULL)) {
	if (Tk_GetPixels(interp, butPtr->tkwin, butPtr->widthString,
		&butPtr->width) != TCL_OK) {
	    widthError:
	    Tcl_AddErrorInfo(interp, "\n    (processing -width option)");
	    return TCL_ERROR;
	}
	if (Tk_GetPixels(interp, butPtr->tkwin, butPtr->heightString,
		&butPtr->height) != TCL_OK) {
	    heightError:
	    Tcl_AddErrorInfo(interp, "\n    (processing -height option)");


	    return TCL_ERROR;
	}
    } else {
	if (Tcl_GetInt(interp, butPtr->widthString, &butPtr->width)
		!= TCL_OK) {
	    goto widthError;

	}
	if (Tcl_GetInt(interp, butPtr->heightString, &butPtr->height)



		!= TCL_OK) {
	    goto heightError;



	}




    }
    
    TkButtonWorldChanged((ClientData) butPtr);





    return TCL_OK;

}

/*
 *---------------------------------------------------------------------------
 *
 * TkButtonWorldChanged --
 *







|


|
|

|
>
|
<
|

|
<
|
<

>
>
>
>
>


<
<

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

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

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

>

<
<
<
<
<














|
|
<





|








>
>
>
>
>
>
>






>
|
|















>
>
>



<
<
<



>
>
>
|
|



<
|
|
>
|







|
<
|



|










|



|
|
<

>
>
>






|
|



|
|




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

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

|
|
|
|
|

>
|
|
|
|
<
<
<
<
<
<

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

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

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

|
|
|
|
|
|
|
|
|

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

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



>
>
>
>
>
|
>







711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726

727
728
729

730

731
732
733
734
735
736
737
738


739


740
741
742
743


744
745
746
747
748
749
750
751
752
753
754
755
756
757

758
759
760
761
762
763
764
765


766
767
768

769
770
771
772

773
774
775


776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792

793
794

795
796
797
798
799




800
801
802
803
804
805

806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831


832
833
834
835
836
837
838
839
840
841
842


843
844
845
846
847
848
849
850
851
852
853
854
855


856
857
858
859
860
861




862

863
864
865
866





867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882

883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933



934
935
936
937
938
939
940
941
942
943
944

945
946
947
948
949
950
951
952
953
954
955
956

957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977

978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011

1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037






1038

1039





1040

1041

1042
1043
1044

1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080

1081
1082
1083
1084



1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097

1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111

1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136

1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171

1172
1173
1174


1175
1176
1177
1178

1179
1180
1181
1182



1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
ButtonWidgetObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Information about button widget. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument values. */
{
    TkButton *butPtr = (TkButton *) clientData;
    int index;
    int result;

    Tcl_Obj *objPtr;

    if (objc < 2) {

        Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");

	return TCL_ERROR;
    }
    result = Tcl_GetIndexFromObj(interp, objv[1], commandNames[butPtr->type],
	    "option", 0, &index);
    if (result != TCL_OK) {
	return result;
    }
    Tcl_Preserve((ClientData) butPtr);





    switch (map[butPtr->type][index]) {
	case COMMAND_CGET: {
	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 1, objv, "cget option");


		goto error;
	    }
	    objPtr = Tk_GetOptionValue(interp, (char *) butPtr,
		    butPtr->optionTable, objv[2], butPtr->tkwin);
	    if (objPtr == NULL) {
		 goto error;
	    } else {
		Tcl_SetObjResult(interp, objPtr);
	    }
	    break;
	}

	case COMMAND_CONFIGURE: {
	    if (objc <= 3) {

		objPtr = Tk_GetOptionInfo(interp, (char *) butPtr,
			butPtr->optionTable,
			(objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
			butPtr->tkwin);
		if (objPtr == NULL) {
		    goto error;
		} else {
		    Tcl_SetObjResult(interp, objPtr);


		}
	    } else {
		result = ConfigureButton(interp, butPtr, objc-2, objv+2);

	    }
	    break;
	}


	case COMMAND_DESELECT: {
	    if (objc > 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "deselect");


		goto error;
	    }
	    if (butPtr->type == TYPE_CHECK_BUTTON) {
		if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL,
			butPtr->offValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
			== NULL) {
		    goto error;
		}
	    } else if (butPtr->flags & SELECTED) {
		if (Tcl_ObjSetVar2(interp,
			butPtr->selVarNamePtr, NULL, Tcl_NewObj(),
			TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
			== NULL) {
		    goto error;
		}
	    }
	    break;

	}


	case COMMAND_FLASH: {
	    int i;

	    if (objc > 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "flash");




		goto error;
	    }
	    if (butPtr->state != STATE_DISABLED) {
		for (i = 0; i < 4; i++) {
		    if (butPtr->state == STATE_NORMAL) {
			butPtr->state = STATE_ACTIVE; 

			Tk_SetBackgroundFromBorder(butPtr->tkwin,
				butPtr->activeBorder);
		    } else {
			butPtr->state = STATE_NORMAL; 
			Tk_SetBackgroundFromBorder(butPtr->tkwin,
				butPtr->normalBorder);
		    }
		    TkpDisplayButton((ClientData) butPtr);
    
		    /*
		     * Special note: must cancel any existing idle handler
		     * for TkpDisplayButton;  it's no longer needed, and
		     * TkpDisplayButton cleared the REDRAW_PENDING flag.
		     */
    
		    Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr);
		    XFlush(butPtr->display);
		    Tcl_Sleep(50);
		}
	    }
	    break;
	}

	case COMMAND_INVOKE: {
	    if (objc > 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "invoke");


		goto error;
	    }
	    if (butPtr->state != STATE_DISABLED) {
		result = TkInvokeButton(butPtr);
	    }
	    break;
	}

	case COMMAND_SELECT: {
	    if (objc > 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "select");


		goto error;
	    }
	    if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL,
		    butPtr->onValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
		    == NULL) {
		goto error;
	    }
	    break;
	}

	case COMMAND_TOGGLE: {
	    if (objc > 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "toggle");


		goto error;
	    }
	    if (Tcl_ObjSetVar2(interp, butPtr->selVarNamePtr, NULL,
		    (butPtr->flags & SELECTED) ? butPtr->offValuePtr
		    : butPtr->onValuePtr,
		    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)




		    == NULL) {

		goto error;
	    }
	    break;
	}





    }
    Tcl_Release((ClientData) butPtr);
    return result;

    error:
    Tcl_Release((ClientData) butPtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * DestroyButton --
 *
 *	This procedure is invoked by ButtonEventProc to free all the
 *	resources of a button and clean up its state.

 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Everything associated with the widget is freed.
 *
 *----------------------------------------------------------------------
 */

static void
DestroyButton(butPtr)
    TkButton *butPtr;		/* Info about button widget. */
{
    TkpDestroyButton(butPtr);

    butPtr->flags |= BUTTON_DELETED;
    if (butPtr->flags & REDRAW_PENDING) {
	Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr);
    }

    /*
     * Free up all the stuff that requires special handling, then
     * let Tk_FreeOptions handle all the standard option-related
     * stuff.
     */

    Tcl_DeleteCommandFromToken(butPtr->interp, butPtr->widgetCmd);
    if (butPtr->textVarNamePtr != NULL) {
	Tcl_UntraceVar(butPtr->interp, Tcl_GetString(butPtr->textVarNamePtr),
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ButtonTextVarProc, (ClientData) butPtr);
    }
    if (butPtr->image != NULL) {
	Tk_FreeImage(butPtr->image);
    }
    if (butPtr->selectImage != NULL) {
	Tk_FreeImage(butPtr->selectImage);
    }
    if (butPtr->normalTextGC != None) {
	Tk_FreeGC(butPtr->display, butPtr->normalTextGC);
    }
    if (butPtr->activeTextGC != None) {
	Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
    }
    if (butPtr->disabledGC != None) {
	Tk_FreeGC(butPtr->display, butPtr->disabledGC);
    }
    if (butPtr->gray != None) {
	Tk_FreeBitmap(butPtr->display, butPtr->gray);
    }



    if (butPtr->copyGC != None) {
	Tk_FreeGC(butPtr->display, butPtr->copyGC);
    }
    if (butPtr->textLayout != NULL) {
	Tk_FreeTextLayout(butPtr->textLayout);
    }
    if (butPtr->selVarNamePtr != NULL) {
	Tcl_UntraceVar(butPtr->interp, Tcl_GetString(butPtr->selVarNamePtr),
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ButtonVarProc, (ClientData) butPtr);
    }

    Tk_FreeConfigOptions((char *) butPtr, butPtr->optionTable,
	    butPtr->tkwin);
    butPtr->tkwin = NULL;
    Tcl_EventuallyFree((ClientData) butPtr, TCL_DYNAMIC);
}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureButton --
 *
 *	This procedure is called to process an objc/objv list to set

 *	configuration options for a button widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then an error message is left in interp's result.
 *
 * Side effects:
 *	Configuration information, such as text string, colors, font,
 *	etc. get set for butPtr;  old resources get freed, if there
 *	were any.  The button is redisplayed.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureButton(interp, butPtr, objc, objv)
    Tcl_Interp *interp;		/* Used for error reporting. */
    register TkButton *butPtr;	/* Information about widget;  may or may
				 * not already have values for some fields. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument values. */

{
    Tk_SavedOptions savedOptions;
    Tcl_Obj *errorResult = NULL;
    int error;
    Tk_Image image;

    /*
     * Eliminate any existing trace on variables monitored by the button.
     */

    if (butPtr->textVarNamePtr != NULL) {
	Tcl_UntraceVar(interp, Tcl_GetString(butPtr->textVarNamePtr), 
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ButtonTextVarProc, (ClientData) butPtr);
    }
    if (butPtr->selVarNamePtr != NULL) {
	Tcl_UntraceVar(interp, Tcl_GetString(butPtr->selVarNamePtr), 
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ButtonVarProc, (ClientData) butPtr);
    }

    /*
     * The following loop is potentially executed twice.  During the
     * first pass configuration options get set to their new values.
     * If there is an error in this pass, we execute a second pass
     * to restore all the options to their previous values.
     */

    for (error = 0; error <= 1; error++) {
	if (!error) {
	    /*
	     * First pass: set options to new values.
	     */


	    if (Tk_SetOptions(interp, (char *) butPtr,
		    butPtr->optionTable, objc, objv,
		    butPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
		continue;
	    }
	} else {
	    /*
	     * Second pass: restore options to old values.
	     */

	    errorResult = Tcl_GetObjResult(interp);
	    Tcl_IncrRefCount(errorResult);
	    Tk_RestoreSavedOptions(&savedOptions);
	}

	/*
	 * A few options need special processing, such as setting the
	 * background from a 3-D border, or filling in complicated
	 * defaults that couldn't be specified to Tk_SetOptions.
	 */

	if ((butPtr->state == STATE_ACTIVE)
		&& !Tk_StrictMotif(butPtr->tkwin)) {
	    Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->activeBorder);
	} else {
	    Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->normalBorder);






	}

	if (butPtr->borderWidth < 0) {





	    butPtr->borderWidth = 0;

	}

	if (butPtr->highlightWidth < 0) {
	    butPtr->highlightWidth = 0;
	}

	if (butPtr->padX < 0) {
	    butPtr->padX = 0;
	}
	if (butPtr->padY < 0) {
	    butPtr->padY = 0;
	}

	if (butPtr->type >= TYPE_CHECK_BUTTON) {
	    Tcl_Obj *valuePtr, *namePtr;
    
	    if (butPtr->selVarNamePtr == NULL) {
		butPtr->selVarNamePtr = Tcl_NewStringObj(
			Tk_Name(butPtr->tkwin), -1);
		Tcl_IncrRefCount(butPtr->selVarNamePtr);
	    }
	    namePtr = butPtr->selVarNamePtr;
    
	    /*
	     * Select the button if the associated variable has the
	     * appropriate value, initialize the variable if it doesn't
	     * exist, then set a trace on the variable to monitor future
	     * changes to its value.
	     */
    
	    valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL, TCL_GLOBAL_ONLY);
	    butPtr->flags &= ~SELECTED;
	    if (valuePtr != NULL) {
		if (strcmp(Tcl_GetString(valuePtr),
			Tcl_GetString(butPtr->onValuePtr)) == 0) {
		    butPtr->flags |= SELECTED;
		}
	    } else {
		if (Tcl_ObjSetVar2(interp, namePtr, NULL,
			(butPtr->type == TYPE_CHECK_BUTTON)
			? butPtr->offValuePtr : Tcl_NewObj(),
			TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)

			== NULL) {
		    continue;
		}
	    }



	}

	/*
	 * Get the images for the widget, if there are any.  Allocate the
	 * new images before freeing the old ones, so that the reference
	 * counts don't go to zero and cause image data to be discarded.
	 */
    
	if (butPtr->imagePtr != NULL) {
	    image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
		    Tcl_GetString(butPtr->imagePtr), ButtonImageProc,
		    (ClientData) butPtr);
	    if (image == NULL) {

		continue;
	    }
	} else {
	    image = NULL;
	}
	if (butPtr->image != NULL) {
	    Tk_FreeImage(butPtr->image);
	}
	butPtr->image = image;
	if (butPtr->selectImagePtr != NULL) {
	    image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
		    Tcl_GetString(butPtr->selectImagePtr),
		    ButtonSelectImageProc, (ClientData) butPtr);
	    if (image == NULL) {

		continue;
	    }
	} else {
	    image = NULL;
	}
	if (butPtr->selectImage != NULL) {
	    Tk_FreeImage(butPtr->selectImage);
	}
	butPtr->selectImage = image;

	if ((butPtr->imagePtr == NULL) && (butPtr->bitmap == None)
		&& (butPtr->textVarNamePtr != NULL)) {
	    /*
	     * The button must display the value of a variable: set up a trace
	     * on the variable's value, create the variable if it doesn't
	     * exist, and fetch its current value.
	     */
    
	    Tcl_Obj *valuePtr, *namePtr;

	    namePtr = butPtr->textVarNamePtr;
	    valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL, TCL_GLOBAL_ONLY);
	    if (valuePtr == NULL) {
		if (Tcl_ObjSetVar2(interp, namePtr, NULL, butPtr->textPtr,
			TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)

			== NULL) {
		    continue;
		}
	    } else {
		if (butPtr->textPtr != NULL) {
		    Tcl_DecrRefCount(butPtr->textPtr);
		}
		butPtr->textPtr = valuePtr;
		Tcl_IncrRefCount(butPtr->textPtr);
	    }
	}
    
	if ((butPtr->bitmap != None) || (butPtr->imagePtr != NULL)) {
	    /*
	     * The button must display the contents of an image or
	     * bitmap.
	     */

	    if (Tk_GetPixelsFromObj(interp, butPtr->tkwin, butPtr->widthPtr,
		    &butPtr->width) != TCL_OK) {
		widthError:
		Tcl_AddErrorInfo(interp, "\n    (processing -width option)");
		continue;
	    }
	    if (Tk_GetPixelsFromObj(interp, butPtr->tkwin, butPtr->heightPtr,
		    &butPtr->height) != TCL_OK) {
		heightError:
		Tcl_AddErrorInfo(interp, "\n    (processing -height option)");
		continue;
	    }
	} else {
	    /*
	     * The button displays an ordinary text string.
	     */


	    if (Tcl_GetIntFromObj(interp, butPtr->widthPtr, &butPtr->width)
		    != TCL_OK) {
		goto widthError;


	    }
	    if (Tcl_GetIntFromObj(interp, butPtr->heightPtr, &butPtr->height)
		    != TCL_OK) {
		goto heightError;

	    }
	}
	break;
    }



    if (!error) {
	Tk_FreeSavedOptions(&savedOptions);
    }

    /*
     * Reestablish the variable traces, if they're needed.
     */

    if (butPtr->textVarNamePtr != NULL) {
	Tcl_TraceVar(interp, Tcl_GetString(butPtr->textVarNamePtr),
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ButtonTextVarProc, (ClientData) butPtr);
    }
    if (butPtr->selVarNamePtr != NULL) {
	Tcl_TraceVar(interp, Tcl_GetString(butPtr->selVarNamePtr),
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ButtonVarProc, (ClientData) butPtr);
    }
    
    TkButtonWorldChanged((ClientData) butPtr);
    if (error) {
	Tcl_SetObjResult(interp, errorResult);
	Tcl_DecrRefCount(errorResult);
	return TCL_ERROR;
    } else {
	return TCL_OK;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TkButtonWorldChanged --
 *
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
    newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
    if (butPtr->normalTextGC != None) {
	Tk_FreeGC(butPtr->display, butPtr->normalTextGC);
    }
    butPtr->normalTextGC = newGC;

    if (butPtr->activeFg != NULL) {
	gcValues.font = Tk_FontId(butPtr->tkfont);
	gcValues.foreground = butPtr->activeFg->pixel;
	gcValues.background = Tk_3DBorderColor(butPtr->activeBorder)->pixel;
	mask = GCForeground | GCBackground | GCFont;
	newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
	if (butPtr->activeTextGC != None) {
	    Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
	}
	butPtr->activeTextGC = newGC;
    }

    if (butPtr->type != TYPE_LABEL) {
	gcValues.font = Tk_FontId(butPtr->tkfont);
	gcValues.background = Tk_3DBorderColor(butPtr->normalBorder)->pixel;
	if ((butPtr->disabledFg != NULL) && (butPtr->imageString == NULL)) {
	    gcValues.foreground = butPtr->disabledFg->pixel;
	    mask = GCForeground | GCBackground | GCFont;
	} else {
	    gcValues.foreground = gcValues.background;
	    mask = GCForeground;
	    if (butPtr->gray == None) {
		butPtr->gray = Tk_GetBitmap(NULL, butPtr->tkwin, 
			Tk_GetUid("gray50"));
	    }
	    if (butPtr->gray != None) {
		gcValues.fill_style = FillStippled;
		gcValues.stipple = butPtr->gray;
		mask |= GCFillStyle | GCStipple;
	    }
	}







<











<

|






|
<







1257
1258
1259
1260
1261
1262
1263

1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274

1275
1276
1277
1278
1279
1280
1281
1282
1283

1284
1285
1286
1287
1288
1289
1290
    newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
    if (butPtr->normalTextGC != None) {
	Tk_FreeGC(butPtr->display, butPtr->normalTextGC);
    }
    butPtr->normalTextGC = newGC;

    if (butPtr->activeFg != NULL) {

	gcValues.foreground = butPtr->activeFg->pixel;
	gcValues.background = Tk_3DBorderColor(butPtr->activeBorder)->pixel;
	mask = GCForeground | GCBackground | GCFont;
	newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
	if (butPtr->activeTextGC != None) {
	    Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
	}
	butPtr->activeTextGC = newGC;
    }

    if (butPtr->type != TYPE_LABEL) {

	gcValues.background = Tk_3DBorderColor(butPtr->normalBorder)->pixel;
	if ((butPtr->disabledFg != NULL) && (butPtr->imagePtr == NULL)) {
	    gcValues.foreground = butPtr->disabledFg->pixel;
	    mask = GCForeground | GCBackground | GCFont;
	} else {
	    gcValues.foreground = gcValues.background;
	    mask = GCForeground;
	    if (butPtr->gray == None) {
		butPtr->gray = Tk_GetBitmap(NULL, butPtr->tkwin, "gray50");

	    }
	    if (butPtr->gray != None) {
		gcValues.fill_style = FillStippled;
		gcValues.stipple = butPtr->gray;
		mask |= GCFillStyle | GCStipple;
	    }
	}
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
	/*
	 * Must redraw after size changes, since layout could have changed
	 * and borders will need to be redrawn.
	 */

	goto redraw;
    } else if (eventPtr->type == DestroyNotify) {
	TkpDestroyButton(butPtr);
	if (butPtr->tkwin != NULL) {
	    butPtr->tkwin = NULL;
            Tcl_DeleteCommandFromToken(butPtr->interp, butPtr->widgetCmd);
	}
	if (butPtr->flags & REDRAW_PENDING) {
	    Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr);
	}
	DestroyButton(butPtr);
    } else if (eventPtr->type == FocusIn) {
	if (eventPtr->xfocus.detail != NotifyInferior) {
	    butPtr->flags |= GOT_FOCUS;
	    if (butPtr->highlightWidth > 0) {
		goto redraw;
	    }







<
<
<
<
<
<
<
<







1341
1342
1343
1344
1345
1346
1347








1348
1349
1350
1351
1352
1353
1354
	/*
	 * Must redraw after size changes, since layout could have changed
	 * and borders will need to be redrawn.
	 */

	goto redraw;
    } else if (eventPtr->type == DestroyNotify) {








	DestroyButton(butPtr);
    } else if (eventPtr->type == FocusIn) {
	if (eventPtr->xfocus.detail != NotifyInferior) {
	    butPtr->flags |= GOT_FOCUS;
	    if (butPtr->highlightWidth > 0) {
		goto redraw;
	    }
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105


1106
1107
1108
1109

1110
1111
1112
1113
1114

1115
1116
1117
1118
1119
1120

1121
1122
1123
1124
1125

1126
1127
1128
1129
1130
1131
1132
 */

static void
ButtonCmdDeletedProc(clientData)
    ClientData clientData;	/* Pointer to widget record for widget. */
{
    TkButton *butPtr = (TkButton *) clientData;
    Tk_Window tkwin = butPtr->tkwin;

    /*
     * This procedure could be invoked either because the window was
     * destroyed and the command was then deleted (in which case tkwin
     * is NULL) or because the command was deleted, and then this procedure
     * destroys the widget.
     */

    if (tkwin != NULL) {
	butPtr->tkwin = NULL;
	Tk_DestroyWindow(tkwin);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkInvokeButton --
 *
 *	This procedure is called to carry out the actions associated
 *	with a button, such as invoking a Tcl command or setting a
 *	variable.  This procedure is invoked, for example, when the
 *	button is invoked via the mouse.
 *
 * Results:
 *	A standard Tcl return value.  Information is also left in
 *	interp->result.
 *
 * Side effects:
 *	Depends on the button and its associated command.
 *
 *----------------------------------------------------------------------
 */

int
TkInvokeButton(butPtr)
    register TkButton *butPtr;		/* Information about button. */
{


    if (butPtr->type == TYPE_CHECK_BUTTON) {
	if (butPtr->flags & SELECTED) {
	    if (Tcl_SetVar(butPtr->interp, butPtr->selVarName, butPtr->offValue,
		    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {

		return TCL_ERROR;
	    }
	} else {
	    if (Tcl_SetVar(butPtr->interp, butPtr->selVarName, butPtr->onValue,
		    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {

		return TCL_ERROR;
	    }
	}
    } else if (butPtr->type == TYPE_RADIO_BUTTON) {
	if (Tcl_SetVar(butPtr->interp, butPtr->selVarName, butPtr->onValue,
		TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {

	    return TCL_ERROR;
	}
    }
    if ((butPtr->type != TYPE_LABEL) && (butPtr->command != NULL)) {
	return TkCopyAndGlobalEval(butPtr->interp, butPtr->command);

    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *







<



|
|
|


<
|
|















|









|

>
>


|
|
>



|
|
>




|
|
>



|
|
>







1389
1390
1391
1392
1393
1394
1395

1396
1397
1398
1399
1400
1401
1402
1403

1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
 */

static void
ButtonCmdDeletedProc(clientData)
    ClientData clientData;	/* Pointer to widget record for widget. */
{
    TkButton *butPtr = (TkButton *) clientData;


    /*
     * This procedure could be invoked either because the window was
     * destroyed and the command was then deleted or because the command
     * was deleted, and then this procedure destroys the widget.  The
     * BUTTON_DELETED flag distinguishes these cases.
     */


    if (!(butPtr->flags & BUTTON_DELETED)) {
	Tk_DestroyWindow(butPtr->tkwin);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkInvokeButton --
 *
 *	This procedure is called to carry out the actions associated
 *	with a button, such as invoking a Tcl command or setting a
 *	variable.  This procedure is invoked, for example, when the
 *	button is invoked via the mouse.
 *
 * Results:
 *	A standard Tcl return value.  Information is also left in
 *	the interp's result.
 *
 * Side effects:
 *	Depends on the button and its associated command.
 *
 *----------------------------------------------------------------------
 */

int
TkInvokeButton(butPtr)
    TkButton *butPtr;			/* Information about button. */
{
    Tcl_Obj *namePtr = butPtr->selVarNamePtr;

    if (butPtr->type == TYPE_CHECK_BUTTON) {
	if (butPtr->flags & SELECTED) {
	    if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL,
		    butPtr->offValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
		    == NULL) {
		return TCL_ERROR;
	    }
	} else {
	    if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL,
		    butPtr->onValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
		    == NULL) {
		return TCL_ERROR;
	    }
	}
    } else if (butPtr->type == TYPE_RADIO_BUTTON) {
	if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL, butPtr->onValuePtr,
		TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
		== NULL) {
	    return TCL_ERROR;
	}
    }
    if ((butPtr->type != TYPE_LABEL) && (butPtr->commandPtr != NULL)) {
	return Tcl_EvalObjEx(butPtr->interp, butPtr->commandPtr,
		TCL_EVAL_GLOBAL);
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
1152
1153
1154
1155
1156
1157
1158

1159


1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183


1184
1185
1186
1187
1188
1189
1190
1191
1192
    ClientData clientData;	/* Information about button. */
    Tcl_Interp *interp;		/* Interpreter containing variable. */
    char *name1;		/* Name of variable. */
    char *name2;		/* Second part of variable name. */
    int flags;			/* Information about what happened. */
{
    register TkButton *butPtr = (TkButton *) clientData;

    char *value;



    /*
     * If the variable is being unset, then just re-establish the
     * trace unless the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	butPtr->flags &= ~SELECTED;
	if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
	    Tcl_TraceVar(interp, butPtr->selVarName,
		    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		    ButtonVarProc, clientData);
	}
	goto redisplay;
    }

    /*
     * Use the value of the variable to update the selected status of
     * the button.
     */

    value = Tcl_GetVar(interp, butPtr->selVarName, TCL_GLOBAL_ONLY);
    if (value == NULL) {
	value = "";


    }
    if (strcmp(value, butPtr->onValue) == 0) {
	if (butPtr->flags & SELECTED) {
	    return (char *) NULL;
	}
	butPtr->flags |= SELECTED;
    } else if (butPtr->flags & SELECTED) {
	butPtr->flags &= ~SELECTED;
    } else {







>
|
>
>









|











|
|

>
>

|







1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
    ClientData clientData;	/* Information about button. */
    Tcl_Interp *interp;		/* Interpreter containing variable. */
    char *name1;		/* Name of variable. */
    char *name2;		/* Second part of variable name. */
    int flags;			/* Information about what happened. */
{
    register TkButton *butPtr = (TkButton *) clientData;
    char *name, *value;
    Tcl_Obj *valuePtr;

    name = Tcl_GetString(butPtr->selVarNamePtr);

    /*
     * If the variable is being unset, then just re-establish the
     * trace unless the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	butPtr->flags &= ~SELECTED;
	if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
	    Tcl_TraceVar(interp, name,
		    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		    ButtonVarProc, clientData);
	}
	goto redisplay;
    }

    /*
     * Use the value of the variable to update the selected status of
     * the button.
     */

    valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
    if (valuePtr == NULL) {
	value = "";
    } else {
	value = Tcl_GetString(valuePtr);
    }
    if (strcmp(value, Tcl_GetString(butPtr->onValuePtr)) == 0) {
	if (butPtr->flags & SELECTED) {
	    return (char *) NULL;
	}
	butPtr->flags |= SELECTED;
    } else if (butPtr->flags & SELECTED) {
	butPtr->flags &= ~SELECTED;
    } else {
1225
1226
1227
1228
1229
1230
1231
1232
1233



1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
ButtonTextVarProc(clientData, interp, name1, name2, flags)
    ClientData clientData;	/* Information about button. */
    Tcl_Interp *interp;		/* Interpreter containing variable. */
    char *name1;		/* Not used. */
    char *name2;		/* Not used. */
    int flags;			/* Information about what happened. */
{
    register TkButton *butPtr = (TkButton *) clientData;
    char *value;




    /*
     * If the variable is unset, then immediately recreate it unless
     * the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
	    Tcl_SetVar(interp, butPtr->textVarName, butPtr->text,
		    TCL_GLOBAL_ONLY);
	    Tcl_TraceVar(interp, butPtr->textVarName,
		    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		    ButtonTextVarProc, clientData);
	}
	return (char *) NULL;
    }

    value = Tcl_GetVar(interp, butPtr->textVarName, TCL_GLOBAL_ONLY);
    if (value == NULL) {
	value = "";
    }
    if (butPtr->text != NULL) {
	ckfree(butPtr->text);
    }
    butPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
    strcpy(butPtr->text, value);
    TkpComputeButtonGeometry(butPtr);

    if ((butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin)
	    && !(butPtr->flags & REDRAW_PENDING)) {
	Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
	butPtr->flags |= REDRAW_PENDING;
    }
    return (char *) NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ButtonImageProc --
 *
 *	This procedure is invoked by the image code whenever the manager
 *	for an image does something that affects the size of contents
 *	of an image displayed in a button.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Arranges for the button to get redisplayed.







|
|
>
>
>








|

|






|
|
|

|
|
<
<
|
















|







1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597


1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
ButtonTextVarProc(clientData, interp, name1, name2, flags)
    ClientData clientData;	/* Information about button. */
    Tcl_Interp *interp;		/* Interpreter containing variable. */
    char *name1;		/* Not used. */
    char *name2;		/* Not used. */
    int flags;			/* Information about what happened. */
{
    TkButton *butPtr = (TkButton *) clientData;
    char *name;
    Tcl_Obj *valuePtr;

    name = Tcl_GetString(butPtr->textVarNamePtr);

    /*
     * If the variable is unset, then immediately recreate it unless
     * the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
	    Tcl_SetVar2Ex(interp, name, NULL, butPtr->textPtr, 
		    TCL_GLOBAL_ONLY);
	    Tcl_TraceVar(interp, name,
		    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		    ButtonTextVarProc, clientData);
	}
	return (char *) NULL;
    }

    valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
    if (valuePtr == NULL) {
	valuePtr = Tcl_NewObj();
    }
    Tcl_DecrRefCount(butPtr->textPtr);
    butPtr->textPtr = valuePtr;


    Tcl_IncrRefCount(butPtr->textPtr);
    TkpComputeButtonGeometry(butPtr);

    if ((butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin)
	    && !(butPtr->flags & REDRAW_PENDING)) {
	Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
	butPtr->flags |= REDRAW_PENDING;
    }
    return (char *) NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ButtonImageProc --
 *
 *	This procedure is invoked by the image code whenever the manager
 *	for an image does something that affects the size or contents
 *	of an image displayed in a button.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Arranges for the button to get redisplayed.
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321

/*
 *----------------------------------------------------------------------
 *
 * ButtonSelectImageProc --
 *
 *	This procedure is invoked by the image code whenever the manager
 *	for an image does something that affects the size of contents
 *	of the image displayed in a button when it is selected.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May arrange for the button to get redisplayed.







|







1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660

/*
 *----------------------------------------------------------------------
 *
 * ButtonSelectImageProc --
 *
 *	This procedure is invoked by the image code whenever the manager
 *	for an image does something that affects the size or contents
 *	of the image displayed in a button when it is selected.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May arrange for the button to get redisplayed.

Changes to generic/tkButton.h.

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
/*
 * tkButton.h --
 *
 *	Declarations of types and functions used to implement
 *	button-like widgets.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkButton.h 1.5 97/06/06 11:19:24
 */

#ifndef _TKBUTTON
#define _TKBUTTON

#ifndef _TKINT
#include "tkInt.h"
#endif






















/*
 * A data structure of the following type is kept for each
 * widget managed by this file:
 */

typedef struct {
    Tk_Window tkwin;		/* Window that embodies the button.  NULL
				 * means that the window has been destroyed. */
    Display *display;		/* Display containing widget.  Needed to
				 * free up resources after tkwin is gone. */
    Tcl_Interp *interp;		/* Interpreter associated with button. */
    Tcl_Command widgetCmd;	/* Token for button's widget command. */
    int type;			/* Type of widget:  restricts operations
				 * that may be performed on widget.  See
				 * below for possible values. */



    /*
     * Information about what's in the button.
     */


    char *text;			/* Text to display in button (malloc'ed)
				 * or NULL. */

    int underline;		/* Index of character to underline.  < 0 means
				 * don't underline anything. */

    char *textVarName;		/* Name of variable (malloc'ed) or NULL.
				 * If non-NULL, button displays the contents
				 * of this variable. */
    Pixmap bitmap;		/* Bitmap to display or None.  If not None

				 * then text and textVar are ignored. */

    char *imageString;		/* Name of image to display (malloc'ed), or
				 * NULL.  If non-NULL, bitmap, text, and
				 * textVarName are ignored. */
    Tk_Image image;		/* Image to display in window, or NULL if
				 * none. */
    char *selectImageString;	/* Name of image to display when selected
				 * (malloc'ed), or NULL. */
    Tk_Image selectImage;	/* Image to display in window when selected,
				 * or NULL if none.  Ignored if image is
				 * NULL. */




    /*
     * Information used when displaying widget:
     */


    Tk_Uid state;		/* State of button for display purposes:
				 * normal, active, or disabled. */
    Tk_3DBorder normalBorder;	/* Structure used to draw 3-D
				 * border and background when window
				 * isn't active.  NULL means no such
				 * border exists. */
    Tk_3DBorder activeBorder;	/* Structure used to draw 3-D

				 * border and background when window
				 * is active.  NULL means no such
				 * border exists. */
    int borderWidth;		/* Width of border. */



    int relief;			/* 3-d effect: TK_RELIEF_RAISED, etc. */

    int highlightWidth;		/* Width in pixels of highlight to draw
				 * around widget when it has the focus.
				 * <= 0 means don't draw a highlight. */


    Tk_3DBorder highlightBorder;
				/* Structure used to draw 3-D default ring

				 * and focus highlight area when highlight
				 * is off. */

    XColor *highlightColorPtr;	/* Color for drawing traversal highlight. */

    int inset;			/* Total width of all borders, including
				 * traversal highlight and 3-D border.
				 * Indicates how much interior stuff must
				 * be offset from outside edges to leave
				 * room for borders. */
    Tk_Font tkfont;		/* Information about text font, or NULL. */


    XColor *normalFg;		/* Foreground color in normal mode. */

    XColor *activeFg;		/* Foreground color in active mode.  NULL
				 * means use normalFg instead. */

    XColor *disabledFg;		/* Foreground color when disabled.  NULL
				 * means use normalFg with a 50% stipple
				 * instead. */
    GC normalTextGC;		/* GC for drawing text in normal mode.  Also
				 * used to copy from off-screen pixmap onto
				 * screen. */
    GC activeTextGC;		/* GC for drawing text in active mode (NULL
				 * means use normalTextGC). */
    Pixmap gray;		/* Pixmap for displaying disabled text if
				 * disabledFg is NULL. */
    GC disabledGC;		/* Used to produce disabled effect.  If
				 * disabledFg isn't NULL, this GC is used to
				 * draw button text or icon.  Otherwise
				 * text or icon is drawn with normalGC and
				 * this GC is used to stipple background
				 * across it.  For labels this is None. */


    GC copyGC;			/* Used for copying information from an
				 * off-screen pixmap to the screen. */
    char *widthString;		/* Value of -width option.  Malloc'ed. */

    char *heightString;		/* Value of -height option.  Malloc'ed. */
    int width, height;		/* If > 0, these specify dimensions to request
				 * for window, in characters for text and in
				 * pixels for bitmaps.  In this case the actual
				 * size of the text string or bitmap is
				 * ignored in computing desired window size. */
    int wrapLength;		/* Line length (in pixels) at which to wrap
				 * onto next line.  <= 0 means don't wrap
				 * except at newlines. */



    int padX, padY;		/* Extra space around text (pixels to leave





				 * on each side).  Ignored for bitmaps and
				 * images. */


    Tk_Anchor anchor;		/* Where text/bitmap should be displayed
				 * inside button region. */
    Tk_Justify justify;		/* Justification to use for multi-line text. */

    int indicatorOn;		/* True means draw indicator, false means

				 * don't draw it. */

    Tk_3DBorder selectBorder;	/* For drawing indicator background, or perhaps
				 * widget background, when selected. */
    int textWidth;		/* Width needed to display text as requested,
				 * in pixels. */
    int textHeight;		/* Height needed to display text as requested,
				 * in pixels. */
    Tk_TextLayout textLayout;	/* Saved text layout information. */
    int indicatorSpace;		/* Horizontal space (in pixels) allocated for
				 * display of indicator. */
    int indicatorDiameter;	/* Diameter of indicator, in pixels. */



    Tk_Uid defaultState;	/* State of default ring: normal, active, or
				 * disabled. */

        
    /*
     * For check and radio buttons, the fields below are used
     * to manage the variable indicating the button's state.
     */


    char *selVarName;		/* Name of variable used to control selected
				 * state of button.  Malloc'ed (if
				 * not NULL). */

    char *onValue;		/* Value to store in variable when
				 * this button is selected.  Malloc'ed (if
				 * not NULL). */

    char *offValue;		/* Value to store in variable when this
				 * button isn't selected.  Malloc'ed
				 * (if not NULL).  Valid only for check
				 * buttons. */

    /*
     * Miscellaneous information:
     */


    Tk_Cursor cursor;		/* Current cursor for window, or None. */
    char *takeFocus;		/* Value of -takefocus option;  not used in
				 * the C code, but used by keyboard traversal
				 * scripts.  Malloc'ed, but may be NULL. */

    char *command;		/* Command to execute when button is
				 * invoked; valid for buttons only.

				 * If not NULL, it's malloc-ed. */
    int flags;			/* Various flags;  see below for
				 * definitions. */
} TkButton;

/*
 * Possible "type" values for buttons.  These are the kinds of
 * widgets supported by this file.  The ordering of the type






|




|








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













|
|
|
>
>





>
|
<
>
|

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

>
>
>





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

>
>
|
<
>
|
|
>
|
|





|
>
>
|
>
|
|
>
|







<
<






>
>


|
>
|
|
<
<
<
|
|


>
>
>
|
>
>
>
>
>
|

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








>
>
>
|
|
>
|





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





>
|
|

|
>
|
<
>
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

84
85
86
87
88
89
90
91
92
93
94
95
96

97
98
99

100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143


144
145
146
147
148
149
150
151
152
153
154
155
156
157



158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207

208
209
210

211
212
213

214
215
216
217
218
219
220
221
222
223
224
225
226

227
228
229
230
231
232
233
234
235
/*
 * tkButton.h --
 *
 *	Declarations of types and functions used to implement
 *	button-like widgets.
 *
 * Copyright (c) 1996-1998 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkButton.h,v 1.1.4.2 1998/09/30 02:16:41 stanton Exp $
 */

#ifndef _TKBUTTON
#define _TKBUTTON

#ifndef _TKINT
#include "tkInt.h"
#endif

#ifdef BUILD_tk
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * Legal values for the "state" field of TkButton records.
 */

enum state {
    STATE_ACTIVE, STATE_DISABLED, STATE_NORMAL
};

/*
 * Legal values for the "defaultState" field of TkButton records.
 */

enum defaultState {
    DEFAULT_ACTIVE, DEFAULT_DISABLED, DEFAULT_NORMAL
};

/*
 * A data structure of the following type is kept for each
 * widget managed by this file:
 */

typedef struct {
    Tk_Window tkwin;		/* Window that embodies the button.  NULL
				 * means that the window has been destroyed. */
    Display *display;		/* Display containing widget.  Needed to
				 * free up resources after tkwin is gone. */
    Tcl_Interp *interp;		/* Interpreter associated with button. */
    Tcl_Command widgetCmd;	/* Token for button's widget command. */
    int type;			/* Type of widget, such as TYPE_LABEL:
				 * restricts operations that may be performed
				 * on widget.  See below for legal values. */
    Tk_OptionTable optionTable;	/* Table that defines configuration options
				 * available for this widget. */

    /*
     * Information about what's in the button.
     */

    Tcl_Obj *textPtr;		/* Value of -text option: specifies text to
				 * display in button. */

    int underline;		/* Value of -underline option: specifies
				 * index of character to underline.  < 0 means
				 * don't underline anything. */
    Tcl_Obj *textVarNamePtr;	/* Value of -textvariable option: specifies
				 * name of variable or NULL.  If non-NULL,
				 * button displays the contents of this
				 * variable. */
    Pixmap bitmap;		/* Value of -bitmap option.  If not None,
				 * specifies bitmap to display and text and
				 * textVar are ignored. */
    Tcl_Obj *imagePtr;		/* Value of -image option: specifies image
				 * to display in window, or NULL if none.
				 * If non-NULL, bitmap, text, and textVarName
				 * are ignored.*/
    Tk_Image image;		/* Derived from imagePtr by calling
				 * Tk_GetImage, or NULL if imagePtr is NULL. */
    Tcl_Obj *selectImagePtr;	/* Value of -selectimage option: specifies

				 * image to display in window when selected,
				 * or NULL if none.  Ignored if imagePtr is
				 * NULL. */
    Tk_Image selectImage;	/* Derived from selectImagePtr by calling
				 * Tk_GetImage, or NULL if selectImagePtr
				 * is NULL. */

    /*
     * Information used when displaying widget:
     */

    enum state state;		/* Value of -state option: specifies
				 * state of button for display purposes.*/

    Tk_3DBorder normalBorder;	/* Value of -background option: specifies
				 * color for background (and border) when
				 * window isn't active. */

    Tk_3DBorder activeBorder;	/* Value of -activebackground option:
				 * this is the color used to draw 3-D border
				 * and background when widget is active. */
    Tcl_Obj *borderWidthPtr;	/* Value of -borderWidth option: specifies
				 * width of border in pixels. */
    int borderWidth;		/* Integer value corresponding to
				 * borderWidthPtr.  Always >= 0. */
    int relief;			/* Value of -relief option: specifies 3-d
				 * effect for border, such as
				 * TK_RELIEF_RAISED. */
    Tcl_Obj *highlightWidthPtr;	/* Value of -highlightthickness option:
				 * specifies width in pixels of highlight to
				 * draw around widget when it has the focus.
				 * <= 0 means don't draw a highlight. */
    int highlightWidth;		/* Integer value corresponding to
				 * highlightWidthPtr.  Always >= 0. */
    Tk_3DBorder highlightBorder;/* Value of -highlightbackground option:

				 * specifies background with which to draw 3-D
				 * default ring and focus highlight area when
				 * highlight is off. */
    XColor *highlightColorPtr;	/* Value of -highlightcolor option:
				 * specifies color for drawing traversal
				 * highlight. */
    int inset;			/* Total width of all borders, including
				 * traversal highlight and 3-D border.
				 * Indicates how much interior stuff must
				 * be offset from outside edges to leave
				 * room for borders. */
    Tk_Font tkfont;		/* Value of -font option: specifies font
				 * to use for display text. */
    XColor *normalFg;		/* Value of -font option: specifies foreground
				 * color in normal mode. */
    XColor *activeFg;		/* Value of -activeforeground option:
				 * foreground color in active mode.  NULL
				 * means use -foreground instead. */
    XColor *disabledFg;		/* Value of -disabledforeground option:
				 * foreground color when disabled.  NULL
				 * means use normalFg with a 50% stipple
				 * instead. */
    GC normalTextGC;		/* GC for drawing text in normal mode.  Also
				 * used to copy from off-screen pixmap onto
				 * screen. */
    GC activeTextGC;		/* GC for drawing text in active mode (NULL
				 * means use normalTextGC). */


    GC disabledGC;		/* Used to produce disabled effect.  If
				 * disabledFg isn't NULL, this GC is used to
				 * draw button text or icon.  Otherwise
				 * text or icon is drawn with normalGC and
				 * this GC is used to stipple background
				 * across it.  For labels this is None. */
    Pixmap gray;		/* Pixmap for displaying disabled text if
				 * disabledFg is NULL. */
    GC copyGC;			/* Used for copying information from an
				 * off-screen pixmap to the screen. */
    Tcl_Obj *widthPtr;		/* Value of -width option. */
    int width;			/* Integer value corresponding to widthPtr. */
    Tcl_Obj *heightPtr;		/* Value of -height option. */
    int height;			/* Integer value corresponding to heightPtr. */



    Tcl_Obj *wrapLengthPtr;	/* Value of -wraplength option: specifies
				 * line length (in pixels) at which to wrap
				 * onto next line.  <= 0 means don't wrap
				 * except at newlines. */
    int wrapLength;		/* Integer value corresponding to
				 * wrapLengthPtr. */
    Tcl_Obj *padXPtr;		/* Value of -padx option: specifies how many
				 * pixels of extra space to leave on left and
				 * right of text.  Ignored for bitmaps and
				 * images. */
    int padX;			/* Integer value corresponding to padXPtr. */
    Tcl_Obj *padYPtr;		/* Value of -padx option: specifies how many
				 * pixels of extra space to leave above and
				 * below text.  Ignored for bitmaps and
				 * images. */
    int padY;			/* Integer value corresponding to padYPtr. */
    Tk_Anchor anchor;		/* Value of -anchor option: specifies where
				 * text/bitmap should be displayed inside
				 * button region. */
    Tk_Justify justify;		/* Value of -justify option: specifies how
				 * to align lines of multi-line text. */
    int indicatorOn;		/* Value of -indicatoron option:  1 means
				 * draw indicator in checkbuttons and
				 * radiobuttons, 0 means don't draw it. */
    Tk_3DBorder selectBorder;	/* Value of -selectcolor option: specifies
				 * color for drawing indicator background, or
				 * perhaps widget background, when selected. */
    int textWidth;		/* Width needed to display text as requested,
				 * in pixels. */
    int textHeight;		/* Height needed to display text as requested,
				 * in pixels. */
    Tk_TextLayout textLayout;	/* Saved text layout information. */
    int indicatorSpace;		/* Horizontal space (in pixels) allocated for
				 * display of indicator. */
    int indicatorDiameter;	/* Diameter of indicator, in pixels. */
    enum defaultState defaultState;
				/* Value of -default option, such as
				 * DEFAULT_NORMAL: specifies state
				 * of default ring for buttons (normal,
				 * active, or disabled).  NULL for other
				 * classes. */

    /*
     * For check and radio buttons, the fields below are used
     * to manage the variable indicating the button's state.
     */

    Tcl_Obj *selVarNamePtr;	/* Value of -variable option: specifies name
				 * of variable used to control selected
				 * state of button. */

    Tcl_Obj *onValuePtr;	/* Value of -offvalue option: specifies value
				 * to store in variable when this button is
				 * selected. */

    Tcl_Obj *offValuePtr;	/* Value of -offvalue option: specifies value
				 * to store in variable when this button
				 * isn't selected.  Used only by

				 * checkbuttons. */

    /*
     * Miscellaneous information:
     */

    Tk_Cursor cursor;		/* Value of -cursor option: if not None,
				 * specifies current cursor for window. */
    Tcl_Obj *takeFocusPtr;	/* Value of -takefocus option;  not used in
				 * the C code, but used by keyboard traversal
				 * scripts. */
    Tcl_Obj *commandPtr;	/* Value of -command option: specifies script 
				 * to execute when button is invoked.  If

				 * widget is label or has no command, this
				 * is NULL. */
    int flags;			/* Various flags;  see below for
				 * definitions. */
} TkButton;

/*
 * Possible "type" values for buttons.  These are the kinds of
 * widgets supported by this file.  The ordering of the type
191
192
193
194
195
196
197



198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227




228
229
230
231
232
233
234
235
236
237
238
239
240



241
 * REDRAW_PENDING:		Non-zero means a DoWhenIdle handler
 *				has already been queued to redraw
 *				this window.
 * SELECTED:			Non-zero means this button is selected,
 *				so special highlight should be drawn.
 * GOT_FOCUS:			Non-zero means this button currently
 *				has the input focus.



 */

#define REDRAW_PENDING		1
#define SELECTED		2
#define GOT_FOCUS		4

/*
 * Mask values used to selectively enable entries in the
 * configuration specs:
 */

#define LABEL_MASK		TK_CONFIG_USER_BIT
#define BUTTON_MASK		TK_CONFIG_USER_BIT << 1
#define CHECK_BUTTON_MASK	TK_CONFIG_USER_BIT << 2
#define RADIO_BUTTON_MASK	TK_CONFIG_USER_BIT << 3
#define ALL_MASK		(LABEL_MASK | BUTTON_MASK \
	| CHECK_BUTTON_MASK | RADIO_BUTTON_MASK)

/*
 * Declaration of variables shared between the files in the button module.
 */

extern TkClassProcs tkpButtonProcs;
extern Tk_ConfigSpec tkpButtonConfigSpecs[];

/*
 * Declaration of procedures used in the implementation of the button
 * widget. 
 */





EXTERN void		TkButtonWorldChanged _ANSI_ARGS_((
			    ClientData instanceData));
EXTERN void		TkpComputeButtonGeometry _ANSI_ARGS_((
			    TkButton *butPtr));
EXTERN TkButton *	TkpCreateButton _ANSI_ARGS_((Tk_Window tkwin));
#ifndef TkpDestroyButton
EXTERN void 		TkpDestroyButton _ANSI_ARGS_((TkButton *butPtr));
#endif
#ifndef TkpDisplayButton
EXTERN void		TkpDisplayButton _ANSI_ARGS_((ClientData clientData));
#endif
EXTERN int		TkInvokeButton  _ANSI_ARGS_((TkButton *butPtr));




#endif /* _TKBUTTON */







>
>
>





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






<






>
>
>
>













>
>
>

248
249
250
251
252
253
254
255
256
257
258
259
260
261
262







263




264
265
266
267
268
269

270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
 * REDRAW_PENDING:		Non-zero means a DoWhenIdle handler
 *				has already been queued to redraw
 *				this window.
 * SELECTED:			Non-zero means this button is selected,
 *				so special highlight should be drawn.
 * GOT_FOCUS:			Non-zero means this button currently
 *				has the input focus.
 * BUTTON_DELETED:		Non-zero needs that this button has been
 *				deleted, or is in the process of being
 *				deleted.
 */

#define REDRAW_PENDING		1
#define SELECTED		2
#define GOT_FOCUS		4







#define BUTTON_DELETED		0x8





/*
 * Declaration of variables shared between the files in the button module.
 */

extern TkClassProcs tkpButtonProcs;


/*
 * Declaration of procedures used in the implementation of the button
 * widget. 
 */

#ifndef TkpButtonSetDefaults
EXTERN void		TkpButtonSetDefaults _ANSI_ARGS_((
			    Tk_OptionSpec *specPtr));
#endif
EXTERN void		TkButtonWorldChanged _ANSI_ARGS_((
			    ClientData instanceData));
EXTERN void		TkpComputeButtonGeometry _ANSI_ARGS_((
			    TkButton *butPtr));
EXTERN TkButton *	TkpCreateButton _ANSI_ARGS_((Tk_Window tkwin));
#ifndef TkpDestroyButton
EXTERN void 		TkpDestroyButton _ANSI_ARGS_((TkButton *butPtr));
#endif
#ifndef TkpDisplayButton
EXTERN void		TkpDisplayButton _ANSI_ARGS_((ClientData clientData));
#endif
EXTERN int		TkInvokeButton  _ANSI_ARGS_((TkButton *butPtr));

# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TKBUTTON */

Changes to generic/tkCanvArc.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkCanvArc.c --
 *
 *	This file implements arc items for canvas widgets.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkCanvArc.c 1.34 97/04/25 16:50:56
 */

#include <stdio.h>
#include "tkPort.h"
#include "tkInt.h"

/*






|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkCanvArc.c --
 *
 *	This file implements arc items for canvas widgets.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkCanvArc.c,v 1.1.4.4 1999/02/16 11:39:30 lfb Exp $
 */

#include <stdio.h>
#include "tkPort.h"
#include "tkInt.h"

/*
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
    (Tk_ItemType *) NULL		/* nextPtr */
};

#ifndef PI
#    define PI 3.14159265358979323846
#endif

/*
 * The uid's below comprise the legal values for the "-style"
 * option for arcs.
 */

static Tk_Uid arcUid =  NULL;
static Tk_Uid chordUid =  NULL;
static Tk_Uid pieSliceUid = NULL;

/*
 *--------------------------------------------------------------
 *
 * CreateArc --
 *
 *	This procedure is invoked to create a new arc item in
 *	a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item, then an error message is left in
 *	interp->result;  in this case itemPtr is
 *	left uninitialized, so it can be safely freed by the
 *	caller.
 *
 * Side effects:
 *	A new arc item is created.
 *
 *--------------------------------------------------------------







<
<
<
<
<
<
<
<












|







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
    (Tk_ItemType *) NULL		/* nextPtr */
};

#ifndef PI
#    define PI 3.14159265358979323846
#endif










/*
 *--------------------------------------------------------------
 *
 * CreateArc --
 *
 *	This procedure is invoked to create a new arc item in
 *	a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item, then an error message is left in
 *	the interp's result;  in this case itemPtr is
 *	left uninitialized, so it can be safely freed by the
 *	caller.
 *
 * Side effects:
 *	A new arc item is created.
 *
 *--------------------------------------------------------------
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
		itemPtr->typePtr->name, " x1 y1 x2 y2 ?options?\"",
		(char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Carry out once-only initialization.
     */

    if (arcUid == NULL) {
	arcUid = Tk_GetUid("arc");
	chordUid = Tk_GetUid("chord");
	pieSliceUid = Tk_GetUid("pieslice");
    }

    /*
     * Carry out initialization that is needed in order to clean
     * up after errors during the the remainder of this procedure.
     */

    arcPtr->start = 0;
    arcPtr->extent = 90;
    arcPtr->outlinePtr = NULL;
    arcPtr->numOutlinePoints = 0;
    arcPtr->width = 1;
    arcPtr->outlineColor = NULL;
    arcPtr->fillColor = NULL;
    arcPtr->fillStipple = None;
    arcPtr->outlineStipple = None;
    arcPtr->style = pieSliceUid;
    arcPtr->outlineGC = None;
    arcPtr->fillGC = None;

    /*
     * Process the arguments to fill in the item record.
     */








<
<
<
<
<
<
<
<
<
<














|







205
206
207
208
209
210
211










212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
		itemPtr->typePtr->name, " x1 y1 x2 y2 ?options?\"",
		(char *) NULL);
	return TCL_ERROR;
    }











    /*
     * Carry out initialization that is needed in order to clean
     * up after errors during the the remainder of this procedure.
     */

    arcPtr->start = 0;
    arcPtr->extent = 90;
    arcPtr->outlinePtr = NULL;
    arcPtr->numOutlinePoints = 0;
    arcPtr->width = 1;
    arcPtr->outlineColor = NULL;
    arcPtr->fillColor = NULL;
    arcPtr->fillStipple = None;
    arcPtr->outlineStipple = None;
    arcPtr->style = Tk_GetUid("pieslice");
    arcPtr->outlineGC = None;
    arcPtr->fillGC = None;

    /*
     * Process the arguments to fill in the item record.
     */

272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
 * ArcCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on arcs.  See the user documentation for details
 *	on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets interp->result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */








|







254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
 * ArcCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on arcs.  See the user documentation for details
 *	on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets the interp's result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */

315
316
317
318
319
320
321

322
323
324

325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
			&arcPtr->bbox[2]) != TCL_OK)
		|| (Tk_CanvasGetCoord(interp, canvas, argv[3],
			&arcPtr->bbox[3]) != TCL_OK)) {
	    return TCL_ERROR;
	}
	ComputeArcBbox(canvas, arcPtr);
    } else {

	sprintf(interp->result,
		"wrong # coordinates: expected 0 or 4, got %d",
		argc);

	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ConfigureArc --
 *
 *	This procedure is invoked to configure various aspects
 *	of a arc item, such as its outline and fill colors.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in interp->result.
 *
 * Side effects:
 *	Configuration information, such as colors and stipple
 *	patterns, may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */







>
|
|
<
>















|







297
298
299
300
301
302
303
304
305
306

307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
			&arcPtr->bbox[2]) != TCL_OK)
		|| (Tk_CanvasGetCoord(interp, canvas, argv[3],
			&arcPtr->bbox[3]) != TCL_OK)) {
	    return TCL_ERROR;
	}
	ComputeArcBbox(canvas, arcPtr);
    } else {
	char buf[64 + TCL_INTEGER_SPACE];
	
	sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", argc);

	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ConfigureArc --
 *
 *	This procedure is invoked to configure various aspects
 *	of a arc item, such as its outline and fill colors.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in the interp's result.
 *
 * Side effects:
 *	Configuration information, such as colors and stipple
 *	patterns, may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */
377
378
379
380
381
382
383
384
385

386
387
388
389
390
391
392
393
394
395
396
    arcPtr->start -= i*360.0;
    if (arcPtr->start < 0) {
	arcPtr->start += 360.0;
    }
    i = (int) (arcPtr->extent/360.0);
    arcPtr->extent -= i*360.0;

    if ((arcPtr->style != arcUid) && (arcPtr->style != chordUid)
	    && (arcPtr->style != pieSliceUid)) {

	Tcl_AppendResult(interp, "bad -style option \"",
		arcPtr->style, "\": must be arc, chord, or pieslice",
		(char *) NULL);
	arcPtr->style = pieSliceUid;
	return TCL_ERROR;
    }

    if (arcPtr->width < 0) {
	arcPtr->width = 1;
    }
    if (arcPtr->outlineColor == NULL) {







|
|
>



|







360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
    arcPtr->start -= i*360.0;
    if (arcPtr->start < 0) {
	arcPtr->start += 360.0;
    }
    i = (int) (arcPtr->extent/360.0);
    arcPtr->extent -= i*360.0;

    if ((arcPtr->style != Tk_GetUid("arc")) 
            && (arcPtr->style != Tk_GetUid("chord"))
	    && (arcPtr->style != Tk_GetUid("pieslice"))) {
	Tcl_AppendResult(interp, "bad -style option \"",
		arcPtr->style, "\": must be arc, chord, or pieslice",
		(char *) NULL);
	arcPtr->style = Tk_GetUid("pieslice");
	return TCL_ERROR;
    }

    if (arcPtr->width < 0) {
	arcPtr->width = 1;
    }
    if (arcPtr->outlineColor == NULL) {
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
	newGC = Tk_GetGC(tkwin, mask, &gcValues);
    }
    if (arcPtr->outlineGC != None) {
	Tk_FreeGC(Tk_Display(tkwin), arcPtr->outlineGC);
    }
    arcPtr->outlineGC = newGC;

    if ((arcPtr->fillColor == NULL) || (arcPtr->style == arcUid)) {
	newGC = None;
    } else {
	gcValues.foreground = arcPtr->fillColor->pixel;
	if (arcPtr->style == chordUid) {
	    gcValues.arc_mode = ArcChord;
	} else {
	    gcValues.arc_mode = ArcPieSlice;
	}
	mask = GCForeground|GCArcMode;
	if (arcPtr->fillStipple != None) {
	    gcValues.stipple = arcPtr->fillStipple;







|



|







392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
	newGC = Tk_GetGC(tkwin, mask, &gcValues);
    }
    if (arcPtr->outlineGC != None) {
	Tk_FreeGC(Tk_Display(tkwin), arcPtr->outlineGC);
    }
    arcPtr->outlineGC = newGC;

    if ((arcPtr->fillColor == NULL) || (arcPtr->style == Tk_GetUid("arc"))) {
	newGC = None;
    } else {
	gcValues.foreground = arcPtr->fillColor->pixel;
	if (arcPtr->style == Tk_GetUid("chord")) {
	    gcValues.arc_mode = ArcChord;
	} else {
	    gcValues.arc_mode = ArcPieSlice;
	}
	mask = GCForeground|GCArcMode;
	if (arcPtr->fillStipple != None) {
	    gcValues.stipple = arcPtr->fillStipple;
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
     */

    arcPtr->header.x1 = arcPtr->header.x2 = (int) arcPtr->center1[0];
    arcPtr->header.y1 = arcPtr->header.y2 = (int) arcPtr->center1[1];
    TkIncludePoint((Tk_Item *) arcPtr, arcPtr->center2);
    center[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2;
    center[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2;
    if (arcPtr->style != arcUid) {
	TkIncludePoint((Tk_Item *) arcPtr, center);
    }

    tmp = -arcPtr->start;
    if (tmp < 0) {
	tmp += 360.0;
    }







|







525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
     */

    arcPtr->header.x1 = arcPtr->header.x2 = (int) arcPtr->center1[0];
    arcPtr->header.y1 = arcPtr->header.y2 = (int) arcPtr->center1[1];
    TkIncludePoint((Tk_Item *) arcPtr, arcPtr->center2);
    center[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2;
    center[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2;
    if (arcPtr->style == Tk_GetUid("pieslice")) {
	TkIncludePoint((Tk_Item *) arcPtr, center);
    }

    tmp = -arcPtr->start;
    if (tmp < 0) {
	tmp += 360.0;
    }
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

	if (arcPtr->width <= 2) {
	    Tk_CanvasDrawableCoords(canvas, arcPtr->center1[0],
		    arcPtr->center1[1], &x1, &y1);
	    Tk_CanvasDrawableCoords(canvas, arcPtr->center2[0],
		    arcPtr->center2[1], &x2, &y2);

	    if (arcPtr->style == chordUid) {
		XDrawLine(display, drawable, arcPtr->outlineGC,
			x1, y1, x2, y2);
	    } else if (arcPtr->style == pieSliceUid) {
		short cx, cy;

		Tk_CanvasDrawableCoords(canvas,
			(arcPtr->bbox[0] + arcPtr->bbox[2])/2.0,
			(arcPtr->bbox[1] + arcPtr->bbox[3])/2.0, &cx, &cy);
		XDrawLine(display, drawable, arcPtr->outlineGC,
			cx, cy, x1, y1);
		XDrawLine(display, drawable, arcPtr->outlineGC,
			cx, cy, x2, y2);
	    }
	} else {
	    if (arcPtr->style == chordUid) {
		TkFillPolygon(canvas, arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
			display, drawable, arcPtr->outlineGC, None);
	    } else if (arcPtr->style == pieSliceUid) {
		TkFillPolygon(canvas, arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
			display, drawable, arcPtr->outlineGC, None);
		TkFillPolygon(canvas, arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
			PIE_OUTLINE2_PTS, display, drawable, arcPtr->outlineGC,
			None);
	    }
	}







|


|











|


|







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

	if (arcPtr->width <= 2) {
	    Tk_CanvasDrawableCoords(canvas, arcPtr->center1[0],
		    arcPtr->center1[1], &x1, &y1);
	    Tk_CanvasDrawableCoords(canvas, arcPtr->center2[0],
		    arcPtr->center2[1], &x2, &y2);

	    if (arcPtr->style == Tk_GetUid("chord")) {
		XDrawLine(display, drawable, arcPtr->outlineGC,
			x1, y1, x2, y2);
	    } else if (arcPtr->style == Tk_GetUid("pieslice")) {
		short cx, cy;

		Tk_CanvasDrawableCoords(canvas,
			(arcPtr->bbox[0] + arcPtr->bbox[2])/2.0,
			(arcPtr->bbox[1] + arcPtr->bbox[3])/2.0, &cx, &cy);
		XDrawLine(display, drawable, arcPtr->outlineGC,
			cx, cy, x1, y1);
		XDrawLine(display, drawable, arcPtr->outlineGC,
			cx, cy, x2, y2);
	    }
	} else {
	    if (arcPtr->style == Tk_GetUid("chord")) {
		TkFillPolygon(canvas, arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
			display, drawable, arcPtr->outlineGC, None);
	    } else if (arcPtr->style == Tk_GetUid("pieslice")) {
		TkFillPolygon(canvas, arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
			display, drawable, arcPtr->outlineGC, None);
		TkFillPolygon(canvas, arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
			PIE_OUTLINE2_PTS, display, drawable, arcPtr->outlineGC,
			None);
	    }
	}
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
	    ((arcPtr->extent < 0) && ((diff - 360.0) >= arcPtr->extent));

    /*
     * Now perform different tests depending on what kind of arc
     * we're dealing with.
     */

    if (arcPtr->style == arcUid) {
	if (angleInRange) {
	    return TkOvalToPoint(arcPtr->bbox, (double) arcPtr->width,
		    0, pointPtr);
	}
	dist = hypot(pointPtr[0] - arcPtr->center1[0],
		pointPtr[1] - arcPtr->center1[1]);
	newDist = hypot(pointPtr[0] - arcPtr->center2[0],







|







765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
	    ((arcPtr->extent < 0) && ((diff - 360.0) >= arcPtr->extent));

    /*
     * Now perform different tests depending on what kind of arc
     * we're dealing with.
     */

    if (arcPtr->style == Tk_GetUid("arc")) {
	if (angleInRange) {
	    return TkOvalToPoint(arcPtr->bbox, (double) arcPtr->width,
		    0, pointPtr);
	}
	dist = hypot(pointPtr[0] - arcPtr->center1[0],
		pointPtr[1] - arcPtr->center1[1]);
	newDist = hypot(pointPtr[0] - arcPtr->center2[0],
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
    }
    if (arcPtr->outlineGC == None) {
	width = 0.0;
    } else {
	width = arcPtr->width;
    }

    if (arcPtr->style == pieSliceUid) {
	if (width > 1.0) {
	    dist = TkPolygonToPoint(arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
		    pointPtr);
	    newDist = TkPolygonToPoint(arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
			PIE_OUTLINE2_PTS, pointPtr);
	} else {
	    dist = TkLineToPoint(vertex, arcPtr->center1, pointPtr);







|







791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
    }
    if (arcPtr->outlineGC == None) {
	width = 0.0;
    } else {
	width = arcPtr->width;
    }

    if (arcPtr->style == Tk_GetUid("pieslice")) {
	if (width > 1.0) {
	    dist = TkPolygonToPoint(arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
		    pointPtr);
	    newDist = TkPolygonToPoint(arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
			PIE_OUTLINE2_PTS, pointPtr);
	} else {
	    dist = TkLineToPoint(vertex, arcPtr->center1, pointPtr);
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
    pointPtr[1] = ry*sin(angle);
    angle += -arcPtr->extent*(PI/180.0);
    pointPtr[2] = rx*cos(angle);
    pointPtr[3] = ry*sin(angle);
    numPoints = 2;
    pointPtr += 4;

    if ((arcPtr->style == pieSliceUid) && (arcPtr->extent < 180.0)) {
	pointPtr[0] = 0.0;
	pointPtr[1] = 0.0;
	numPoints++;
	pointPtr += 2;
    }

    tmp = -arcPtr->start;







|







946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
    pointPtr[1] = ry*sin(angle);
    angle += -arcPtr->extent*(PI/180.0);
    pointPtr[2] = rx*cos(angle);
    pointPtr[3] = ry*sin(angle);
    numPoints = 2;
    pointPtr += 4;

    if ((arcPtr->style == Tk_GetUid("pieslice")) && (arcPtr->extent < 180.0)) {
	pointPtr[0] = 0.0;
	pointPtr[1] = 0.0;
	numPoints++;
	pointPtr += 2;
    }

    tmp = -arcPtr->start;
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
     * So far, oval appears to be outside rectangle, but can't yet tell
     * for sure.  Next, test each of the four sides of the rectangle
     * against the bounding region for the arc.  If any intersections
     * are found, then return "overlapping".  First, test against the
     * polygon(s) forming the sides of a chord or pie-slice.
     */

    if (arcPtr->style == pieSliceUid) {
	if (width >= 1.0) {
	    if (TkPolygonToArea(arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
		    rectPtr) != -1)  {
		return 0;
	    }
	    if (TkPolygonToArea(arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
		    PIE_OUTLINE2_PTS, rectPtr) != -1) {
		return 0;
	    }
	} else {
	    if ((TkLineToArea(center, arcPtr->center1, rectPtr) != -1) ||
		    (TkLineToArea(center, arcPtr->center2, rectPtr) != -1)) {
		return 0;
	    }
	}
    } else if (arcPtr->style == chordUid) {
	if (width >= 1.0) {
	    if (TkPolygonToArea(arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
		    rectPtr) != -1) {
		return 0;
	    }
	} else {
	    if (TkLineToArea(arcPtr->center1, arcPtr->center2,







|















|







1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
     * So far, oval appears to be outside rectangle, but can't yet tell
     * for sure.  Next, test each of the four sides of the rectangle
     * against the bounding region for the arc.  If any intersections
     * are found, then return "overlapping".  First, test against the
     * polygon(s) forming the sides of a chord or pie-slice.
     */

    if (arcPtr->style == Tk_GetUid("pieslice")) {
	if (width >= 1.0) {
	    if (TkPolygonToArea(arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
		    rectPtr) != -1)  {
		return 0;
	    }
	    if (TkPolygonToArea(arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
		    PIE_OUTLINE2_PTS, rectPtr) != -1) {
		return 0;
	    }
	} else {
	    if ((TkLineToArea(center, arcPtr->center1, rectPtr) != -1) ||
		    (TkLineToArea(center, arcPtr->center2, rectPtr) != -1)) {
		return 0;
	    }
	}
    } else if (arcPtr->style == Tk_GetUid("chord")) {
	if (width >= 1.0) {
	    if (TkPolygonToArea(arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
		    rectPtr) != -1) {
		return 0;
	    }
	} else {
	    if (TkLineToArea(arcPtr->center1, arcPtr->center2,
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
    /*
     * For a chord outline, generate a six-sided polygon with three
     * points for each end of the chord.  The first and third points
     * for each end are butt points generated on either side of the
     * center point.  The second point is the corner point.
     */

    if (arcPtr->style == chordUid) {
	outlinePtr[0] = outlinePtr[12] = corner1[0];
	outlinePtr[1] = outlinePtr[13] = corner1[1];
	TkGetButtPoints(arcPtr->center2, arcPtr->center1,
		(double) arcPtr->width, 0, outlinePtr+10, outlinePtr+2);
	outlinePtr[4] = arcPtr->center2[0] + outlinePtr[2]
		- arcPtr->center1[0];
	outlinePtr[5] = arcPtr->center2[1] + outlinePtr[3]
		- arcPtr->center1[1];
	outlinePtr[6] = corner2[0];
	outlinePtr[7] = corner2[1];
	outlinePtr[8] = arcPtr->center2[0] + outlinePtr[10]
		- arcPtr->center1[0];
	outlinePtr[9] = arcPtr->center2[1] + outlinePtr[11]
		- arcPtr->center1[1];
    } else if (arcPtr->style == pieSliceUid) {
	/*
	 * For pie slices, generate two polygons, one for each side
	 * of the pie slice.  The first arm has a shape like this,
	 * where the center of the oval is X, arcPtr->center1 is at Y, and
	 * corner1 is at Z:
	 *
	 *	 _____________________







|














|







1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
    /*
     * For a chord outline, generate a six-sided polygon with three
     * points for each end of the chord.  The first and third points
     * for each end are butt points generated on either side of the
     * center point.  The second point is the corner point.
     */

    if (arcPtr->style == Tk_GetUid("chord")) {
	outlinePtr[0] = outlinePtr[12] = corner1[0];
	outlinePtr[1] = outlinePtr[13] = corner1[1];
	TkGetButtPoints(arcPtr->center2, arcPtr->center1,
		(double) arcPtr->width, 0, outlinePtr+10, outlinePtr+2);
	outlinePtr[4] = arcPtr->center2[0] + outlinePtr[2]
		- arcPtr->center1[0];
	outlinePtr[5] = arcPtr->center2[1] + outlinePtr[3]
		- arcPtr->center1[1];
	outlinePtr[6] = corner2[0];
	outlinePtr[7] = corner2[1];
	outlinePtr[8] = arcPtr->center2[0] + outlinePtr[10]
		- arcPtr->center1[0];
	outlinePtr[9] = arcPtr->center2[1] + outlinePtr[11]
		- arcPtr->center1[1];
    } else if (arcPtr->style == Tk_GetUid("pieslice")) {
	/*
	 * For pie slices, generate two polygons, one for each side
	 * of the pie slice.  The first arm has a shape like this,
	 * where the center of the oval is X, arcPtr->center1 is at Y, and
	 * corner1 is at Z:
	 *
	 *	 _____________________
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
 *
 *	This procedure is called to generate Postscript for
 *	arc items.
 *
 * Results:
 *	The return value is a standard Tcl result.  If an error
 *	occurs in generating Postscript then an error message is
 *	left in interp->result, replacing whatever used
 *	to be there.  If no error occurs, then Postscript for the
 *	item is appended to the result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------







|







1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
 *
 *	This procedure is called to generate Postscript for
 *	arc items.
 *
 * Results:
 *	The return value is a standard Tcl result.  If an error
 *	occurs in generating Postscript then an error message is
 *	left in the interp's result, replacing whatever used
 *	to be there.  If no error occurs, then Postscript for the
 *	item is appended to the result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
     */

    if (arcPtr->fillGC != None) {
	sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n",
		(arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2,
		(arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2);
	Tcl_AppendResult(interp, buffer, (char *) NULL);
	if (arcPtr->style == chordUid) {
	    sprintf(buffer, "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n",
		    ang1, ang2);
	} else {
	    sprintf(buffer,
		    "0 0 moveto 0 0 1 %.15g %.15g arc closepath\nsetmatrix\n",
		    ang1, ang2);
	}







|







1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
     */

    if (arcPtr->fillGC != None) {
	sprintf(buffer, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale\n",
		(arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2,
		(arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2);
	Tcl_AppendResult(interp, buffer, (char *) NULL);
	if (arcPtr->style == Tk_GetUid("chord")) {
	    sprintf(buffer, "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n",
		    ang1, ang2);
	} else {
	    sprintf(buffer,
		    "0 0 moveto 0 0 1 %.15g %.15g arc closepath\nsetmatrix\n",
		    ang1, ang2);
	}
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
	    if (Tk_CanvasPsStipple(interp, canvas,
		    arcPtr->outlineStipple) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
	}
	if (arcPtr->style != arcUid) {
	    Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
	    if (arcPtr->style == chordUid) {
		Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr,
			CHORD_OUTLINE_PTS);
	    } else {
		Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr,
			PIE_OUTLINE1_PTS);
		if (Tk_CanvasPsColor(interp, canvas, arcPtr->outlineColor)
			!= TCL_OK) {







|

|







1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
	    if (Tk_CanvasPsStipple(interp, canvas,
		    arcPtr->outlineStipple) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
	}
	if (arcPtr->style != Tk_GetUid("arc")) {
	    Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
	    if (arcPtr->style == Tk_GetUid("chord")) {
		Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr,
			CHORD_OUTLINE_PTS);
	    } else {
		Tk_CanvasPsPath(interp, canvas, arcPtr->outlinePtr,
			PIE_OUTLINE1_PTS);
		if (Tk_CanvasPsColor(interp, canvas, arcPtr->outlineColor)
			!= TCL_OK) {

Changes to generic/tkCanvBmap.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkCanvBmap.c --
 *
 *	This file implements bitmap items for canvas widgets.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkCanvBmap.c 1.30 96/05/03 10:49:00
 */

#include <stdio.h>
#include "tkInt.h"
#include "tkPort.h"
#include "tkCanvas.h"







|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkCanvBmap.c --
 *
 *	This file implements bitmap items for canvas widgets.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkCanvBmap.c,v 1.1.4.2 1998/09/30 02:16:42 stanton Exp $
 */

#include <stdio.h>
#include "tkInt.h"
#include "tkPort.h"
#include "tkCanvas.h"

125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
 *
 *	This procedure is invoked to create a new bitmap
 *	item in a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item, then an error message is left in
 *	interp->result;  in this case itemPtr is left uninitialized,
 *	so it can be safely freed by the caller.
 *
 * Side effects:
 *	A new bitmap item is created.
 *
 *--------------------------------------------------------------
 */







|







125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
 *
 *	This procedure is invoked to create a new bitmap
 *	item in a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item, then an error message is left in
 *	the interp's result;  in this case itemPtr is left uninitialized,
 *	so it can be safely freed by the caller.
 *
 * Side effects:
 *	A new bitmap item is created.
 *
 *--------------------------------------------------------------
 */
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
 * BitmapCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on bitmap items.  See the user documentation for
 *	details on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets interp->result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */








|







190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
 * BitmapCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on bitmap items.  See the user documentation for
 *	details on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets the interp's result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */

224
225
226
227
228
229
230

231
232

233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
	if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &bmapPtr->x) != TCL_OK)
		|| (Tk_CanvasGetCoord(interp, canvas, argv[1], &bmapPtr->y)
		    != TCL_OK)) {
	    return TCL_ERROR;
	}
	ComputeBitmapBbox(canvas, bmapPtr);
    } else {

	sprintf(interp->result,
		"wrong # coordinates: expected 0 or 2, got %d", argc);

	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ConfigureBitmap --
 *
 *	This procedure is invoked to configure various aspects
 *	of a bitmap item, such as its anchor position.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in interp->result.
 *
 * Side effects:
 *	Configuration information may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */








>
|
|
>















|







224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
	if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &bmapPtr->x) != TCL_OK)
		|| (Tk_CanvasGetCoord(interp, canvas, argv[1], &bmapPtr->y)
		    != TCL_OK)) {
	    return TCL_ERROR;
	}
	ComputeBitmapBbox(canvas, bmapPtr);
    } else {
	char buf[64 + TCL_INTEGER_SPACE];

	sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ConfigureBitmap --
 *
 *	This procedure is invoked to configure various aspects
 *	of a bitmap item, such as its anchor position.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in the interp's result.
 *
 * Side effects:
 *	Configuration information may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */

686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
 *
 *	This procedure is called to generate Postscript for
 *	bitmap items.
 *
 * Results:
 *	The return value is a standard Tcl result.  If an error
 *	occurs in generating Postscript then an error message is
 *	left in interp->result, replacing whatever used to be there.
 *	If no error occurs, then Postscript for the item is appended
 *	to the result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------







|







688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
 *
 *	This procedure is called to generate Postscript for
 *	bitmap items.
 *
 * Results:
 *	The return value is a standard Tcl result.  If an error
 *	occurs in generating Postscript then an error message is
 *	left in the interp's result, replacing whatever used to be there.
 *	If no error occurs, then Postscript for the item is appended
 *	to the result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
					 * collect font information;  0 means
					 * final Postscript is being created. */
{
    BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
    double x, y;
    int width, height, rowsAtOnce, rowsThisTime;
    int curRow;
    char buffer[200];

    if (bmapPtr->bitmap == None) {
	return TCL_OK;
    }

    /*
     * Compute the coordinates of the lower-left corner of the bitmap,







|







713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
					 * collect font information;  0 means
					 * final Postscript is being created. */
{
    BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
    double x, y;
    int width, height, rowsAtOnce, rowsThisTime;
    int curRow;
    char buffer[100 + TCL_DOUBLE_SPACE * 2 + TCL_INTEGER_SPACE * 4];

    if (bmapPtr->bitmap == None) {
	return TCL_OK;
    }

    /*
     * Compute the coordinates of the lower-left corner of the bitmap,
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
    /*
     * Color the background, if there is one.
     */

    if (bmapPtr->bgColor != NULL) {
	sprintf(buffer,
		"%.15g %.15g moveto %d 0 rlineto 0 %d rlineto %d %s\n",
		x, y, width, height, -width,"0 rlineto closepath");
	Tcl_AppendResult(interp, buffer, (char *) NULL);
	if (Tk_CanvasPsColor(interp, canvas, bmapPtr->bgColor) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_AppendResult(interp, "fill\n", (char *) NULL);
    }








|







747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
    /*
     * Color the background, if there is one.
     */

    if (bmapPtr->bgColor != NULL) {
	sprintf(buffer,
		"%.15g %.15g moveto %d 0 rlineto 0 %d rlineto %d %s\n",
		x, y, width, height, -width, "0 rlineto closepath");
	Tcl_AppendResult(interp, buffer, (char *) NULL);
	if (Tk_CanvasPsColor(interp, canvas, bmapPtr->bgColor) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_AppendResult(interp, "fill\n", (char *) NULL);
    }

Changes to generic/tkCanvImg.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkCanvImg.c --
 *
 *	This file implements image items for canvas widgets.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkCanvImg.c 1.18 96/05/03 10:49:09
 */

#include <stdio.h>
#include "tkInt.h"
#include "tkPort.h"
#include "tkCanvas.h"







|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkCanvImg.c --
 *
 *	This file implements image items for canvas widgets.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkCanvImg.c,v 1.1.4.2 1998/09/30 02:16:43 stanton Exp $
 */

#include <stdio.h>
#include "tkInt.h"
#include "tkPort.h"
#include "tkCanvas.h"

122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
 *
 *	This procedure is invoked to create a new image
 *	item in a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item, then an error message is left in
 *	interp->result;  in this case itemPtr is left uninitialized,
 *	so it can be safely freed by the caller.
 *
 * Side effects:
 *	A new image item is created.
 *
 *--------------------------------------------------------------
 */







|







122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
 *
 *	This procedure is invoked to create a new image
 *	item in a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item, then an error message is left in
 *	the interp's result;  in this case itemPtr is left uninitialized,
 *	so it can be safely freed by the caller.
 *
 * Side effects:
 *	A new image item is created.
 *
 *--------------------------------------------------------------
 */
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
 * ImageCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on image items.  See the user documentation for
 *	details on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets interp->result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */








|







186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
 * ImageCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on image items.  See the user documentation for
 *	details on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets the interp's result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */

220
221
222
223
224
225
226

227
228

229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
	if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &imgPtr->x) != TCL_OK)
		|| (Tk_CanvasGetCoord(interp, canvas, argv[1],
		    &imgPtr->y) != TCL_OK)) {
	    return TCL_ERROR;
	}
	ComputeImageBbox(canvas, imgPtr);
    } else {

	sprintf(interp->result,
		"wrong # coordinates: expected 0 or 2, got %d", argc);

	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ConfigureImage --
 *
 *	This procedure is invoked to configure various aspects
 *	of an image item, such as its anchor position.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in interp->result.
 *
 * Side effects:
 *	Configuration information may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */








>
|
|
>















|







220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
	if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &imgPtr->x) != TCL_OK)
		|| (Tk_CanvasGetCoord(interp, canvas, argv[1],
		    &imgPtr->y) != TCL_OK)) {
	    return TCL_ERROR;
	}
	ComputeImageBbox(canvas, imgPtr);
    } else {
	char buf[64];
	
	sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ConfigureImage --
 *
 *	This procedure is invoked to configure various aspects
 *	of an image item, such as its anchor position.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in the interp's result.
 *
 * Side effects:
 *	Configuration information may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */

Changes to generic/tkCanvLine.c.

1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkCanvLine.c --
 *
 *	This file implements line items for canvas widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkCanvLine.c 1.46 97/04/25 16:51:02
 */

#include <stdio.h>
#include "tkInt.h"
#include "tkPort.h"

/*






|
>




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkCanvLine.c --
 *
 *	This file implements line items for canvas widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkCanvLine.c,v 1.1.4.5 1999/02/16 11:39:30 lfb Exp $
 */

#include <stdio.h>
#include "tkInt.h"
#include "tkPort.h"

/*
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
    (Tk_ItemCursorProc *) NULL,		/* icursorProc */
    (Tk_ItemSelectionProc *) NULL,	/* selectionProc */
    (Tk_ItemInsertProc *) NULL,		/* insertProc */
    (Tk_ItemDCharsProc *) NULL,		/* dTextProc */
    (Tk_ItemType *) NULL		/* nextPtr */
};

/*
 * The Tk_Uid's below refer to uids for the various arrow types:
 */

static Tk_Uid noneUid = NULL;
static Tk_Uid firstUid = NULL;
static Tk_Uid lastUid = NULL;
static Tk_Uid bothUid = NULL;

/*
 * The definition below determines how large are static arrays
 * used to hold spline points (splines larger than this have to
 * have their arrays malloc-ed).
 */

#define MAX_STATIC_POINTS 200

/*
 *--------------------------------------------------------------
 *
 * CreateLine --
 *
 *	This procedure is invoked to create a new line item in
 *	a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item, then an error message is left in
 *	interp->result;  in this case itemPtr is left uninitialized,
 *	so it can be safely freed by the caller.
 *
 * Side effects:
 *	A new line item is created.
 *
 *--------------------------------------------------------------
 */







<
<
<
<
<
<
<
<
<



















|







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
    (Tk_ItemCursorProc *) NULL,		/* icursorProc */
    (Tk_ItemSelectionProc *) NULL,	/* selectionProc */
    (Tk_ItemInsertProc *) NULL,		/* insertProc */
    (Tk_ItemDCharsProc *) NULL,		/* dTextProc */
    (Tk_ItemType *) NULL		/* nextPtr */
};










/*
 * The definition below determines how large are static arrays
 * used to hold spline points (splines larger than this have to
 * have their arrays malloc-ed).
 */

#define MAX_STATIC_POINTS 200

/*
 *--------------------------------------------------------------
 *
 * CreateLine --
 *
 *	This procedure is invoked to create a new line item in
 *	a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item, then an error message is left in
 *	the interp's result;  in this case itemPtr is left uninitialized,
 *	so it can be safely freed by the caller.
 *
 * Side effects:
 *	A new line item is created.
 *
 *--------------------------------------------------------------
 */
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
    linePtr->width = 1;
    linePtr->fg = None;
    linePtr->fillStipple = None;
    linePtr->capStyle = CapButt;
    linePtr->joinStyle = JoinRound;
    linePtr->gc = None;
    linePtr->arrowGC = None;
    if (noneUid == NULL) {
	noneUid = Tk_GetUid("none");
	firstUid = Tk_GetUid("first");
	lastUid = Tk_GetUid("last");
	bothUid = Tk_GetUid("both");
    }
    linePtr->arrow = noneUid;
    linePtr->arrowShapeA = (float)8.0;
    linePtr->arrowShapeB = (float)10.0;
    linePtr->arrowShapeC = (float)3.0;
    linePtr->firstArrowPtr = NULL;
    linePtr->lastArrowPtr = NULL;
    linePtr->smooth = 0;
    linePtr->splineSteps = 12;







<
<
<
<
<
<
|







240
241
242
243
244
245
246






247
248
249
250
251
252
253
254
    linePtr->width = 1;
    linePtr->fg = None;
    linePtr->fillStipple = None;
    linePtr->capStyle = CapButt;
    linePtr->joinStyle = JoinRound;
    linePtr->gc = None;
    linePtr->arrowGC = None;






    linePtr->arrow = Tk_GetUid("none");
    linePtr->arrowShapeA = (float)8.0;
    linePtr->arrowShapeB = (float)10.0;
    linePtr->arrowShapeC = (float)3.0;
    linePtr->firstArrowPtr = NULL;
    linePtr->lastArrowPtr = NULL;
    linePtr->smooth = 0;
    linePtr->splineSteps = 12;
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
 * LineCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on lines.  See the user documentation for details
 *	on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets interp->result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */








|







284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
 * LineCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on lines.  See the user documentation for details
 *	on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets the interp's result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */

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
	    ckfree((char *) linePtr->firstArrowPtr);
	    linePtr->firstArrowPtr = NULL;
	}
	if (linePtr->lastArrowPtr != NULL) {
	    ckfree((char *) linePtr->lastArrowPtr);
	    linePtr->lastArrowPtr = NULL;
	}
	if (linePtr->arrow != noneUid) {
	    ConfigureArrows(canvas, linePtr);
	}
	ComputeLineBbox(canvas, linePtr);
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ConfigureLine --
 *
 *	This procedure is invoked to configure various aspects
 *	of a line item such as its background color.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in interp->result.
 *
 * Side effects:
 *	Configuration information, such as colors and stipple
 *	patterns, may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */







|

















|







367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
	    ckfree((char *) linePtr->firstArrowPtr);
	    linePtr->firstArrowPtr = NULL;
	}
	if (linePtr->lastArrowPtr != NULL) {
	    ckfree((char *) linePtr->lastArrowPtr);
	    linePtr->lastArrowPtr = NULL;
	}
	if (linePtr->arrow != Tk_GetUid("none")) {
	    ConfigureArrows(canvas, linePtr);
	}
	ComputeLineBbox(canvas, linePtr);
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ConfigureLine --
 *
 *	This procedure is invoked to configure various aspects
 *	of a line item such as its background color.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in the interp's result.
 *
 * Side effects:
 *	Configuration information, such as colors and stipple
 *	patterns, may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */
422
423
424
425
426
427
428




429
430
431
432
433
434
435
    int flags;			/* Flags to pass to Tk_ConfigureWidget. */
{
    LineItem *linePtr = (LineItem *) itemPtr;
    XGCValues gcValues;
    GC newGC, arrowGC;
    unsigned long mask;
    Tk_Window tkwin;





    tkwin = Tk_CanvasTkwin(canvas);
    if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
	    (char *) linePtr, flags) != TCL_OK) {
	return TCL_ERROR;
    }








>
>
>
>







408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
    int flags;			/* Flags to pass to Tk_ConfigureWidget. */
{
    LineItem *linePtr = (LineItem *) itemPtr;
    XGCValues gcValues;
    GC newGC, arrowGC;
    unsigned long mask;
    Tk_Window tkwin;
    Tk_Uid noneUid = Tk_GetUid("none");
    Tk_Uid bothUid = Tk_GetUid("both");
    Tk_Uid firstUid = Tk_GetUid("first");
    Tk_Uid lastUid = Tk_GetUid("last");

    tkwin = Tk_CanvasTkwin(canvas);
    if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
	    (char *) linePtr, flags) != TCL_OK) {
	return TCL_ERROR;
    }

489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
    if ((linePtr->firstArrowPtr != NULL) && (linePtr->arrow != firstUid)
	    && (linePtr->arrow != bothUid)) {
	linePtr->coordPtr[0] = linePtr->firstArrowPtr[0];
	linePtr->coordPtr[1] = linePtr->firstArrowPtr[1];
	ckfree((char *) linePtr->firstArrowPtr);
	linePtr->firstArrowPtr = NULL;
    }
    if ((linePtr->lastArrowPtr != NULL) && (linePtr->arrow != lastUid)
	    && (linePtr->arrow != bothUid)) {
	int i;

	i = 2*(linePtr->numPoints-1);
	linePtr->coordPtr[i] = linePtr->lastArrowPtr[0];
	linePtr->coordPtr[i+1] = linePtr->lastArrowPtr[1];
	ckfree((char *) linePtr->lastArrowPtr);
	linePtr->lastArrowPtr = NULL;
    }
    if (linePtr->arrow != noneUid) {
	if ((linePtr->arrow != firstUid) && (linePtr->arrow != lastUid)
		&& (linePtr->arrow != bothUid)) {
	    Tcl_AppendResult(interp, "bad arrow spec \"",
		    linePtr->arrow, "\": must be none, first, last, or both",
		    (char *) NULL);
	    linePtr->arrow = noneUid;
	    return TCL_ERROR;
	}
	ConfigureArrows(canvas, linePtr);







|
|










|







479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
    if ((linePtr->firstArrowPtr != NULL) && (linePtr->arrow != firstUid)
	    && (linePtr->arrow != bothUid)) {
	linePtr->coordPtr[0] = linePtr->firstArrowPtr[0];
	linePtr->coordPtr[1] = linePtr->firstArrowPtr[1];
	ckfree((char *) linePtr->firstArrowPtr);
	linePtr->firstArrowPtr = NULL;
    }
    if ((linePtr->lastArrowPtr != NULL) && (linePtr->arrow != lastUid) 
            && (linePtr->arrow != bothUid)) {
	int i;

	i = 2*(linePtr->numPoints-1);
	linePtr->coordPtr[i] = linePtr->lastArrowPtr[0];
	linePtr->coordPtr[i+1] = linePtr->lastArrowPtr[1];
	ckfree((char *) linePtr->lastArrowPtr);
	linePtr->lastArrowPtr = NULL;
    }
    if (linePtr->arrow != noneUid) {
	if ((linePtr->arrow != firstUid) && (linePtr->arrow != lastUid)
       	        && (linePtr->arrow != bothUid)) {
	    Tcl_AppendResult(interp, "bad arrow spec \"",
		    linePtr->arrow, "\": must be none, first, last, or both",
		    (char *) NULL);
	    linePtr->arrow = noneUid;
	    return TCL_ERROR;
	}
	ConfigureArrows(canvas, linePtr);
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
	}
    }

    /*
     * Add in the sizes of arrowheads, if any.
     */

    if (linePtr->arrow != noneUid) {
	if (linePtr->arrow != lastUid) {
	    for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
		    i++, coordPtr += 2) {
		TkIncludePoint((Tk_Item *) linePtr, coordPtr);
	    }
	}
	if (linePtr->arrow != firstUid) {
	    for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
		    i++, coordPtr += 2) {
		TkIncludePoint((Tk_Item *) linePtr, coordPtr);
	    }
	}
    }








|
|





|







638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
	}
    }

    /*
     * Add in the sizes of arrowheads, if any.
     */

    if (linePtr->arrow != Tk_GetUid("none")) {
	if (linePtr->arrow != Tk_GetUid("last")) {
	    for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
		    i++, coordPtr += 2) {
		TkIncludePoint((Tk_Item *) linePtr, coordPtr);
	    }
	}
	if (linePtr->arrow != Tk_GetUid("first")) {
	    for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
		    i++, coordPtr += 2) {
		TkIncludePoint((Tk_Item *) linePtr, coordPtr);
	    }
	}
    }

810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
    Tk_Item *itemPtr;		/* Item to check against point. */
    double *pointPtr;		/* Pointer to x and y coordinates. */
{
    LineItem *linePtr = (LineItem *) itemPtr;
    double *coordPtr, *linePoints;
    double staticSpace[2*MAX_STATIC_POINTS];
    double poly[10];
    double bestDist, dist;
    int numPoints, count;
    int changedMiterToBevel;	/* Non-zero means that a mitered corner
				 * had to be treated as beveled after all
				 * because the angle was < 11 degrees. */

    bestDist = 1.0e36;








|







800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
    Tk_Item *itemPtr;		/* Item to check against point. */
    double *pointPtr;		/* Pointer to x and y coordinates. */
{
    LineItem *linePtr = (LineItem *) itemPtr;
    double *coordPtr, *linePoints;
    double staticSpace[2*MAX_STATIC_POINTS];
    double poly[10];
    double bestDist, dist, width;
    int numPoints, count;
    int changedMiterToBevel;	/* Non-zero means that a mitered corner
				 * had to be treated as beveled after all
				 * because the angle was < 11 degrees. */

    bestDist = 1.0e36;

838
839
840
841
842
843
844





845
846
847
848
849
850
851
	numPoints = TkMakeBezierCurve(canvas, linePtr->coordPtr,
		linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
		linePoints);
    } else {
	numPoints = linePtr->numPoints;
	linePoints = linePtr->coordPtr;
    }






    /*
     * The overall idea is to iterate through all of the edges of
     * the line, computing a polygon for each edge and testing the
     * point against that polygon.  In addition, there are additional
     * tests to deal with rounded joints and caps.
     */







>
>
>
>
>







828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
	numPoints = TkMakeBezierCurve(canvas, linePtr->coordPtr,
		linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
		linePoints);
    } else {
	numPoints = linePtr->numPoints;
	linePoints = linePtr->coordPtr;
    }

    width = (double) linePtr->width;
    if (width < 1.0) {
	width = 1.0;
    }

    /*
     * The overall idea is to iterate through all of the edges of
     * the line, computing a polygon for each edge and testing the
     * point against that polygon.  In addition, there are additional
     * tests to deal with rounded joints and caps.
     */
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
	 * the distance between the point and the point.
	 */

	if (((linePtr->capStyle == CapRound) && (count == numPoints))
		|| ((linePtr->joinStyle == JoinRound)
			&& (count != numPoints))) {
	    dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
		    - linePtr->width/2.0;
	    if (dist <= 0.0) {
		bestDist = 0.0;
		goto done;
	    } else if (dist < bestDist) {
		bestDist = dist;
	    }
	}

	/*
	 * Compute the polygonal shape corresponding to this edge,
	 * consisting of two points for the first point of the edge
	 * and two points for the last point of the edge.
	 */

	if (count == numPoints) {
	    TkGetButtPoints(coordPtr+2, coordPtr, (double) linePtr->width,
		    linePtr->capStyle == CapProjecting, poly, poly+2);
	} else if ((linePtr->joinStyle == JoinMiter) && !changedMiterToBevel) {
	    poly[0] = poly[6];
	    poly[1] = poly[7];
	    poly[2] = poly[4];
	    poly[3] = poly[5];
	} else {
	    TkGetButtPoints(coordPtr+2, coordPtr, (double) linePtr->width, 0,
		    poly, poly+2);

	    /*
	     * If this line uses beveled joints, then check the distance
	     * to a polygon comprising the last two points of the previous
	     * polygon and the first two from this polygon;  this checks
	     * the wedges that fill the mitered joint.







|















|







|







854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
	 * the distance between the point and the point.
	 */

	if (((linePtr->capStyle == CapRound) && (count == numPoints))
		|| ((linePtr->joinStyle == JoinRound)
			&& (count != numPoints))) {
	    dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
		    - width/2.0;
	    if (dist <= 0.0) {
		bestDist = 0.0;
		goto done;
	    } else if (dist < bestDist) {
		bestDist = dist;
	    }
	}

	/*
	 * Compute the polygonal shape corresponding to this edge,
	 * consisting of two points for the first point of the edge
	 * and two points for the last point of the edge.
	 */

	if (count == numPoints) {
	    TkGetButtPoints(coordPtr+2, coordPtr, width,
		    linePtr->capStyle == CapProjecting, poly, poly+2);
	} else if ((linePtr->joinStyle == JoinMiter) && !changedMiterToBevel) {
	    poly[0] = poly[6];
	    poly[1] = poly[7];
	    poly[2] = poly[4];
	    poly[3] = poly[5];
	} else {
	    TkGetButtPoints(coordPtr+2, coordPtr, width, 0,
		    poly, poly+2);

	    /*
	     * If this line uses beveled joints, then check the distance
	     * to a polygon comprising the last two points of the previous
	     * polygon and the first two from this polygon;  this checks
	     * the wedges that fill the mitered joint.
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
		} else if (dist < bestDist) {
		    bestDist = dist;
		}
		changedMiterToBevel = 0;
	    }
	}
	if (count == 2) {
	    TkGetButtPoints(coordPtr, coordPtr+2, (double) linePtr->width,
		    linePtr->capStyle == CapProjecting, poly+4, poly+6);
	} else if (linePtr->joinStyle == JoinMiter) {
	    if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
		    (double) linePtr->width, poly+4, poly+6) == 0) {
		changedMiterToBevel = 1;
		TkGetButtPoints(coordPtr, coordPtr+2, (double) linePtr->width,
			0, poly+4, poly+6);
	    }
	} else {
	    TkGetButtPoints(coordPtr, coordPtr+2, (double) linePtr->width, 0,
		    poly+4, poly+6);
	}
	poly[8] = poly[0];
	poly[9] = poly[1];
	dist = TkPolygonToPoint(poly, 5, pointPtr);
	if (dist <= 0.0) {
	    bestDist = 0.0;
	    goto done;
	} else if (dist < bestDist) {
	    bestDist = dist;
	}
    }

    /*
     * If caps are rounded, check the distance to the cap around the
     * final end point of the line.
     */

    if (linePtr->capStyle == CapRound) {
	dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
		- linePtr->width/2.0;
	if (dist <= 0.0) {
	    bestDist = 0.0;
	    goto done;
	} else if (dist < bestDist) {
	    bestDist = dist;
	}
    }

    /*
     * If there are arrowheads, check the distance to the arrowheads.
     */

    if (linePtr->arrow != noneUid) {
	if (linePtr->arrow != lastUid) {
	    dist = TkPolygonToPoint(linePtr->firstArrowPtr, PTS_IN_ARROW,
		    pointPtr);
	    if (dist <= 0.0) {
		bestDist = 0.0;
		goto done;
	    } else if (dist < bestDist) {
		bestDist = dist;
	    }
	}
	if (linePtr->arrow != firstUid) {
	    dist = TkPolygonToPoint(linePtr->lastArrowPtr, PTS_IN_ARROW,
		    pointPtr);
	    if (dist <= 0.0) {
		bestDist = 0.0;
		goto done;
	    } else if (dist < bestDist) {
		bestDist = dist;







|



|

|



|




















|












|
|









|







902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
		} else if (dist < bestDist) {
		    bestDist = dist;
		}
		changedMiterToBevel = 0;
	    }
	}
	if (count == 2) {
	    TkGetButtPoints(coordPtr, coordPtr+2, width,
		    linePtr->capStyle == CapProjecting, poly+4, poly+6);
	} else if (linePtr->joinStyle == JoinMiter) {
	    if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
		    width, poly+4, poly+6) == 0) {
		changedMiterToBevel = 1;
		TkGetButtPoints(coordPtr, coordPtr+2, width,
			0, poly+4, poly+6);
	    }
	} else {
	    TkGetButtPoints(coordPtr, coordPtr+2, width, 0,
		    poly+4, poly+6);
	}
	poly[8] = poly[0];
	poly[9] = poly[1];
	dist = TkPolygonToPoint(poly, 5, pointPtr);
	if (dist <= 0.0) {
	    bestDist = 0.0;
	    goto done;
	} else if (dist < bestDist) {
	    bestDist = dist;
	}
    }

    /*
     * If caps are rounded, check the distance to the cap around the
     * final end point of the line.
     */

    if (linePtr->capStyle == CapRound) {
	dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
		- width/2.0;
	if (dist <= 0.0) {
	    bestDist = 0.0;
	    goto done;
	} else if (dist < bestDist) {
	    bestDist = dist;
	}
    }

    /*
     * If there are arrowheads, check the distance to the arrowheads.
     */

    if (linePtr->arrow != Tk_GetUid("none")) {
	if (linePtr->arrow != Tk_GetUid("last")) {
	    dist = TkPolygonToPoint(linePtr->firstArrowPtr, PTS_IN_ARROW,
		    pointPtr);
	    if (dist <= 0.0) {
		bestDist = 0.0;
		goto done;
	    } else if (dist < bestDist) {
		bestDist = dist;
	    }
	}
	if (linePtr->arrow != Tk_GetUid("first")) {
	    dist = TkPolygonToPoint(linePtr->lastArrowPtr, PTS_IN_ARROW,
		    pointPtr);
	    if (dist <= 0.0) {
		bestDist = 0.0;
		goto done;
	    } else if (dist < bestDist) {
		bestDist = dist;
1011
1012
1013
1014
1015
1016
1017

1018
1019
1020
1021
1022
1023
1024
    Tk_Canvas canvas;		/* Canvas containing item. */
    Tk_Item *itemPtr;		/* Item to check against line. */
    double *rectPtr;
{
    LineItem *linePtr = (LineItem *) itemPtr;
    double staticSpace[2*MAX_STATIC_POINTS];
    double *linePoints;

    int numPoints, result;

    /*
     * Handle smoothed lines by generating an expanded set of points
     * against which to do the check.
     */








>







1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
    Tk_Canvas canvas;		/* Canvas containing item. */
    Tk_Item *itemPtr;		/* Item to check against line. */
    double *rectPtr;
{
    LineItem *linePtr = (LineItem *) itemPtr;
    double staticSpace[2*MAX_STATIC_POINTS];
    double *linePoints;
    double width;
    int numPoints, result;

    /*
     * Handle smoothed lines by generating an expanded set of points
     * against which to do the check.
     */

1037
1038
1039
1040
1041
1042
1043
1044





1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
	numPoints = linePtr->numPoints;
	linePoints = linePtr->coordPtr;
    }

    /*
     * Check the segments of the line.
     */






    result = TkThickPolyLineToArea(linePoints, numPoints, 
	    (double) linePtr->width, linePtr->capStyle, linePtr->joinStyle,
	    rectPtr);
    if (result == 0) {
	goto done;
    }

    /*
     * Check arrowheads, if any.
     */

    if (linePtr->arrow != noneUid) {
	if (linePtr->arrow != lastUid) {
	    if (TkPolygonToArea(linePtr->firstArrowPtr, PTS_IN_ARROW,
		    rectPtr) != result) {
		result = 0;
		goto done;
	    }
	}
	if (linePtr->arrow != firstUid) {
	    if (TkPolygonToArea(linePtr->lastArrowPtr, PTS_IN_ARROW,
		    rectPtr) != result) {
		result = 0;
		goto done;
	    }
	}
    }








>
>
>
>
>

|









|
|






|







1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
	numPoints = linePtr->numPoints;
	linePoints = linePtr->coordPtr;
    }

    /*
     * Check the segments of the line.
     */

    width = (double) linePtr->width;
    if (width < 1.0) {
	width = 1.0;
    }

    result = TkThickPolyLineToArea(linePoints, numPoints, 
	    width, linePtr->capStyle, linePtr->joinStyle,
	    rectPtr);
    if (result == 0) {
	goto done;
    }

    /*
     * Check arrowheads, if any.
     */

    if (linePtr->arrow != Tk_GetUid("none")) {
	if (linePtr->arrow != Tk_GetUid("last")) {
	    if (TkPolygonToArea(linePtr->firstArrowPtr, PTS_IN_ARROW,
		    rectPtr) != result) {
		result = 0;
		goto done;
	    }
	}
	if (linePtr->arrow != Tk_GetUid("first")) {
	    if (TkPolygonToArea(linePtr->lastArrowPtr, PTS_IN_ARROW,
		    rectPtr) != result) {
		result = 0;
		goto done;
	    }
	}
    }
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
	linePtr->lastArrowPtr = NULL;
    }
    for (i = 0, coordPtr = linePtr->coordPtr; i < linePtr->numPoints;
	    i++, coordPtr += 2) {
	coordPtr[0] = originX + scaleX*(*coordPtr - originX);
	coordPtr[1] = originY + scaleY*(coordPtr[1] - originY);
    }
    if (linePtr->arrow != noneUid) {
	ConfigureArrows(canvas, linePtr);
    }
    ComputeLineBbox(canvas, linePtr);
}

/*
 *--------------------------------------------------------------







|







1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
	linePtr->lastArrowPtr = NULL;
    }
    for (i = 0, coordPtr = linePtr->coordPtr; i < linePtr->numPoints;
	    i++, coordPtr += 2) {
	coordPtr[0] = originX + scaleX*(*coordPtr - originX);
	coordPtr[1] = originY + scaleY*(coordPtr[1] - originY);
    }
    if (linePtr->arrow != Tk_GetUid("none")) {
	ConfigureArrows(canvas, linePtr);
    }
    ComputeLineBbox(canvas, linePtr);
}

/*
 *--------------------------------------------------------------
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
     * If there's an arrowhead on the first point of the line, compute
     * its polygon and adjust the first point of the line so that the
     * line doesn't stick out past the leading edge of the arrowhead.
     */

    fracHeight = (linePtr->width/2.0)/shapeC;
    backup = fracHeight*shapeB + shapeA*(1.0 - fracHeight)/2.0;
    if (linePtr->arrow != lastUid) {
	poly = linePtr->firstArrowPtr;
	if (poly == NULL) {
	    poly = (double *) ckalloc((unsigned)
		    (2*PTS_IN_ARROW*sizeof(double)));
	    poly[0] = poly[10] = linePtr->coordPtr[0];
	    poly[1] = poly[11] = linePtr->coordPtr[1];
	    linePtr->firstArrowPtr = poly;







|







1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
     * If there's an arrowhead on the first point of the line, compute
     * its polygon and adjust the first point of the line so that the
     * line doesn't stick out past the leading edge of the arrowhead.
     */

    fracHeight = (linePtr->width/2.0)/shapeC;
    backup = fracHeight*shapeB + shapeA*(1.0 - fracHeight)/2.0;
    if (linePtr->arrow != Tk_GetUid("last")) {
	poly = linePtr->firstArrowPtr;
	if (poly == NULL) {
	    poly = (double *) ckalloc((unsigned)
		    (2*PTS_IN_ARROW*sizeof(double)));
	    poly[0] = poly[10] = linePtr->coordPtr[0];
	    poly[1] = poly[11] = linePtr->coordPtr[1];
	    linePtr->firstArrowPtr = poly;
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
	linePtr->coordPtr[1] = poly[1] - backup*sinTheta;
    }

    /*
     * Similar arrowhead calculation for the last point of the line.
     */

    if (linePtr->arrow != firstUid) {
	coordPtr = linePtr->coordPtr + 2*(linePtr->numPoints-2);
	poly = linePtr->lastArrowPtr;
	if (poly == NULL) {
	    poly = (double *) ckalloc((unsigned)
		    (2*PTS_IN_ARROW*sizeof(double)));
	    poly[0] = poly[10] = coordPtr[2];
	    poly[1] = poly[11] = coordPtr[3];







|







1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
	linePtr->coordPtr[1] = poly[1] - backup*sinTheta;
    }

    /*
     * Similar arrowhead calculation for the last point of the line.
     */

    if (linePtr->arrow != Tk_GetUid("first")) {
	coordPtr = linePtr->coordPtr + 2*(linePtr->numPoints-2);
	poly = linePtr->lastArrowPtr;
	if (poly == NULL) {
	    poly = (double *) ckalloc((unsigned)
		    (2*PTS_IN_ARROW*sizeof(double)));
	    poly[0] = poly[10] = coordPtr[2];
	    poly[1] = poly[11] = coordPtr[3];
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
 *
 *	This procedure is called to generate Postscript for
 *	line items.
 *
 * Results:
 *	The return value is a standard Tcl result.  If an error
 *	occurs in generating Postscript then an error message is
 *	left in interp->result, replacing whatever used
 *	to be there.  If no error occurs, then Postscript for the
 *	item is appended to the result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------







|







1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
 *
 *	This procedure is called to generate Postscript for
 *	line items.
 *
 * Results:
 *	The return value is a standard Tcl result.  If an error
 *	occurs in generating Postscript then an error message is
 *	left in the interp's result, replacing whatever used
 *	to be there.  If no error occurs, then Postscript for the
 *	item is appended to the result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
    Tk_Item *itemPtr;			/* Item for which Postscript is
					 * wanted. */
    int prepass;			/* 1 means this is a prepass to
					 * collect font information;  0 means
					 * final Postscript is being created. */
{
    LineItem *linePtr = (LineItem *) itemPtr;
    char buffer[200];
    char *style;

    if (linePtr->fg == NULL) {
	return TCL_OK;
    }

    /*







|







1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
    Tk_Item *itemPtr;			/* Item for which Postscript is
					 * wanted. */
    int prepass;			/* 1 means this is a prepass to
					 * collect font information;  0 means
					 * final Postscript is being created. */
{
    LineItem *linePtr = (LineItem *) itemPtr;
    char buffer[64 + TCL_INTEGER_SPACE];
    char *style;

    if (linePtr->fg == NULL) {
	return TCL_OK;
    }

    /*
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
 *
 *	This procedure is called to generate Postscript for
 *	an arrowhead for a line item.
 *
 * Results:
 *	The return value is a standard Tcl result.  If an error
 *	occurs in generating Postscript then an error message is
 *	left in interp->result, replacing whatever used
 *	to be there.  If no error occurs, then Postscript for the
 *	arrowhead is appended to the result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------







|







1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
 *
 *	This procedure is called to generate Postscript for
 *	an arrowhead for a line item.
 *
 * Results:
 *	The return value is a standard Tcl result.  If an error
 *	occurs in generating Postscript then an error message is
 *	left in the interp's result, replacing whatever used
 *	to be there.  If no error occurs, then Postscript for the
 *	arrowhead is appended to the result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------

Changes to generic/tkCanvPoly.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkCanvPoly.c --
 *
 *	This file implements polygon items for canvas widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkCanvPoly.c 1.37 97/04/29 15:39:16
 */

#include <stdio.h>
#include "tkInt.h"
#include "tkPort.h"

/*











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkCanvPoly.c --
 *
 *	This file implements polygon items for canvas widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkCanvPoly.c,v 1.1.4.2 1998/09/30 02:16:44 stanton Exp $
 */

#include <stdio.h>
#include "tkInt.h"
#include "tkPort.h"

/*
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
 *
 *	This procedure is invoked to create a new polygon item in
 *	a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item, then an error message is left in
 *	interp->result;  in this case itemPtr is
 *	left uninitialized, so it can be safely freed by the
 *	caller.
 *
 * Side effects:
 *	A new polygon item is created.
 *
 *--------------------------------------------------------------







|







146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
 *
 *	This procedure is invoked to create a new polygon item in
 *	a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item, then an error message is left in
 *	the interp's result;  in this case itemPtr is
 *	left uninitialized, so it can be safely freed by the
 *	caller.
 *
 * Side effects:
 *	A new polygon item is created.
 *
 *--------------------------------------------------------------
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
 * PolygonCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on polygons.  See the user documentation for details
 *	on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets interp->result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */








|







230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
 * PolygonCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on polygons.  See the user documentation for details
 *	on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets the interp's result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */

323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
 * ConfigurePolygon --
 *
 *	This procedure is invoked to configure various aspects
 *	of a polygon item such as its background color.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in interp->result.
 *
 * Side effects:
 *	Configuration information, such as colors and stipple
 *	patterns, may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */







|







323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
 * ConfigurePolygon --
 *
 *	This procedure is invoked to configure various aspects
 *	of a polygon item such as its background color.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in the interp's result.
 *
 * Side effects:
 *	Configuration information, such as colors and stipple
 *	patterns, may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
 *
 *	This procedure is called to generate Postscript for
 *	polygon items.
 *
 * Results:
 *	The return value is a standard Tcl result.  If an error
 *	occurs in generating Postscript then an error message is
 *	left in interp->result, replacing whatever used
 *	to be there.  If no error occurs, then Postscript for the
 *	item is appended to the result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
PolygonToPostscript(interp, canvas, itemPtr, prepass)
    Tcl_Interp *interp;			/* Leave Postscript or error message
					 * here. */
    Tk_Canvas canvas;			/* Information about overall canvas. */
    Tk_Item *itemPtr;			/* Item for which Postscript is
					 * wanted. */
    int prepass;			/* 1 means this is a prepass to
					 * collect font information;  0 means
					 * final Postscript is being created. */
{
    char string[100];
    PolygonItem *polyPtr = (PolygonItem *) itemPtr;

    /*
     * Fill the area of the polygon.
     */

    if (polyPtr->fillColor != NULL) {







|




















<







915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942

943
944
945
946
947
948
949
 *
 *	This procedure is called to generate Postscript for
 *	polygon items.
 *
 * Results:
 *	The return value is a standard Tcl result.  If an error
 *	occurs in generating Postscript then an error message is
 *	left in the interp's result, replacing whatever used
 *	to be there.  If no error occurs, then Postscript for the
 *	item is appended to the result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
PolygonToPostscript(interp, canvas, itemPtr, prepass)
    Tcl_Interp *interp;			/* Leave Postscript or error message
					 * here. */
    Tk_Canvas canvas;			/* Information about overall canvas. */
    Tk_Item *itemPtr;			/* Item for which Postscript is
					 * wanted. */
    int prepass;			/* 1 means this is a prepass to
					 * collect font information;  0 means
					 * final Postscript is being created. */
{

    PolygonItem *polyPtr = (PolygonItem *) itemPtr;

    /*
     * Fill the area of the polygon.
     */

    if (polyPtr->fillColor != NULL) {
973
974
975
976
977
978
979


980
981
982
983
984
985
986
    }

    /*
     * Now draw the outline, if there is one.
     */

    if (polyPtr->outlineColor != NULL) {


	if (!polyPtr->smooth) {
	    Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr,
		polyPtr->numPoints);
	} else {
	    TkMakeBezierPostscript(interp, canvas, polyPtr->coordPtr,
		polyPtr->numPoints);
	}







>
>







972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
    }

    /*
     * Now draw the outline, if there is one.
     */

    if (polyPtr->outlineColor != NULL) {
	char string[32 + TCL_INTEGER_SPACE];

	if (!polyPtr->smooth) {
	    Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr,
		polyPtr->numPoints);
	} else {
	    TkMakeBezierPostscript(interp, canvas, polyPtr->coordPtr,
		polyPtr->numPoints);
	}

Changes to generic/tkCanvPs.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkCanvPs.c --
 *
 *	This module provides Postscript output support for canvases,
 *	including the "postscript" widget command plus a few utility
 *	procedures used for generating Postscript.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkCanvPs.c 1.57 97/10/28 18:08:39
 */

#include "tkInt.h"
#include "tkCanvas.h"
#include "tkPort.h"

/*








|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkCanvPs.c --
 *
 *	This module provides Postscript output support for canvases,
 *	including the "postscript" widget command plus a few utility
 *	procedures used for generating Postscript.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkCanvPs.c,v 1.1.4.3 1999/04/06 02:17:06 stanton Exp $
 */

#include "tkInt.h"
#include "tkCanvas.h"
#include "tkPort.h"

/*
107
108
109
110
111
112
113


























































































































































































































































































































114
115
116
117
118
119
120
	"", Tk_Offset(TkPostscriptInfo, x), 0},
    {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL,
	"", Tk_Offset(TkPostscriptInfo, y), 0},
    {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, 0}
};



























































































































































































































































































































/*
 * Forward declarations for procedures defined later in this file:
 */

static int		GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, double *doublePtr));








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







107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
	"", Tk_Offset(TkPostscriptInfo, x), 0},
    {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL,
	"", Tk_Offset(TkPostscriptInfo, y), 0},
    {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, 0}
};

/*
 * The prolog data. Generated by str2c from prolog.ps
 * This was split in small chunks by str2c because
 * some C compiler have limitations on the size of static strings.
 * (str2c is a small tcl script in tcl's tool directory (source release))
 */
static CONST char * CONST  prolog[]= {
	/* Start of part 1 (2000 characters) */
	"%%BeginProlog\n\
50 dict begin\n\
\n\
% This is a standard prolog for Postscript generated by Tk's canvas\n\
% widget.\n\
% RCS: @(#) $Id: tkCanvPs.c,v 1.1.4.3 1999/04/06 02:17:06 stanton Exp $\n\
\n\
% The definitions below just define all of the variables used in\n\
% any of the procedures here.  This is needed for obscure reasons\n\
% explained on p. 716 of the Postscript manual (Section H.2.7,\n\
% \"Initializing Variables,\" in the section on Encapsulated Postscript).\n\
\n\
/baseline 0 def\n\
/stipimage 0 def\n\
/height 0 def\n\
/justify 0 def\n\
/lineLength 0 def\n\
/spacing 0 def\n\
/stipple 0 def\n\
/strings 0 def\n\
/xoffset 0 def\n\
/yoffset 0 def\n\
/tmpstip null def\n\
\n\
% Define the array ISOLatin1Encoding (which specifies how characters are\n\
% encoded for ISO-8859-1 fonts), if it isn't already present (Postscript\n\
% level 2 is supposed to define it, but level 1 doesn't).\n\
\n\
systemdict /ISOLatin1Encoding known not {\n\
    /ISOLatin1Encoding [\n\
	/space /space /space /space /space /space /space /space\n\
	/space /space /space /space /space /space /space /space\n\
	/space /space /space /space /space /space /space /space\n\
	/space /space /space /space /space /space /space /space\n\
	/space /exclam /quotedbl /numbersign /dollar /percent /ampersand\n\
	    /quoteright\n\
	/parenleft /parenright /asterisk /plus /comma /minus /period /slash\n\
	/zero /one /two /three /four /five /six /seven\n\
	/eight /nine /colon /semicolon /less /equal /greater /question\n\
	/at /A /B /C /D /E /F /G\n\
	/H /I /J /K /L /M /N /O\n\
	/P /Q /R /S /T /U /V /W\n\
	/X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore\n\
	/quoteleft /a /b /c /d /e /f /g\n\
	/h /i /j /k /l /m /n /o\n\
	/p /q /r /s /t /u /v /w\n\
	/x /y /z /braceleft /bar /braceright /asciitilde /space\n\
	/space /space /space /space /space /space /space /space\n\
	/space /space /space /space /space /space /space /space\n\
	/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent\n\
	/dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron\n\
	/space /exclamdown /cent /sterling /currency /yen /brokenbar /section\n\
	/dieresis /copyright /ordfem",
	/* End of part 1 */

	/* Start of part 2 (2000 characters) */
	"inine /guillemotleft /logicalnot /hyphen\n\
	    /registered /macron\n\
	/degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph\n\
	    /periodcentered\n\
	/cedillar /onesuperior /ordmasculine /guillemotright /onequarter\n\
	    /onehalf /threequarters /questiondown\n\
	/Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla\n\
	/Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex\n\
	    /Idieresis\n\
	/Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply\n\
	/Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn\n\
	    /germandbls\n\
	/agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla\n\
	/egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex\n\
	    /idieresis\n\
	/eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide\n\
	/oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn\n\
	    /ydieresis\n\
    ] def\n\
} if\n\
\n\
% font ISOEncode font\n\
% This procedure changes the encoding of a font from the default\n\
% Postscript encoding to ISOLatin1.  It's typically invoked just\n\
% before invoking \"setfont\".  The body of this procedure comes from\n\
% Section 5.6.1 of the Postscript book.\n\
\n\
/ISOEncode {\n\
    dup length dict begin\n\
	{1 index /FID ne {def} {pop pop} ifelse} forall\n\
	/Encoding ISOLatin1Encoding def\n\
	currentdict\n\
    end\n\
\n\
    % I'm not sure why it's necessary to use \"definefont\" on this new\n\
    % font, but it seems to be important; just use the name \"Temporary\"\n\
    % for the font.\n\
\n\
    /Temporary exch definefont\n\
} bind def\n\
\n\
% StrokeClip\n\
%\n\
% This procedure converts the current path into a clip area under\n\
% the assumption of stroking.  It's a bit tricky because some Postscript\n\
% interpreters get errors during strokepath for dashed lines.  If\n\
% this happens then turn off dashes and try again.\n\
\n\
/StrokeClip {\n\
    {strokepath} stopped {\n\
	(This Postscript printer gets limitcheck overflows when) =\n\
	(stippling dashed lines;  lines will be printed solid instead.) =\n\
	[] 0 setdash strokepath} if\n\
    clip\n\
} bind def\n\
\n\
% d",
	/* End of part 2 */

	/* Start of part 3 (2000 characters) */
	"esiredSize EvenPixels closestSize\n\
%\n\
% The procedure below is used for stippling.  Given the optimal size\n\
% of a dot in a stipple pattern in the current user coordinate system,\n\
% compute the closest size that is an exact multiple of the device's\n\
% pixel size.  This allows stipple patterns to be displayed without\n\
% aliasing effects.\n\
\n\
/EvenPixels {\n\
    % Compute exact number of device pixels per stipple dot.\n\
    dup 0 matrix currentmatrix dtransform\n\
    dup mul exch dup mul add sqrt\n\
\n\
    % Round to an integer, make sure the number is at least 1, and compute\n\
    % user coord distance corresponding to this.\n\
    dup round dup 1 lt {pop 1} if\n\
    exch div mul\n\
} bind def\n\
\n\
% width height string StippleFill --\n\
%\n\
% Given a path already set up and a clipping region generated from\n\
% it, this procedure will fill the clipping region with a stipple\n\
% pattern.  \"String\" contains a proper image description of the\n\
% stipple pattern and \"width\" and \"height\" give its dimensions.  Each\n\
% stipple dot is assumed to be about one unit across in the current\n\
% user coordinate system.  This procedure trashes the graphics state.\n\
\n\
/StippleFill {\n\
    % The following code is needed to work around a NeWSprint bug.\n\
\n\
    /tmpstip 1 index def\n\
\n\
    % Change the scaling so that one user unit in user coordinates\n\
    % corresponds to the size of one stipple dot.\n\
    1 EvenPixels dup scale\n\
\n\
    % Compute the bounding box occupied by the path (which is now\n\
    % the clipping region), and round the lower coordinates down\n\
    % to the nearest starting point for the stipple pattern.  Be\n\
    % careful about negative numbers, since the rounding works\n\
    % differently on them.\n\
\n\
    pathbbox\n\
    4 2 roll\n\
    5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll\n\
    6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll\n\
\n\
    % Stack now: width height string y1 y2 x1 x2\n\
    % Below is a doubly-nested for loop to iterate across this area\n\
    % in units of the stipple pattern size, going up columns then\n\
    % acr",
	/* End of part 3 */

	/* Start of part 4 (2000 characters) */
	"oss rows, blasting out a stipple-pattern-sized rectangle at\n\
    % each position\n\
\n\
    6 index exch {\n\
	2 index 5 index 3 index {\n\
	    % Stack now: width height string y1 y2 x y\n\
\n\
	    gsave\n\
	    1 index exch translate\n\
	    5 index 5 index true matrix tmpstip imagemask\n\
	    grestore\n\
	} for\n\
	pop\n\
    } for\n\
    pop pop pop pop pop\n\
} bind def\n\
\n\
% -- AdjustColor --\n\
% Given a color value already set for output by the caller, adjusts\n\
% that value to a grayscale or mono value if requested by the CL\n\
% variable.\n\
\n\
/AdjustColor {\n\
    CL 2 lt {\n\
	currentgray\n\
	CL 0 eq {\n\
	    .5 lt {0} {1} ifelse\n\
	} if\n\
	setgray\n\
    } if\n\
} bind def\n\
\n\
% x y strings spacing xoffset yoffset justify stipple DrawText --\n\
% This procedure does all of the real work of drawing text.  The\n\
% color and font must already have been set by the caller, and the\n\
% following arguments must be on the stack:\n\
%\n\
% x, y -	Coordinates at which to draw text.\n\
% strings -	An array of strings, one for each line of the text item,\n\
%		in order from top to bottom.\n\
% spacing -	Spacing between lines.\n\
% xoffset -	Horizontal offset for text bbox relative to x and y: 0 for\n\
%		nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n\
% yoffset -	Vertical offset for text bbox relative to x and y: 0 for\n\
%		nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n\
% justify -	0 for left justification, 0.5 for center, 1 for right justify.\n\
% stipple -	Boolean value indicating whether or not text is to be\n\
%		drawn in stippled fashion.  If text is stippled,\n\
%		procedure StippleText must have been defined to call\n\
%		StippleFill in the right way.\n\
%\n\
% Also, when this procedure is invoked, the color and font must already\n\
% have been set for the text.\n\
\n\
/DrawText {\n\
    /stipple exch def\n\
    /justify exch def\n\
    /yoffset exch def\n\
    /xoffset exch def\n\
    /spacing exch def\n\
    /strings exch def\n\
\n\
    % First scan through all of the text to find the widest line.\n\
\n\
    /lineLength 0 def\n\
    strings {\n\
	stringwidth pop\n\
	dup lineLength gt {/lineLength exch def}",
	/* End of part 4 */

	/* Start of part 5 (1546 characters) */
	" {pop} ifelse\n\
	newpath\n\
    } forall\n\
\n\
    % Compute the baseline offset and the actual font height.\n\
\n\
    0 0 moveto (TXygqPZ) false charpath\n\
    pathbbox dup /baseline exch def\n\
    exch pop exch sub /height exch def pop\n\
    newpath\n\
\n\
    % Translate coordinates first so that the origin is at the upper-left\n\
    % corner of the text's bounding box. Remember that x and y for\n\
    % positioning are still on the stack.\n\
\n\
    translate\n\
    lineLength xoffset mul\n\
    strings length 1 sub spacing mul height add yoffset mul translate\n\
\n\
    % Now use the baseline and justification information to translate so\n\
    % that the origin is at the baseline and positioning point for the\n\
    % first line of text.\n\
\n\
    justify lineLength mul baseline neg translate\n\
\n\
    % Iterate over each of the lines to output it.  For each line,\n\
    % compute its width again so it can be properly justified, then\n\
    % display it.\n\
\n\
    strings {\n\
	dup stringwidth pop\n\
	justify neg mul 0 moveto\n\
	stipple {\n\
\n\
	    % The text is stippled, so turn it into a path and print\n\
	    % by calling StippledText, which in turn calls StippleFill.\n\
	    % Unfortunately, many Postscript interpreters will get\n\
	    % overflow errors if we try to do the whole string at\n\
	    % once, so do it a character at a time.\n\
\n\
	    gsave\n\
	    /char (X) def\n\
	    {\n\
		char 0 3 -1 roll put\n\
		currentpoint\n\
		gsave\n\
		char true charpath clip StippleText\n\
		grestore\n\
		char stringwidth translate\n\
		moveto\n\
	    } forall\n\
	    grestore\n\
	} {show} ifelse\n\
	0 spacing neg translate\n\
    } forall\n\
} bind def\n\
\n\
%%EndProlog\n\
",
	/* End of part 5 */

	NULL	/* End of data marker */
};

/*
 * Forward declarations for procedures defined later in this file:
 */

static int		GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, double *doublePtr));

160
161
162
163
164
165
166

167
168
169
170
171
172
173
					 * point on the page (reflects
					 * anchor position).  Initial values
					 * needed only to stop compiler
					 * warnings. */
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
    Tcl_DString buffer;


    /*
     *----------------------------------------------------------------
     * Initialize the data structure describing Postscript generation,
     * then process all the arguments to fill the data structure in.
     *----------------------------------------------------------------
     */







>







474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
					 * point on the page (reflects
					 * anchor position).  Initial values
					 * needed only to stop compiler
					 * warnings. */
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
    Tcl_DString buffer;
    CONST char * CONST *chunk;

    /*
     *----------------------------------------------------------------
     * Initialize the data structure describing Postscript generation,
     * then process all the arguments to fill the data structure in.
     *----------------------------------------------------------------
     */
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
     *--------------------------------------------------------
     * Generate the header and prolog for the Postscript.
     *--------------------------------------------------------
     */

    Tcl_AppendResult(canvasPtr->interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
	    "%%Creator: Tk Canvas Widget\n", (char *) NULL);
#if !(defined(__WIN32__) || defined(MAC_TCL))
    if (!Tcl_IsSafe(interp)) {
	struct passwd *pwPtr = getpwuid(getuid());
	Tcl_AppendResult(canvasPtr->interp, "%%For: ",
		(pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n",
		(char *) NULL);
	endpwent();
    }
#endif /* __WIN32__ || MAC_TCL */
    Tcl_AppendResult(canvasPtr->interp, "%%Title: Window ",
	    Tk_PathName(canvasPtr->tkwin), "\n", (char *) NULL);
    time(&now);
    Tcl_AppendResult(canvasPtr->interp, "%%CreationDate: ",
	    ctime(&now), (char *) NULL);
    if (!psInfo.rotate) {
	sprintf(string, "%d %d %d %d",
		(int) (psInfo.pageX + psInfo.scale*deltaX),
		(int) (psInfo.pageY + psInfo.scale*deltaY),
		(int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width)
			+ 1.0),
		(int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height)







|

|





|




|







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
     *--------------------------------------------------------
     * Generate the header and prolog for the Postscript.
     *--------------------------------------------------------
     */

    Tcl_AppendResult(canvasPtr->interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
	    "%%Creator: Tk Canvas Widget\n", (char *) NULL);
#ifdef HAVE_PW_GECOS
    if (!Tcl_IsSafe(interp)) {
	struct passwd *pwPtr = getpwuid(getuid());	/* INTL: Native. */
	Tcl_AppendResult(canvasPtr->interp, "%%For: ",
		(pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n",
		(char *) NULL);
	endpwent();
    }
#endif /* HAVE_PW_GECOS */
    Tcl_AppendResult(canvasPtr->interp, "%%Title: Window ",
	    Tk_PathName(canvasPtr->tkwin), "\n", (char *) NULL);
    time(&now);
    Tcl_AppendResult(canvasPtr->interp, "%%CreationDate: ",
	    ctime(&now), (char *) NULL);		/* INTL: Native. */
    if (!psInfo.rotate) {
	sprintf(string, "%d %d %d %d",
		(int) (psInfo.pageX + psInfo.scale*deltaX),
		(int) (psInfo.pageY + psInfo.scale*deltaY),
		(int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width)
			+ 1.0),
		(int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height)
439
440
441
442
443
444
445
446
447
448


449
450
451
452
453
454
455
456
457
458
459
460
461
462
		Tcl_GetHashKey(&psInfo.fontTable, hPtr),
		"\n", (char *) NULL);
	p = "%%+ font ";
    }
    Tcl_AppendResult(canvasPtr->interp, "%%EndComments\n\n", (char *) NULL);

    /*
     * Read a standard prolog file in a native way and insert it into
     * the Postscript.
     */



    if (TkGetNativeProlog(canvasPtr->interp) != TCL_OK) {
	result = TCL_ERROR;
	goto cleanup;
    }
    if (psInfo.chan != NULL) {
	Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
	Tcl_ResetResult(canvasPtr->interp);
    }

    /*
     *-----------------------------------------------------------
     * Document setup:  set the color level and include fonts.
     *-----------------------------------------------------------







<
|

>
>
|
<
<
<
|

|







754
755
756
757
758
759
760

761
762
763
764
765



766
767
768
769
770
771
772
773
774
775
		Tcl_GetHashKey(&psInfo.fontTable, hPtr),
		"\n", (char *) NULL);
	p = "%%+ font ";
    }
    Tcl_AppendResult(canvasPtr->interp, "%%EndComments\n\n", (char *) NULL);

    /*

     * Insert the prolog
     */
    for (chunk=prolog; *chunk; chunk++) {
	Tcl_AppendResult(interp, *chunk, (char *) NULL);
    }




    if (psInfo.chan != NULL) {
	Tcl_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1);
	Tcl_ResetResult(canvasPtr->interp);
    }

    /*
     *-----------------------------------------------------------
     * Document setup:  set the color level and include fonts.
     *-----------------------------------------------------------
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
	    psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
	    psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
	    psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2),
	    psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2));
    Tcl_AppendResult(canvasPtr->interp, string,
	" lineto closepath clip newpath\n", (char *) NULL);
    if (psInfo.chan != NULL) {
	Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
	Tcl_ResetResult(canvasPtr->interp);
    }

    /*
     *---------------------------------------------------------------------
     * Iterate through all the items, having each relevant one draw itself.
     * Quit if any of the items returns an error.







|







808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
	    psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
	    psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
	    psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2),
	    psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2));
    Tcl_AppendResult(canvasPtr->interp, string,
	" lineto closepath clip newpath\n", (char *) NULL);
    if (psInfo.chan != NULL) {
	Tcl_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1);
	Tcl_ResetResult(canvasPtr->interp);
    }

    /*
     *---------------------------------------------------------------------
     * Iterate through all the items, having each relevant one draw itself.
     * Quit if any of the items returns an error.
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
	if (itemPtr->typePtr->postscriptProc == NULL) {
	    continue;
	}
	Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL);
	result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
		(Tk_Canvas) canvasPtr, itemPtr, 0);
	if (result != TCL_OK) {
	    char msg[100];

	    sprintf(msg, "\n    (generating Postscript for item %d)",
		    itemPtr->id);
	    Tcl_AddErrorInfo(canvasPtr->interp, msg);
	    goto cleanup;
	}
	Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL);
	if (psInfo.chan != NULL) {
	    Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
	    Tcl_ResetResult(canvasPtr->interp);
	}
    }

    /*
     *---------------------------------------------------------------------
     * Output page-end information, such as commands to print the page
     * and document trailer stuff.
     *---------------------------------------------------------------------
     */

    Tcl_AppendResult(canvasPtr->interp, "restore showpage\n\n",
	    "%%Trailer\nend\n%%EOF\n", (char *) NULL);
    if (psInfo.chan != NULL) {
	Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
	Tcl_ResetResult(canvasPtr->interp);
    }

    /*
     * Clean up psInfo to release malloc'ed stuff.
     */








|








|














|







833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
	if (itemPtr->typePtr->postscriptProc == NULL) {
	    continue;
	}
	Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL);
	result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
		(Tk_Canvas) canvasPtr, itemPtr, 0);
	if (result != TCL_OK) {
	    char msg[64 + TCL_INTEGER_SPACE];

	    sprintf(msg, "\n    (generating Postscript for item %d)",
		    itemPtr->id);
	    Tcl_AddErrorInfo(canvasPtr->interp, msg);
	    goto cleanup;
	}
	Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL);
	if (psInfo.chan != NULL) {
	    Tcl_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1);
	    Tcl_ResetResult(canvasPtr->interp);
	}
    }

    /*
     *---------------------------------------------------------------------
     * Output page-end information, such as commands to print the page
     * and document trailer stuff.
     *---------------------------------------------------------------------
     */

    Tcl_AppendResult(canvasPtr->interp, "restore showpage\n\n",
	    "%%Trailer\nend\n%%EOF\n", (char *) NULL);
    if (psInfo.chan != NULL) {
	Tcl_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1);
	Tcl_ResetResult(canvasPtr->interp);
    }

    /*
     * Clean up psInfo to release malloc'ed stuff.
     */

600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
 *	This procedure is called by individual canvas items when
 *	they want to set a color value for output.  Given information
 *	about an X color, this procedure will generate Postscript
 *	commands to set up an appropriate color in Postscript.
 *
 * Results:
 *	Returns a standard Tcl return value.  If an error occurs
 *	then an error message will be left in interp->result.
 *	If no error occurs, then additional Postscript will be
 *	appended to interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */








|

|







913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
 *	This procedure is called by individual canvas items when
 *	they want to set a color value for output.  Given information
 *	about an X color, this procedure will generate Postscript
 *	commands to set up an appropriate color in Postscript.
 *
 * Results:
 *	Returns a standard Tcl return value.  If an error occurs
 *	then an error message will be left in the interp's result.
 *	If no error occurs, then additional Postscript will be
 *	appended to the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

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
 *	This procedure is called by individual canvas items when
 *	they want to output text.  Given information about an X
 *	font, this procedure will generate Postscript commands
 *	to set up an appropriate font in Postscript.
 *
 * Results:
 *	Returns a standard Tcl return value.  If an error occurs
 *	then an error message will be left in interp->result.
 *	If no error occurs, then additional Postscript will be
 *	appended to the interp->result.
 *
 * Side effects:
 *	The Postscript font name is entered into psInfoPtr->fontTable
 *	if it wasn't already there.
 *
 *--------------------------------------------------------------
 */

int
Tk_CanvasPsFont(interp, canvas, tkfont)
    Tcl_Interp *interp;			/* Interpreter for returning Postscript
					 * or error message. */
    Tk_Canvas canvas;			/* Information about canvas. */
    Tk_Font tkfont;			/* Information about font in which text
					 * is to be printed. */
{
    TkCanvas *canvasPtr = (TkCanvas *) canvas;
    TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
    char *end;
    char pointString[20];
    Tcl_DString ds;
    int i, points;

    /*
     * First, look up the font's name in the font map, if there is one.
     * If there is an entry for this font, it consists of a list
     * containing font name and size.  Use this information.







|

|



















|







994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
 *	This procedure is called by individual canvas items when
 *	they want to output text.  Given information about an X
 *	font, this procedure will generate Postscript commands
 *	to set up an appropriate font in Postscript.
 *
 * Results:
 *	Returns a standard Tcl return value.  If an error occurs
 *	then an error message will be left in the interp's result.
 *	If no error occurs, then additional Postscript will be
 *	appended to the interp's result.
 *
 * Side effects:
 *	The Postscript font name is entered into psInfoPtr->fontTable
 *	if it wasn't already there.
 *
 *--------------------------------------------------------------
 */

int
Tk_CanvasPsFont(interp, canvas, tkfont)
    Tcl_Interp *interp;			/* Interpreter for returning Postscript
					 * or error message. */
    Tk_Canvas canvas;			/* Information about canvas. */
    Tk_Font tkfont;			/* Information about font in which text
					 * is to be printed. */
{
    TkCanvas *canvasPtr = (TkCanvas *) canvas;
    TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
    char *end;
    char pointString[TCL_INTEGER_SPACE];
    Tcl_DString ds;
    int i, points;

    /*
     * First, look up the font's name in the font map, if there is one.
     * If there is an entry for this font, it consists of a list
     * containing font name and size.  Use this information.
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
 *	This procedure is called to output the contents of a
 *	sub-region of a bitmap in proper image data format for
 *	Postscript (i.e. data between angle brackets, one bit
 *	per pixel).
 *
 * Results:
 *	Returns a standard Tcl return value.  If an error occurs
 *	then an error message will be left in interp->result.
 *	If no error occurs, then additional Postscript will be
 *	appended to interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */








|

|







1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
 *	This procedure is called to output the contents of a
 *	sub-region of a bitmap in proper image data format for
 *	Postscript (i.e. data between angle brackets, one bit
 *	per pixel).
 *
 * Results:
 *	Returns a standard Tcl return value.  If an error occurs
 *	then an error message will be left in the interp's result.
 *	If no error occurs, then additional Postscript will be
 *	appended to the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
 *	a stipple pattern.  Given information about an X bitmap,
 *	this procedure will generate Postscript commands to fill
 *	the current clip region using a stipple pattern defined by the
 *	bitmap.
 *
 * Results:
 *	Returns a standard Tcl return value.  If an error occurs
 *	then an error message will be left in interp->result.
 *	If no error occurs, then additional Postscript will be
 *	appended to interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

int
Tk_CanvasPsStipple(interp, canvas, bitmap)
    Tcl_Interp *interp;			/* Interpreter for returning Postscript
					 * or error message. */
    Tk_Canvas canvas;			/* Information about canvas. */
    Pixmap bitmap;			/* Bitmap to use for stippling. */
{
    TkCanvas *canvasPtr = (TkCanvas *) canvas;
    TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
    int width, height;
    char string[100];
    Window dummyRoot;
    int dummyX, dummyY;
    unsigned dummyBorderwidth, dummyDepth;

    if (psInfoPtr->prepass) {
	return TCL_OK;
    }







|

|

















|







1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
 *	a stipple pattern.  Given information about an X bitmap,
 *	this procedure will generate Postscript commands to fill
 *	the current clip region using a stipple pattern defined by the
 *	bitmap.
 *
 * Results:
 *	Returns a standard Tcl return value.  If an error occurs
 *	then an error message will be left in the interp's result.
 *	If no error occurs, then additional Postscript will be
 *	appended to the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

int
Tk_CanvasPsStipple(interp, canvas, bitmap)
    Tcl_Interp *interp;			/* Interpreter for returning Postscript
					 * or error message. */
    Tk_Canvas canvas;			/* Information about canvas. */
    Pixmap bitmap;			/* Bitmap to use for stippling. */
{
    TkCanvas *canvasPtr = (TkCanvas *) canvas;
    TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
    int width, height;
    char string[TCL_INTEGER_SPACE * 2];
    Window dummyRoot;
    int dummyX, dummyY;
    unsigned dummyBorderwidth, dummyDepth;

    if (psInfoPtr->prepass) {
	return TCL_OK;
    }
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
 *
 * Tk_CanvasPsPath --
 *
 *	Given an array of points for a path, generate Postscript
 *	commands to create the path.
 *
 * Results:
 *	Postscript commands get appended to what's in interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */








|







1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
 *
 * Tk_CanvasPsPath --
 *
 *	Given an array of points for a path, generate Postscript
 *	commands to create the path.
 *
 * Results:
 *	Postscript commands get appended to what's in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
 *	corresponding to that string.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	screen distance is stored at *doublePtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */








|







1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
 *	corresponding to that string.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	screen distance is stored at *doublePtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
    while ((*end != '\0') && isspace(UCHAR(*end))) {
	end++;
    }
    if (*end != 0) {
	goto error;
    }
    *doublePtr = d;
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * TkGetProlog --
 *
 *	Locate and load the postscript prolog.
 *
 * Results:
 *	A standard Tcl Result.  If everything is OK the prolog
 *	will be located in the result string of the interpreter.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

int
TkGetProlog(interp)
    Tcl_Interp *interp;		/* Places the prolog in the result. */
{
    char *libDir;
    Tcl_Channel chan;
    Tcl_DString buffer, buffer2;
    char *prologPathParts[2];
    int bufferSize;
    char *prologBuffer;

    libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY);
    if (libDir == NULL) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "couldn't find library directory: ",
		"tk_library variable doesn't exist", (char *) NULL);
	return TCL_ERROR;
    }
    Tcl_TranslateFileName(interp, libDir, &buffer);
    prologPathParts[0] = buffer.string;
    prologPathParts[1] = "prolog.ps";
    Tcl_DStringInit(&buffer2);
    Tcl_JoinPath(2, prologPathParts, &buffer2);
    Tcl_DStringFree(&buffer);

    /*
     * Compute size of file by seeking to the end of the file.  This will
     * overallocate if we are performing CRLF translation.
     */
    
    chan = Tcl_OpenFileChannel(NULL, buffer2.string, "r", 0);
    if (chan == NULL) {
	/*
	 * We have to set the error message ourselves because the
	 * interp's result need to be reset.
	 */
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "couldn't open \"", 
		buffer2.string, "\": ", Tcl_PosixError(interp), (char *) NULL);
	Tcl_DStringFree(&buffer2);
	return TCL_ERROR;
    }

    bufferSize = Tcl_Seek(chan, 0L, SEEK_END);
    (void) Tcl_Seek(chan, 0L, SEEK_SET);
    if (bufferSize < 0) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "error seeking to end of file \"",
		buffer2.string, "\": ", Tcl_PosixError(interp), (char *) NULL);
	Tcl_Close(NULL, chan);
	Tcl_DStringFree(&buffer2);
	return TCL_ERROR;

    }
    prologBuffer = (char *) ckalloc((unsigned) bufferSize+1);
    bufferSize = Tcl_Read(chan, prologBuffer, bufferSize);
    Tcl_Close(NULL, chan);
    if (bufferSize < 0) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "error reading file \"", buffer2.string, 
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	Tcl_DStringFree(&buffer2);
	return TCL_ERROR;
    }
    Tcl_DStringFree(&buffer2);
    prologBuffer[bufferSize] = 0;
    Tcl_AppendResult(interp, prologBuffer, (char *) NULL);
    ckfree(prologBuffer);
    
    return TCL_OK;
}









<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
1379
1380
1381
1382
1383
1384
1385
1386
1387

























































































    while ((*end != '\0') && isspace(UCHAR(*end))) {
	end++;
    }
    if (*end != 0) {
	goto error;
    }
    *doublePtr = d;
    return TCL_OK;
}

























































































Changes to generic/tkCanvText.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkCanvText.c --
 *
 *	This file implements text items for canvas widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkCanvText.c 1.68 97/10/09 17:44:53
 */

#include <stdio.h>
#include "tkInt.h"
#include "tkCanvas.h"
#include "tkPort.h"
#include "default.h"






|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkCanvText.c --
 *
 *	This file implements text items for canvas widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkCanvText.c,v 1.1.4.4 1999/03/30 04:12:55 stanton Exp $
 */

#include <stdio.h>
#include "tkInt.h"
#include "tkCanvas.h"
#include "tkPort.h"
#include "default.h"
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
				 * by (and shared with) the generic canvas
				 * code. */
    /*
     * Fields that are set by widget commands other than "configure".
     */
     
    double x, y;		/* Positioning point for text. */

    int insertPos;		/* Insertion cursor is displayed just to left
				 * of character with this index. */

    /*
     * Configuration settings that are updated by Tk_ConfigureWidget.
     */

    Tk_Anchor anchor;		/* Where to anchor text relative to (x,y). */
    XColor *color;		/* Color for text. */
    Tk_Font tkfont;		/* Font for drawing text. */
    Tk_Justify justify;		/* Justification mode for text. */
    Pixmap stipple;		/* Stipple bitmap for text, or None. */
    char *text;			/* Text for item (malloc-ed). */
    int width;			/* Width of lines for word-wrap, pixels.
				 * Zero means no word-wrap. */

    /*
     * Fields whose values are derived from the current values of the
     * configuration settings above.
     */

    int numChars;		/* Number of non-NULL characters in text. */

    Tk_TextLayout textLayout;	/* Cached text layout information. */
    int leftEdge;		/* Pixel location of the left edge of the
				 * text item; where the left border of the
				 * text layout is drawn. */
    int rightEdge;		/* Pixel just to right of right edge of
				 * area of text item.  Used for selecting up
				 * to end of line. */







>
|
<



















|
>







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
				 * by (and shared with) the generic canvas
				 * code. */
    /*
     * Fields that are set by widget commands other than "configure".
     */
     
    double x, y;		/* Positioning point for text. */
    int insertPos;		/* Character index of character just before
				 * which the insertion cursor is displayed. */


    /*
     * Configuration settings that are updated by Tk_ConfigureWidget.
     */

    Tk_Anchor anchor;		/* Where to anchor text relative to (x,y). */
    XColor *color;		/* Color for text. */
    Tk_Font tkfont;		/* Font for drawing text. */
    Tk_Justify justify;		/* Justification mode for text. */
    Pixmap stipple;		/* Stipple bitmap for text, or None. */
    char *text;			/* Text for item (malloc-ed). */
    int width;			/* Width of lines for word-wrap, pixels.
				 * Zero means no word-wrap. */

    /*
     * Fields whose values are derived from the current values of the
     * configuration settings above.
     */

    int numChars;		/* Length of text in characters. */
    int numBytes;		/* Length of text in bytes. */
    Tk_TextLayout textLayout;	/* Cached text layout information. */
    int leftEdge;		/* Pixel location of the left edge of the
				 * text item; where the left border of the
				 * text layout is drawn. */
    int rightEdge;		/* Pixel just to right of right edge of
				 * area of text item.  Used for selecting up
				 * to end of line. */
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
};

static Tk_ConfigSpec configSpecs[] = {
    {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
	"center", Tk_Offset(TextItem, anchor),
	TK_CONFIG_DONT_SET_DEFAULT},
    {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
	"black", Tk_Offset(TextItem, color), 0},
    {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL,
	DEF_CANVTEXT_FONT, Tk_Offset(TextItem, tkfont), 0},
    {TK_CONFIG_JUSTIFY, "-justify", (char *) NULL, (char *) NULL,
	"left", Tk_Offset(TextItem, justify),
	TK_CONFIG_DONT_SET_DEFAULT},
    {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
	(char *) NULL, Tk_Offset(TextItem, stipple), TK_CONFIG_NULL_OK},







|







83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
};

static Tk_ConfigSpec configSpecs[] = {
    {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
	"center", Tk_Offset(TextItem, anchor),
	TK_CONFIG_DONT_SET_DEFAULT},
    {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
	"black", Tk_Offset(TextItem, color), TK_CONFIG_NULL_OK},
    {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL,
	DEF_CANVTEXT_FONT, Tk_Offset(TextItem, tkfont), 0},
    {TK_CONFIG_JUSTIFY, "-justify", (char *) NULL, (char *) NULL,
	"left", Tk_Offset(TextItem, justify),
	TK_CONFIG_DONT_SET_DEFAULT},
    {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
	(char *) NULL, Tk_Offset(TextItem, stipple), TK_CONFIG_NULL_OK},
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234

235
236
237
238
239
240
241

/*
 * The structures below defines the rectangle and oval item types
 * by means of procedures that can be invoked by generic item code.
 */

Tk_ItemType tkTextType = {
    "text",				/* name */
    sizeof(TextItem),			/* itemSize */
    CreateText,				/* createProc */
    configSpecs,			/* configSpecs */
    ConfigureText,			/* configureProc */
    TextCoords,				/* coordProc */
    DeleteText,				/* deleteProc */
    DisplayCanvText,			/* displayProc */
    0,					/* alwaysRedraw */
    TextToPoint,			/* pointProc */
    TextToArea,				/* areaProc */
    TextToPostscript,			/* postscriptProc */
    ScaleText,				/* scaleProc */
    TranslateText,			/* translateProc */
    GetTextIndex,			/* indexProc */
    SetTextCursor,			/* icursorProc */
    GetSelText,				/* selectionProc */
    TextInsert,				/* insertProc */
    TextDeleteChars,			/* dTextProc */
    (Tk_ItemType *) NULL		/* nextPtr */
};

/*
 *--------------------------------------------------------------
 *
 * CreateText --
 *
 *	This procedure is invoked to create a new text item
 *	in a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item then an error message is left in
 *	interp->result;  in this case itemPtr is left uninitialized
 *	so it can be safely freed by the caller.
 *
 * Side effects:
 *	A new text item is created.
 *
 *--------------------------------------------------------------
 */

static int
CreateText(interp, canvas, itemPtr, argc, argv)
    Tcl_Interp *interp;			/* Interpreter for error reporting. */
    Tk_Canvas canvas;			/* Canvas to hold new item. */
    Tk_Item *itemPtr;			/* Record to hold new item;  header
					 * has been initialized by caller. */
    int argc;				/* Number of arguments in argv. */
    char **argv;			/* Arguments describing rectangle. */
{
    TextItem *textPtr = (TextItem *) itemPtr;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
		itemPtr->typePtr->name, " x y ?options?\"", (char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Carry out initialization that is needed in order to clean
     * up after errors during the the remainder of this procedure.
     */

    textPtr->textInfoPtr = Tk_CanvasGetTextInfo(canvas);

    textPtr->insertPos	= 0;

    textPtr->anchor	= TK_ANCHOR_CENTER;
    textPtr->color	= NULL;
    textPtr->tkfont	= NULL;
    textPtr->justify	= TK_JUSTIFY_LEFT;
    textPtr->stipple	= None;
    textPtr->text	= NULL;
    textPtr->width	= 0;

    textPtr->numChars	= 0;

    textPtr->textLayout = NULL;
    textPtr->leftEdge	= 0;
    textPtr->rightEdge	= 0;
    textPtr->gc		= None;
    textPtr->selTextGC	= None;
    textPtr->cursorOffGC = None;








|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|













|










|
|
|
|
|
|











|
|















>







151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243

/*
 * The structures below defines the rectangle and oval item types
 * by means of procedures that can be invoked by generic item code.
 */

Tk_ItemType tkTextType = {
    "text",			/* name */
    sizeof(TextItem),		/* itemSize */
    CreateText,			/* createProc */
    configSpecs,		/* configSpecs */
    ConfigureText,		/* configureProc */
    TextCoords,			/* coordProc */
    DeleteText,			/* deleteProc */
    DisplayCanvText,		/* displayProc */
    0,				/* alwaysRedraw */
    TextToPoint,		/* pointProc */
    TextToArea,			/* areaProc */
    TextToPostscript,		/* postscriptProc */
    ScaleText,			/* scaleProc */
    TranslateText,		/* translateProc */
    GetTextIndex,		/* indexProc */
    SetTextCursor,		/* icursorProc */
    GetSelText,			/* selectionProc */
    TextInsert,			/* insertProc */
    TextDeleteChars,		/* dTextProc */
    (Tk_ItemType *) NULL	/* nextPtr */
};

/*
 *--------------------------------------------------------------
 *
 * CreateText --
 *
 *	This procedure is invoked to create a new text item
 *	in a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item then an error message is left in
 *	the interp's result;  in this case itemPtr is left uninitialized
 *	so it can be safely freed by the caller.
 *
 * Side effects:
 *	A new text item is created.
 *
 *--------------------------------------------------------------
 */

static int
CreateText(interp, canvas, itemPtr, argc, argv)
    Tcl_Interp *interp;		/* Interpreter for error reporting. */
    Tk_Canvas canvas;		/* Canvas to hold new item. */
    Tk_Item *itemPtr;		/* Record to hold new item; header has been
				 * initialized by caller. */
    int argc;			/* Number of arguments in argv. */
    char **argv;		/* Arguments describing rectangle. */
{
    TextItem *textPtr = (TextItem *) itemPtr;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
		itemPtr->typePtr->name, " x y ?options?\"", (char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Carry out initialization that is needed in order to clean up after
     * errors during the the remainder of this procedure.
     */

    textPtr->textInfoPtr = Tk_CanvasGetTextInfo(canvas);

    textPtr->insertPos	= 0;

    textPtr->anchor	= TK_ANCHOR_CENTER;
    textPtr->color	= NULL;
    textPtr->tkfont	= NULL;
    textPtr->justify	= TK_JUSTIFY_LEFT;
    textPtr->stipple	= None;
    textPtr->text	= NULL;
    textPtr->width	= 0;

    textPtr->numChars	= 0;
    textPtr->numBytes	= 0;
    textPtr->textLayout = NULL;
    textPtr->leftEdge	= 0;
    textPtr->rightEdge	= 0;
    textPtr->gc		= None;
    textPtr->selTextGC	= None;
    textPtr->cursorOffGC = None;

262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302

303
304

305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
 * TextCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on text items.  See the user documentation for
 *	details on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets interp->result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */

static int
TextCoords(interp, canvas, itemPtr, argc, argv)
    Tcl_Interp *interp;			/* Used for error reporting. */
    Tk_Canvas canvas;			/* Canvas containing item. */
    Tk_Item *itemPtr;			/* Item whose coordinates are to be
					 * read or modified. */
    int argc;				/* Number of coordinates supplied in
					 * argv. */
    char **argv;			/* Array of coordinates: x1, y1,
					 * x2, y2, ... */
{
    TextItem *textPtr = (TextItem *) itemPtr;
    char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE];

    if (argc == 0) {
	Tcl_PrintDouble(interp, textPtr->x, x);
	Tcl_PrintDouble(interp, textPtr->y, y);
	Tcl_AppendResult(interp, x, " ", y, (char *) NULL);
    } else if (argc == 2) {
	if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &textPtr->x) != TCL_OK)
		|| (Tk_CanvasGetCoord(interp, canvas, argv[1],
		    &textPtr->y) != TCL_OK)) {
	    return TCL_ERROR;
	}
	ComputeTextBbox(canvas, textPtr);
    } else {

	sprintf(interp->result,
		"wrong # coordinates: expected 0 or 2, got %d", argc);

	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ConfigureText --
 *
 *	This procedure is invoked to configure various aspects
 *	of a text item, such as its border and background colors.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in interp->result.
 *
 * Side effects:
 *	Configuration information, such as colors and stipple
 *	patterns, may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */







|









|
|
|
|
|
<
|
<
















>
|
|
>















|







264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285

286

287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
 * TextCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on text items.  See the user documentation for
 *	details on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets the interp's result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */

static int
TextCoords(interp, canvas, itemPtr, argc, argv)
    Tcl_Interp *interp;		/* Used for error reporting. */
    Tk_Canvas canvas;		/* Canvas containing item. */
    Tk_Item *itemPtr;		/* Item whose coordinates are to be read or
				 * modified. */
    int argc;			/* Number of coordinates supplied in argv. */

    char **argv;		/* Array of coordinates: x1, y1, x2, y2, ... */

{
    TextItem *textPtr = (TextItem *) itemPtr;
    char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE];

    if (argc == 0) {
	Tcl_PrintDouble(interp, textPtr->x, x);
	Tcl_PrintDouble(interp, textPtr->y, y);
	Tcl_AppendResult(interp, x, " ", y, (char *) NULL);
    } else if (argc == 2) {
	if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &textPtr->x) != TCL_OK)
		|| (Tk_CanvasGetCoord(interp, canvas, argv[1],
		    &textPtr->y) != TCL_OK)) {
	    return TCL_ERROR;
	}
	ComputeTextBbox(canvas, textPtr);
    } else {
	char buf[64 + TCL_INTEGER_SPACE];
	
	sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ConfigureText --
 *
 *	This procedure is invoked to configure various aspects
 *	of a text item, such as its border and background colors.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in the interp's result.
 *
 * Side effects:
 *	Configuration information, such as colors and stipple
 *	patterns, may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */
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


    /*
     * If the text was changed, move the selection and insertion indices
     * to keep them inside the item.
     */

    textPtr->numChars = strlen(textPtr->text);

    if (textInfoPtr->selItemPtr == itemPtr) {

	if (textInfoPtr->selectFirst >= textPtr->numChars) {
	    textInfoPtr->selItemPtr = NULL;
	} else {
	    if (textInfoPtr->selectLast >= textPtr->numChars) {
		textInfoPtr->selectLast = textPtr->numChars-1;
	    }
	    if ((textInfoPtr->anchorItemPtr == itemPtr)
		    && (textInfoPtr->selectAnchor >= textPtr->numChars)) {
		textInfoPtr->selectAnchor = textPtr->numChars-1;
	    }
	}
    }
    if (textPtr->insertPos >= textPtr->numChars) {
	textPtr->insertPos = textPtr->numChars;
    }








|
>

>




|



|







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


    /*
     * If the text was changed, move the selection and insertion indices
     * to keep them inside the item.
     */

    textPtr->numBytes = strlen(textPtr->text);
    textPtr->numChars = Tcl_NumUtfChars(textPtr->text, textPtr->numBytes);
    if (textInfoPtr->selItemPtr == itemPtr) {
	
	if (textInfoPtr->selectFirst >= textPtr->numChars) {
	    textInfoPtr->selItemPtr = NULL;
	} else {
	    if (textInfoPtr->selectLast >= textPtr->numChars) {
		textInfoPtr->selectLast = textPtr->numChars - 1;
	    }
	    if ((textInfoPtr->anchorItemPtr == itemPtr)
		    && (textInfoPtr->selectAnchor >= textPtr->numChars)) {
		textInfoPtr->selectAnchor = textPtr->numChars - 1;
	    }
	}
    }
    if (textPtr->insertPos >= textPtr->numChars) {
	textPtr->insertPos = textPtr->numChars;
    }

437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
 *	Resources associated with itemPtr are released.
 *
 *--------------------------------------------------------------
 */

static void
DeleteText(canvas, itemPtr, display)
    Tk_Canvas canvas;			/* Info about overall canvas widget. */
    Tk_Item *itemPtr;			/* Item that is being deleted. */
    Display *display;			/* Display containing window for
					 * canvas. */
{
    TextItem *textPtr = (TextItem *) itemPtr;

    if (textPtr->color != NULL) {
	Tk_FreeColor(textPtr->color);
    }
    Tk_FreeFont(textPtr->tkfont);







|
|
|
<







441
442
443
444
445
446
447
448
449
450

451
452
453
454
455
456
457
 *	Resources associated with itemPtr are released.
 *
 *--------------------------------------------------------------
 */

static void
DeleteText(canvas, itemPtr, display)
    Tk_Canvas canvas;		/* Info about overall canvas widget. */
    Tk_Item *itemPtr;		/* Item that is being deleted. */
    Display *display;		/* Display containing window for canvas. */

{
    TextItem *textPtr = (TextItem *) itemPtr;

    if (textPtr->color != NULL) {
	Tk_FreeColor(textPtr->color);
    }
    Tk_FreeFont(textPtr->tkfont);
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
 *	for itemPtr.
 *
 *--------------------------------------------------------------
 */

static void
ComputeTextBbox(canvas, textPtr)
    Tk_Canvas canvas;			/* Canvas that contains item. */
    TextItem *textPtr;			/* Item whose bbos is to be
					 * recomputed. */
{
    Tk_CanvasTextInfo *textInfoPtr;
    int leftX, topY, width, height, fudge;

    Tk_FreeTextLayout(textPtr->textLayout);
    textPtr->textLayout = Tk_ComputeTextLayout(textPtr->tkfont,
	    textPtr->text, textPtr->numChars, textPtr->width,







|
|
<







493
494
495
496
497
498
499
500
501

502
503
504
505
506
507
508
 *	for itemPtr.
 *
 *--------------------------------------------------------------
 */

static void
ComputeTextBbox(canvas, textPtr)
    Tk_Canvas canvas;		/* Canvas that contains item. */
    TextItem *textPtr;		/* Item whose bbox is to be recomputed. */

{
    Tk_CanvasTextInfo *textInfoPtr;
    int leftX, topY, width, height, fudge;

    Tk_FreeTextLayout(textPtr->textLayout);
    textPtr->textLayout = Tk_ComputeTextLayout(textPtr->tkfont,
	    textPtr->text, textPtr->numChars, textPtr->width,
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625

626



627
628
629
630
631
632



633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
 *	information in canvas.
 *
 *--------------------------------------------------------------
 */

static void
DisplayCanvText(canvas, itemPtr, display, drawable, x, y, width, height)
    Tk_Canvas canvas;			/* Canvas that contains item. */
    Tk_Item *itemPtr;			/* Item to be displayed. */
    Display *display;			/* Display on which to draw item. */
    Drawable drawable;			/* Pixmap or window in which to draw
					 * item. */
    int x, y, width, height;		/* Describes region of canvas that
					 * must be redisplayed (not used). */
{
    TextItem *textPtr;
    Tk_CanvasTextInfo *textInfoPtr;
    int selFirst, selLast;
    short drawableX, drawableY;

    textPtr = (TextItem *) itemPtr;
    textInfoPtr = textPtr->textInfoPtr;

    if (textPtr->gc == None) {
	return;
    }

    /*
     * If we're stippling, then modify the stipple offset in the GC.  Be
     * sure to reset the offset when done, since the GC is supposed to be
     * read-only.
     */

    if (textPtr->stipple != None) {
	Tk_CanvasSetStippleOrigin(canvas, textPtr->gc);
    }

    selFirst = -1;
    selLast = 0;		/* lint. */

    if (textInfoPtr->selItemPtr == itemPtr) {



	selFirst = textInfoPtr->selectFirst;
	selLast = textInfoPtr->selectLast;
	if (selLast >= textPtr->numChars) {
	    selLast = textPtr->numChars - 1;
	}
	if ((selFirst >= 0) && (selFirst <= selLast)) {



	    /*
	     * Draw a special background under the selection.
	     */

	    int xFirst, yFirst, hFirst;
	    int xLast, yLast, wLast;

	    Tk_CharBbox(textPtr->textLayout, selFirst,
		    &xFirst, &yFirst, NULL, &hFirst);
	    Tk_CharBbox(textPtr->textLayout, selLast,
		    &xLast, &yLast, &wLast, NULL);

	    /*
	     * If the selection spans the end of this line, then display
	     * selection background all the way to the end of the line.
	     * However, for the last line we only want to display up to the
	     * last character, not the end of the line.
	     */

	    x = xFirst;
	    height = hFirst;
	    for (y = yFirst ; y <= yLast; y += height) {
		if (y == yLast) {
		    width = (xLast + wLast) - x;
		} else {	    
		    width = textPtr->rightEdge - textPtr->leftEdge - x;
		}
		Tk_CanvasDrawableCoords(canvas,
			(double) (textPtr->leftEdge + x
				- textInfoPtr->selBorderWidth),
			(double) (textPtr->header.y1 + y),







|
|
|
|
<
|
|



|



















|
|
>

>
>
>
|
|
|
|

|
>
>
>




<
<
<
|
|
|
|












|







589
590
591
592
593
594
595
596
597
598
599

600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644



645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
 *	information in canvas.
 *
 *--------------------------------------------------------------
 */

static void
DisplayCanvText(canvas, itemPtr, display, drawable, x, y, width, height)
    Tk_Canvas canvas;		/* Canvas that contains item. */
    Tk_Item *itemPtr;		/* Item to be displayed. */
    Display *display;		/* Display on which to draw item. */
    Drawable drawable;		/* Pixmap or window in which to draw item. */

    int x, y, width, height;	/* Describes region of canvas that must be
				 * redisplayed (not used). */
{
    TextItem *textPtr;
    Tk_CanvasTextInfo *textInfoPtr;
    int selFirstChar, selLastChar;
    short drawableX, drawableY;

    textPtr = (TextItem *) itemPtr;
    textInfoPtr = textPtr->textInfoPtr;

    if (textPtr->gc == None) {
	return;
    }

    /*
     * If we're stippling, then modify the stipple offset in the GC.  Be
     * sure to reset the offset when done, since the GC is supposed to be
     * read-only.
     */

    if (textPtr->stipple != None) {
	Tk_CanvasSetStippleOrigin(canvas, textPtr->gc);
    }

    selFirstChar = -1;
    selLastChar = 0;		/* lint. */

    if (textInfoPtr->selItemPtr == itemPtr) {
	char *text;

	text = textPtr->text;
	selFirstChar = textInfoPtr->selectFirst;
	selLastChar = textInfoPtr->selectLast;
	if (selLastChar >= textPtr->numChars) {
	    selLastChar = textPtr->numChars - 1;
	}
	if ((selFirstChar >= 0) && (selFirstChar <= selLastChar)) {
	    int xFirst, yFirst, hFirst;
	    int xLast, yLast;

	    /*
	     * Draw a special background under the selection.
	     */




	    Tk_CharBbox(textPtr->textLayout, selFirstChar, &xFirst, &yFirst,
		    NULL, &hFirst);
	    Tk_CharBbox(textPtr->textLayout, selLastChar, &xLast, &yLast,
		    NULL, NULL);

	    /*
	     * If the selection spans the end of this line, then display
	     * selection background all the way to the end of the line.
	     * However, for the last line we only want to display up to the
	     * last character, not the end of the line.
	     */

	    x = xFirst;
	    height = hFirst;
	    for (y = yFirst ; y <= yLast; y += height) {
		if (y == yLast) {
		    width = xLast - x;
		} else {	    
		    width = textPtr->rightEdge - textPtr->leftEdge - x;
		}
		Tk_CanvasDrawableCoords(canvas,
			(double) (textPtr->leftEdge + x
				- textInfoPtr->selBorderWidth),
			(double) (textPtr->header.y1 + y),
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
     */

    Tk_CanvasDrawableCoords(canvas, (double) textPtr->leftEdge,
	    (double) textPtr->header.y1, &drawableX, &drawableY);
    Tk_DrawTextLayout(display, drawable, textPtr->gc, textPtr->textLayout,
	    drawableX, drawableY, 0, -1);

    if ((selFirst >= 0) && (textPtr->selTextGC != textPtr->gc)) {
	Tk_DrawTextLayout(display, drawable, textPtr->selTextGC,
	    textPtr->textLayout, drawableX, drawableY, selFirst,
	    selLast + 1);
    }

    if (textPtr->stipple != None) {
	XSetTSOrigin(display, textPtr->gc, 0, 0);
    }
}








|

|
|







725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
     */

    Tk_CanvasDrawableCoords(canvas, (double) textPtr->leftEdge,
	    (double) textPtr->header.y1, &drawableX, &drawableY);
    Tk_DrawTextLayout(display, drawable, textPtr->gc, textPtr->textLayout,
	    drawableX, drawableY, 0, -1);

    if ((selFirstChar >= 0) && (textPtr->selTextGC != textPtr->gc)) {
	Tk_DrawTextLayout(display, drawable, textPtr->selTextGC,
	    textPtr->textLayout, drawableX, drawableY, selFirstChar,
	    selLastChar + 1);
    }

    if (textPtr->stipple != None) {
	XSetTSOrigin(display, textPtr->gc, 0, 0);
    }
}

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
 *	selection positions are also modified to reflect the
 *	insertion.
 *
 *--------------------------------------------------------------
 */

static void
TextInsert(canvas, itemPtr, beforeThis, string)
    Tk_Canvas canvas;		/* Canvas containing text item. */
    Tk_Item *itemPtr;		/* Text item to be modified. */
    int beforeThis;		/* Index of character before which text is
				 * to be inserted. */
    char *string;		/* New characters to be inserted. */
{
    TextItem *textPtr = (TextItem *) itemPtr;
    int length;
    char *new;
    Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;

    length = strlen(string);
    if (length == 0) {
	return;
    }
    if (beforeThis < 0) {
	beforeThis = 0;
    }
    if (beforeThis > textPtr->numChars) {
	beforeThis = textPtr->numChars;
    }






    new = (char *) ckalloc((unsigned) (textPtr->numChars + length + 1));
    strncpy(new, textPtr->text, (size_t) beforeThis);
    strcpy(new+beforeThis, string);

    strcpy(new+beforeThis+length, textPtr->text+beforeThis);
    ckfree(textPtr->text);
    textPtr->text = new;

    textPtr->numChars += length;


    /*
     * Inserting characters invalidates indices such as those for the
     * selection and cursor.  Update the indices appropriately.
     */

    if (textInfoPtr->selItemPtr == itemPtr) {
	if (textInfoPtr->selectFirst >= beforeThis) {
	    textInfoPtr->selectFirst += length;
	}
	if (textInfoPtr->selectLast >= beforeThis) {
	    textInfoPtr->selectLast += length;
	}
	if ((textInfoPtr->anchorItemPtr == itemPtr)
		&& (textInfoPtr->selectAnchor >= beforeThis)) {
	    textInfoPtr->selectAnchor += length;
	}
    }
    if (textPtr->insertPos >= beforeThis) {
	textPtr->insertPos += length;
    }
    ComputeTextBbox(canvas, textPtr);
}

/*
 *--------------------------------------------------------------
 *







|


|




|
|


|
<
<
|
|
|

|
|

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

>
|
>







|
|

|
|


|
|


|
|







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
 *	selection positions are also modified to reflect the
 *	insertion.
 *
 *--------------------------------------------------------------
 */

static void
TextInsert(canvas, itemPtr, index, string)
    Tk_Canvas canvas;		/* Canvas containing text item. */
    Tk_Item *itemPtr;		/* Text item to be modified. */
    int index;			/* Character index before which string is
				 * to be inserted. */
    char *string;		/* New characters to be inserted. */
{
    TextItem *textPtr = (TextItem *) itemPtr;
    int byteIndex, byteCount, charsAdded;
    char *new, *text;
    Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;

    text = textPtr->text;



    if (index < 0) {
	index = 0;
    }
    if (index > textPtr->numChars) {
	index = textPtr->numChars;
    }
    byteIndex = Tcl_UtfAtIndex(text, index) - text;
    byteCount = strlen(string);
    if (byteCount == 0) {
	return;
    }

    new = (char *) ckalloc((unsigned) textPtr->numBytes + byteCount + 1);
    memcpy(new, text, (size_t) byteIndex);
    strcpy(new + byteIndex, string);
    strcpy(new + byteIndex + byteCount, text + byteIndex);

    ckfree(text);
    textPtr->text = new;
    charsAdded = Tcl_NumUtfChars(string, byteCount);
    textPtr->numChars += charsAdded;
    textPtr->numBytes += byteCount;

    /*
     * Inserting characters invalidates indices such as those for the
     * selection and cursor.  Update the indices appropriately.
     */

    if (textInfoPtr->selItemPtr == itemPtr) {
	if (textInfoPtr->selectFirst >= index) {
	    textInfoPtr->selectFirst += charsAdded;
	}
	if (textInfoPtr->selectLast >= index) {
	    textInfoPtr->selectLast += charsAdded;
	}
	if ((textInfoPtr->anchorItemPtr == itemPtr)
		&& (textInfoPtr->selectAnchor >= index)) {
	    textInfoPtr->selectAnchor += charsAdded;
	}
    }
    if (textPtr->insertPos >= index) {
	textPtr->insertPos += charsAdded;
    }
    ComputeTextBbox(canvas, textPtr);
}

/*
 *--------------------------------------------------------------
 *
826
827
828
829
830
831
832
833

834

835
836
837
838
839
840

841
842
843
844
845
846
847
848
849
850
851




852
853

854
855
856
857

858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
 *--------------------------------------------------------------
 */

static void
TextDeleteChars(canvas, itemPtr, first, last)
    Tk_Canvas canvas;		/* Canvas containing itemPtr. */
    Tk_Item *itemPtr;		/* Item in which to delete characters. */
    int first;			/* Index of first character to delete. */

    int last;			/* Index of last character to delete. */

{
    TextItem *textPtr = (TextItem *) itemPtr;
    int count;
    char *new;
    Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;


    if (first < 0) {
	first = 0;
    }
    if (last >= textPtr->numChars) {
	last = textPtr->numChars-1;
    }
    if (first > last) {
	return;
    }
    count = last + 1 - first;





    new = (char *) ckalloc((unsigned) (textPtr->numChars + 1 - count));
    strncpy(new, textPtr->text, (size_t) first);

    strcpy(new+first, textPtr->text+last+1);
    ckfree(textPtr->text);
    textPtr->text = new;
    textPtr->numChars -= count;


    /*
     * Update indexes for the selection and cursor to reflect the
     * renumbering of the remaining characters.
     */

    if (textInfoPtr->selItemPtr == itemPtr) {
	if (textInfoPtr->selectFirst > first) {
	    textInfoPtr->selectFirst -= count;
	    if (textInfoPtr->selectFirst < first) {
		textInfoPtr->selectFirst = first;
	    }
	}
	if (textInfoPtr->selectLast >= first) {
	    textInfoPtr->selectLast -= count;
	    if (textInfoPtr->selectLast < (first-1)) {
		textInfoPtr->selectLast = (first-1);
	    }
	}
	if (textInfoPtr->selectFirst > textInfoPtr->selectLast) {
	    textInfoPtr->selItemPtr = NULL;
	}
	if ((textInfoPtr->anchorItemPtr == itemPtr)
		&& (textInfoPtr->selectAnchor > first)) {
	    textInfoPtr->selectAnchor -= count;
	    if (textInfoPtr->selectAnchor < first) {
		textInfoPtr->selectAnchor = first;
	    }
	}
    }
    if (textPtr->insertPos > first) {
	textPtr->insertPos -= count;
	if (textPtr->insertPos < first) {
	    textPtr->insertPos = first;
	}
    }
    ComputeTextBbox(canvas, textPtr);
    return;
}







|
>
|
>


|
|


>




|




|

>
>
>
>
|
|
>
|
|

|
>








|





|
|
|







|






|







837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
 *--------------------------------------------------------------
 */

static void
TextDeleteChars(canvas, itemPtr, first, last)
    Tk_Canvas canvas;		/* Canvas containing itemPtr. */
    Tk_Item *itemPtr;		/* Item in which to delete characters. */
    int first;			/* Character index of first character to
				 * delete. */
    int last;			/* Character index of last character to
				 * delete (inclusive). */
{
    TextItem *textPtr = (TextItem *) itemPtr;
    int byteIndex, byteCount, charsRemoved;
    char *new, *text;
    Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;

    text = textPtr->text;
    if (first < 0) {
	first = 0;
    }
    if (last >= textPtr->numChars) {
	last = textPtr->numChars - 1;
    }
    if (first > last) {
	return;
    }
    charsRemoved = last + 1 - first;

    byteIndex = Tcl_UtfAtIndex(text, first) - text;
    byteCount = Tcl_UtfAtIndex(text + byteIndex, charsRemoved)
	- (text + byteIndex);
    
    new = (char *) ckalloc((unsigned) (textPtr->numBytes + 1 - byteCount));
    memcpy(new, text, (size_t) byteIndex);
    strcpy(new + byteIndex, text + byteIndex + byteCount);

    ckfree(text);
    textPtr->text = new;
    textPtr->numChars -= charsRemoved;
    textPtr->numBytes -= byteCount;

    /*
     * Update indexes for the selection and cursor to reflect the
     * renumbering of the remaining characters.
     */

    if (textInfoPtr->selItemPtr == itemPtr) {
	if (textInfoPtr->selectFirst > first) {
	    textInfoPtr->selectFirst -= charsRemoved;
	    if (textInfoPtr->selectFirst < first) {
		textInfoPtr->selectFirst = first;
	    }
	}
	if (textInfoPtr->selectLast >= first) {
	    textInfoPtr->selectLast -= charsRemoved;
	    if (textInfoPtr->selectLast < first - 1) {
		textInfoPtr->selectLast = first - 1;
	    }
	}
	if (textInfoPtr->selectFirst > textInfoPtr->selectLast) {
	    textInfoPtr->selItemPtr = NULL;
	}
	if ((textInfoPtr->anchorItemPtr == itemPtr)
		&& (textInfoPtr->selectAnchor > first)) {
	    textInfoPtr->selectAnchor -= charsRemoved;
	    if (textInfoPtr->selectAnchor < first) {
		textInfoPtr->selectAnchor = first;
	    }
	}
    }
    if (textPtr->insertPos > first) {
	textPtr->insertPos -= charsRemoved;
	if (textPtr->insertPos < first) {
	    textPtr->insertPos = first;
	}
    }
    ComputeTextBbox(canvas, textPtr);
    return;
}
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
 *
 *--------------------------------------------------------------
 */

	/* ARGSUSED */
static void
ScaleText(canvas, itemPtr, originX, originY, scaleX, scaleY)
    Tk_Canvas canvas;			/* Canvas containing rectangle. */
    Tk_Item *itemPtr;			/* Rectangle to be scaled. */
    double originX, originY;		/* Origin about which to scale rect. */
    double scaleX;			/* Amount to scale in X direction. */
    double scaleY;			/* Amount to scale in Y direction. */
{
    TextItem *textPtr = (TextItem *) itemPtr;

    textPtr->x = originX + scaleX*(textPtr->x - originX);
    textPtr->y = originY + scaleY*(textPtr->y - originY);
    ComputeTextBbox(canvas, textPtr);
    return;







|
|
|
|
|







1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
 *
 *--------------------------------------------------------------
 */

	/* ARGSUSED */
static void
ScaleText(canvas, itemPtr, originX, originY, scaleX, scaleY)
    Tk_Canvas canvas;		/* Canvas containing rectangle. */
    Tk_Item *itemPtr;		/* Rectangle to be scaled. */
    double originX, originY;	/* Origin about which to scale rect. */
    double scaleX;		/* Amount to scale in X direction. */
    double scaleY;		/* Amount to scale in Y direction. */
{
    TextItem *textPtr = (TextItem *) itemPtr;

    textPtr->x = originX + scaleX*(textPtr->x - originX);
    textPtr->y = originY + scaleY*(textPtr->y - originY);
    ComputeTextBbox(canvas, textPtr);
    return;
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065

1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
 *	item structure.
 *
 *--------------------------------------------------------------
 */

static void
TranslateText(canvas, itemPtr, deltaX, deltaY)
    Tk_Canvas canvas;			/* Canvas containing item. */
    Tk_Item *itemPtr;			/* Item that is being moved. */
    double deltaX, deltaY;		/* Amount by which item is to be
					 * moved. */
{
    TextItem *textPtr = (TextItem *) itemPtr;

    textPtr->x += deltaX;
    textPtr->y += deltaY;
    ComputeTextBbox(canvas, textPtr);
}

/*
 *--------------------------------------------------------------
 *
 * GetTextIndex --
 *
 *	Parse an index into a text item and return either its value
 *	or an error.
 *
 * Results:
 *	A standard Tcl result.  If all went well, then *indexPtr is
 *	filled in with the index (into itemPtr) corresponding to
 *	string.  Otherwise an error message is left in
 *	interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
GetTextIndex(interp, canvas, itemPtr, string, indexPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    Tk_Canvas canvas;		/* Canvas containing item. */
    Tk_Item *itemPtr;		/* Item for which the index is being
				 * specified. */
    char *string;		/* Specification of a particular character
				 * in itemPtr's text. */
    int *indexPtr;		/* Where to store converted index. */

{
    TextItem *textPtr = (TextItem *) itemPtr;
    size_t length;
    int c;
    TkCanvas *canvasPtr = (TkCanvas *) canvas;
    Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;

    c = string[0];
    length = strlen(string);

    if ((c == 'e') && (strncmp(string, "end", length) == 0)) {
	*indexPtr = textPtr->numChars;
    } else if ((c == 'i') && (strncmp(string, "insert", length) == 0)) {
	*indexPtr = textPtr->insertPos;
    } else if ((c == 's') && (strncmp(string, "sel.first", length) == 0)
	    && (length >= 5)) {
	if (textInfoPtr->selItemPtr != itemPtr) {
	    interp->result = "selection isn't in item";
	    return TCL_ERROR;
	}
	*indexPtr = textInfoPtr->selectFirst;
    } else if ((c == 's') && (strncmp(string, "sel.last", length) == 0)
	    && (length >= 5)) {
	if (textInfoPtr->selItemPtr != itemPtr) {
	    interp->result = "selection isn't in item";
	    return TCL_ERROR;
	}
	*indexPtr = textInfoPtr->selectLast;
    } else if (c == '@') {
	int x, y;
	double tmp;
	char *end, *p;







|
|
|
<




















|















|
>

















|






|







1038
1039
1040
1041
1042
1043
1044
1045
1046
1047

1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
 *	item structure.
 *
 *--------------------------------------------------------------
 */

static void
TranslateText(canvas, itemPtr, deltaX, deltaY)
    Tk_Canvas canvas;		/* Canvas containing item. */
    Tk_Item *itemPtr;		/* Item that is being moved. */
    double deltaX, deltaY;	/* Amount by which item is to be moved. */

{
    TextItem *textPtr = (TextItem *) itemPtr;

    textPtr->x += deltaX;
    textPtr->y += deltaY;
    ComputeTextBbox(canvas, textPtr);
}

/*
 *--------------------------------------------------------------
 *
 * GetTextIndex --
 *
 *	Parse an index into a text item and return either its value
 *	or an error.
 *
 * Results:
 *	A standard Tcl result.  If all went well, then *indexPtr is
 *	filled in with the index (into itemPtr) corresponding to
 *	string.  Otherwise an error message is left in
 *	the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
GetTextIndex(interp, canvas, itemPtr, string, indexPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    Tk_Canvas canvas;		/* Canvas containing item. */
    Tk_Item *itemPtr;		/* Item for which the index is being
				 * specified. */
    char *string;		/* Specification of a particular character
				 * in itemPtr's text. */
    int *indexPtr;		/* Where to store converted character
				 * index. */
{
    TextItem *textPtr = (TextItem *) itemPtr;
    size_t length;
    int c;
    TkCanvas *canvasPtr = (TkCanvas *) canvas;
    Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;

    c = string[0];
    length = strlen(string);

    if ((c == 'e') && (strncmp(string, "end", length) == 0)) {
	*indexPtr = textPtr->numChars;
    } else if ((c == 'i') && (strncmp(string, "insert", length) == 0)) {
	*indexPtr = textPtr->insertPos;
    } else if ((c == 's') && (strncmp(string, "sel.first", length) == 0)
	    && (length >= 5)) {
	if (textInfoPtr->selItemPtr != itemPtr) {
	    Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC);
	    return TCL_ERROR;
	}
	*indexPtr = textInfoPtr->selectFirst;
    } else if ((c == 's') && (strncmp(string, "sel.last", length) == 0)
	    && (length >= 5)) {
	if (textInfoPtr->selItemPtr != itemPtr) {
	    Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC);
	    return TCL_ERROR;
	}
	*indexPtr = textInfoPtr->selectLast;
    } else if (c == '@') {
	int x, y;
	double tmp;
	char *end, *p;
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
	if (*indexPtr < 0){
	    *indexPtr = 0;
	} else if (*indexPtr > textPtr->numChars) {
	    *indexPtr = textPtr->numChars;
	}
    } else {
	/*
	 * Some of the paths here leave messages in interp->result,
	 * so we have to clear it out before storing our own message.
	 */

	badIndex:
	Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
	Tcl_AppendResult(interp, "bad index \"", string, "\"",
		(char *) NULL);







|







1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
	if (*indexPtr < 0){
	    *indexPtr = 0;
	} else if (*indexPtr > textPtr->numChars) {
	    *indexPtr = textPtr->numChars;
	}
    } else {
	/*
	 * Some of the paths here leave messages in the interp's result,
	 * so we have to clear it out before storing our own message.
	 */

	badIndex:
	Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
	Tcl_AppendResult(interp, "bad index \"", string, "\"",
		(char *) NULL);
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
 *
 *--------------------------------------------------------------
 */

	/* ARGSUSED */
static void
SetTextCursor(canvas, itemPtr, index)
    Tk_Canvas canvas;			/* Record describing canvas widget. */
    Tk_Item *itemPtr;			/* Text item in which cursor position
					 * is to be set. */
    int index;				/* Index of character just before which
					 * cursor is to be positioned. */
{
    TextItem *textPtr = (TextItem *) itemPtr;

    if (index < 0) {
	textPtr->insertPos = 0;
    } else  if (index > textPtr->numChars) {
	textPtr->insertPos = textPtr->numChars;







|
|
|
|
|







1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
 *
 *--------------------------------------------------------------
 */

	/* ARGSUSED */
static void
SetTextCursor(canvas, itemPtr, index)
    Tk_Canvas canvas;		/* Record describing canvas widget. */
    Tk_Item *itemPtr;		/* Text item in which cursor position is to
				 * be set. */
    int index;			/* Character index of character just before
				 * which cursor is to be positioned. */
{
    TextItem *textPtr = (TextItem *) itemPtr;

    if (index < 0) {
	textPtr->insertPos = 0;
    } else  if (index > textPtr->numChars) {
	textPtr->insertPos = textPtr->numChars;
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205

1206
1207
1208
1209
1210
1211





1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
GetSelText(canvas, itemPtr, offset, buffer, maxBytes)
    Tk_Canvas canvas;			/* Canvas containing selection. */
    Tk_Item *itemPtr;			/* Text item containing selection. */
    int offset;				/* Offset within selection of first
					 * character to be returned. */
    char *buffer;			/* Location in which to place
					 * selection. */
    int maxBytes;			/* Maximum number of bytes to place
					 * at buffer, not including terminating
					 * NULL character. */
{
    TextItem *textPtr = (TextItem *) itemPtr;
    int count;

    Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;

    count = textInfoPtr->selectLast + 1 - textInfoPtr->selectFirst - offset;
    if (textInfoPtr->selectLast == textPtr->numChars) {
	count -= 1;
    }





    if (count > maxBytes) {
	count = maxBytes;
    }
    if (count <= 0) {
	return 0;
    }
    strncpy(buffer, textPtr->text + textInfoPtr->selectFirst + offset,
	    (size_t) count);
    buffer[count] = '\0';
    return count;
}

/*
 *--------------------------------------------------------------
 *
 * TextToPostscript --
 *
 *	This procedure is called to generate Postscript for
 *	text items.
 *
 * Results:
 *	The return value is a standard Tcl result.  If an error
 *	occurs in generating Postscript then an error message is
 *	left in interp->result, replacing whatever used
 *	to be there.  If no error occurs, then Postscript for the
 *	item is appended to the result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
TextToPostscript(interp, canvas, itemPtr, prepass)
    Tcl_Interp *interp;			/* Leave Postscript or error message
					 * here. */
    Tk_Canvas canvas;			/* Information about overall canvas. */
    Tk_Item *itemPtr;			/* Item for which Postscript is
					 * wanted. */
    int prepass;			/* 1 means this is a prepass to
					 * collect font information;  0 means
					 * final Postscript is being created. */
{
    TextItem *textPtr = (TextItem *) itemPtr;
    int x, y;
    Tk_FontMetrics fm;
    char *justify;
    char buffer[500];








|
|
|
|
|
<
|
|
|


|
>


|
|
|

>
>
>
>
>
|
|

|


<
|
|
|













|











|
<
|
|
<
|
|
|







1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218

1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242

1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271

1272
1273

1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
GetSelText(canvas, itemPtr, offset, buffer, maxBytes)
    Tk_Canvas canvas;		/* Canvas containing selection. */
    Tk_Item *itemPtr;		/* Text item containing selection. */
    int offset;			/* Byte offset within selection of first
				 * character to be returned. */
    char *buffer;		/* Location in which to place selection. */

    int maxBytes;		/* Maximum number of bytes to place at
				 * buffer, not including terminating NULL
				 * character. */
{
    TextItem *textPtr = (TextItem *) itemPtr;
    int byteCount; 
    char *text, *selStart, *selEnd;
    Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;

    if ((textInfoPtr->selectFirst < 0) ||
	    (textInfoPtr->selectFirst > textInfoPtr->selectLast)) {
	return 0;
    }
    text = textPtr->text;
    selStart = Tcl_UtfAtIndex(text, textInfoPtr->selectFirst);
    selEnd = Tcl_UtfAtIndex(selStart,
	    textInfoPtr->selectLast + 1 - textInfoPtr->selectFirst);
    byteCount = selEnd - selStart - offset;
    if (byteCount > maxBytes) {
	byteCount = maxBytes;
    }
    if (byteCount <= 0) {
	return 0;
    }

    memcpy(buffer, selStart + offset, (size_t) byteCount);
    buffer[byteCount] = '\0';
    return byteCount;
}

/*
 *--------------------------------------------------------------
 *
 * TextToPostscript --
 *
 *	This procedure is called to generate Postscript for
 *	text items.
 *
 * Results:
 *	The return value is a standard Tcl result.  If an error
 *	occurs in generating Postscript then an error message is
 *	left in the interp's result, replacing whatever used
 *	to be there.  If no error occurs, then Postscript for the
 *	item is appended to the result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
TextToPostscript(interp, canvas, itemPtr, prepass)
    Tcl_Interp *interp;		/* Leave Postscript or error message here. */

    Tk_Canvas canvas;		/* Information about overall canvas. */
    Tk_Item *itemPtr;		/* Item for which Postscript is wanted. */

    int prepass;		/* 1 means this is a prepass to collect
				 * font information; 0 means final Postscript
				 * is being created. */
{
    TextItem *textPtr = (TextItem *) itemPtr;
    int x, y;
    Tk_FontMetrics fm;
    char *justify;
    char buffer[500];

Changes to generic/tkCanvUtil.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkCanvUtil.c --
 *
 *	This procedure contains a collection of utility procedures
 *	used by the implementations of various canvas item types.
 *
 * Copyright (c) 1994 Sun Microsystems, Inc.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkCanvUtil.c 1.7 96/05/03 10:54:22
 */

#include "tk.h"
#include "tkCanvas.h"
#include "tkPort.h"














|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkCanvUtil.c --
 *
 *	This procedure contains a collection of utility procedures
 *	used by the implementations of various canvas item types.
 *
 * Copyright (c) 1994 Sun Microsystems, Inc.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkCanvUtil.c,v 1.1.4.2 1998/09/30 02:16:47 stanton Exp $
 */

#include "tk.h"
#include "tkCanvas.h"
#include "tkPort.h"


173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
 *	corresponding to that string.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	canvas coordinate is stored at *doublePtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */








|







173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
 *	corresponding to that string.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	canvas coordinate is stored at *doublePtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

Changes to generic/tkCanvWind.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkCanvWind.c --
 *
 *	This file implements window items for canvas widgets.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkCanvWind.c 1.29 97/10/14 10:40:54
 */

#include <stdio.h>
#include "tkInt.h"
#include "tkPort.h"
#include "tkCanvas.h"












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkCanvWind.c --
 *
 *	This file implements window items for canvas widgets.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkCanvWind.c,v 1.1.4.2 1998/09/30 02:16:47 stanton Exp $
 */

#include <stdio.h>
#include "tkInt.h"
#include "tkPort.h"
#include "tkCanvas.h"

143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
 *
 *	This procedure is invoked to create a new window
 *	item in a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item, then an error message is left in
 *	interp->result;  in this case itemPtr is
 *	left uninitialized, so it can be safely freed by the
 *	caller.
 *
 * Side effects:
 *	A new window item is created.
 *
 *--------------------------------------------------------------







|







143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
 *
 *	This procedure is invoked to create a new window
 *	item in a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item, then an error message is left in
 *	the interp's result;  in this case itemPtr is
 *	left uninitialized, so it can be safely freed by the
 *	caller.
 *
 * Side effects:
 *	A new window item is created.
 *
 *--------------------------------------------------------------
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
 * WinItemCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on window items.  See the user documentation for
 *	details on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets interp->result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */








|







210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
 * WinItemCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on window items.  See the user documentation for
 *	details on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets the interp's result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */

244
245
246
247
248
249
250

251
252

253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
	if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &winItemPtr->x)
		!= TCL_OK) || (Tk_CanvasGetCoord(interp, canvas, argv[1],
		&winItemPtr->y) != TCL_OK)) {
	    return TCL_ERROR;
	}
	ComputeWindowBbox(canvas, winItemPtr);
    } else {

	sprintf(interp->result,
		"wrong # coordinates: expected 0 or 2, got %d", argc);

	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ConfigureWinItem --
 *
 *	This procedure is invoked to configure various aspects
 *	of a window item, such as its anchor position.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in interp->result.
 *
 * Side effects:
 *	Configuration information may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */








>
|
|
>















|







244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
	if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &winItemPtr->x)
		!= TCL_OK) || (Tk_CanvasGetCoord(interp, canvas, argv[1],
		&winItemPtr->y) != TCL_OK)) {
	    return TCL_ERROR;
	}
	ComputeWindowBbox(canvas, winItemPtr);
    } else {
	char buf[64 + TCL_INTEGER_SPACE];

	sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ConfigureWinItem --
 *
 *	This procedure is invoked to configure various aspects
 *	of a window item, such as its anchor position.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in the interp's result.
 *
 * Side effects:
 *	Configuration information may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */

Changes to generic/tkCanvas.c.

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
/* 
 * tkCanvas.c --
 *
 *	This module implements canvas widgets for the Tk toolkit.
 *	A canvas displays a background and a collection of graphical
 *	objects such as rectangles, lines, and texts.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkCanvas.c 1.126 97/07/31 09:05:52
 */

#include "default.h"
#include "tkInt.h"
#include "tkPort.h"
#include "tkCanvas.h"

/*
 * See tkCanvas.h for key data structures used to implement canvases.
 */

/*
 * The structure defined below is used to keep track of a tag search
 * in progress.  Only the "prevPtr" field should be accessed by anyone
 * other than StartTagSearch and NextItem.
 */

typedef struct TagSearch {
    TkCanvas *canvasPtr;	/* Canvas widget being searched. */
    Tk_Uid tag;			/* Tag to search for.   0 means return
				 * all items. */
    Tk_Item *prevPtr;		/* Item just before last one found (or NULL
				 * if last one found was first in the item
				 * list of canvasPtr). */
    Tk_Item *currentPtr;	/* Pointer to last item returned. */




    int searchOver;		/* Non-zero means NextItem should always
				 * return NULL. */
} TagSearch;

/*
 * Information used for argv parsing.
 */








|
>




|













|
|






<
<
<

>
>
>
>







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
/* 
 * tkCanvas.c --
 *
 *	This module implements canvas widgets for the Tk toolkit.
 *	A canvas displays a background and a collection of graphical
 *	objects such as rectangles, lines, and texts.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkCanvas.c,v 1.1.4.5 1999/02/16 11:39:30 lfb Exp $
 */

#include "default.h"
#include "tkInt.h"
#include "tkPort.h"
#include "tkCanvas.h"

/*
 * See tkCanvas.h for key data structures used to implement canvases.
 */

/*
 * The structure defined below is used to keep track of a tag search
 * in progress.  No field should be accessed by anyone other than
 * StartTagSearch and NextItem.
 */

typedef struct TagSearch {
    TkCanvas *canvasPtr;	/* Canvas widget being searched. */
    Tk_Uid tag;			/* Tag to search for.   0 means return
				 * all items. */



    Tk_Item *currentPtr;	/* Pointer to last item returned. */
    Tk_Item *lastPtr;		/* The item right before the currentPtr
				 * is tracked so if the currentPtr is
				 * deleted we don't have to start from the
				 * beginning. */
    int searchOver;		/* Non-zero means NextItem should always
				 * return NULL. */
} TagSearch;

/*
 * Information used for argv parsing.
 */
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
 * Standard item types provided by Tk:
 */

extern Tk_ItemType tkArcType, tkBitmapType, tkImageType, tkLineType;
extern Tk_ItemType tkOvalType, tkPolygonType;
extern Tk_ItemType tkRectangleType, tkTextType, tkWindowType;

/*
 * Various Tk_Uid's used by this module (set up during initialization):
 */

static Tk_Uid allUid = NULL;
static Tk_Uid currentUid = NULL;

/*
 * Statistics counters:
 */

static int numIdSearches;
static int numSlowSearches;

/*
 * Prototypes for procedures defined later in this file:
 */

static void		CanvasBindProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		CanvasBlinkProc _ANSI_ARGS_((ClientData clientData));







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







147
148
149
150
151
152
153














154
155
156
157
158
159
160
 * Standard item types provided by Tk:
 */

extern Tk_ItemType tkArcType, tkBitmapType, tkImageType, tkLineType;
extern Tk_ItemType tkOvalType, tkPolygonType;
extern Tk_ItemType tkRectangleType, tkTextType, tkWindowType;















/*
 * Prototypes for procedures defined later in this file:
 */

static void		CanvasBindProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		CanvasBlinkProc _ANSI_ARGS_((ClientData clientData));
349
350
351
352
353
354
355

356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
    canvasPtr->cursor = None;
    canvasPtr->takeFocus = NULL;
    canvasPtr->pixelsPerMM = WidthOfScreen(Tk_Screen(new));
    canvasPtr->pixelsPerMM /= WidthMMOfScreen(Tk_Screen(new));
    canvasPtr->flags = 0;
    canvasPtr->nextId = 1;
    canvasPtr->psInfoPtr = NULL;


    Tk_SetClass(canvasPtr->tkwin, "Canvas");
    TkSetClassProcs(canvasPtr->tkwin, &canvasClass, (ClientData) canvasPtr);
    Tk_CreateEventHandler(canvasPtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    CanvasEventProc, (ClientData) canvasPtr);
    Tk_CreateEventHandler(canvasPtr->tkwin, KeyPressMask|KeyReleaseMask
	    |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
	    |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
	    CanvasBindProc, (ClientData) canvasPtr);
    Tk_CreateSelHandler(canvasPtr->tkwin, XA_PRIMARY, XA_STRING,
	    CanvasFetchSelection, (ClientData) canvasPtr, XA_STRING);
    if (ConfigureCanvas(interp, canvasPtr, argc-2, argv+2, 0) != TCL_OK) {
	goto error;
    }

    interp->result = Tk_PathName(canvasPtr->tkwin);
    return TCL_OK;

    error:
    Tk_DestroyWindow(canvasPtr->tkwin);
    return TCL_ERROR;
}








>
















|







337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
    canvasPtr->cursor = None;
    canvasPtr->takeFocus = NULL;
    canvasPtr->pixelsPerMM = WidthOfScreen(Tk_Screen(new));
    canvasPtr->pixelsPerMM /= WidthMMOfScreen(Tk_Screen(new));
    canvasPtr->flags = 0;
    canvasPtr->nextId = 1;
    canvasPtr->psInfoPtr = NULL;
    Tcl_InitHashTable(&canvasPtr->idTable, TCL_ONE_WORD_KEYS);

    Tk_SetClass(canvasPtr->tkwin, "Canvas");
    TkSetClassProcs(canvasPtr->tkwin, &canvasClass, (ClientData) canvasPtr);
    Tk_CreateEventHandler(canvasPtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    CanvasEventProc, (ClientData) canvasPtr);
    Tk_CreateEventHandler(canvasPtr->tkwin, KeyPressMask|KeyReleaseMask
	    |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
	    |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
	    CanvasBindProc, (ClientData) canvasPtr);
    Tk_CreateSelHandler(canvasPtr->tkwin, XA_PRIMARY, XA_STRING,
	    CanvasFetchSelection, (ClientData) canvasPtr, XA_STRING);
    if (ConfigureCanvas(interp, canvasPtr, argc-2, argv+2, 0) != TCL_OK) {
	goto error;
    }

    Tcl_SetResult(interp, Tk_PathName(canvasPtr->tkwin), TCL_STATIC);
    return TCL_OK;

    error:
    Tk_DestroyWindow(canvasPtr->tkwin);
    return TCL_ERROR;
}

468
469
470
471
472
473
474


475

476
477
478
479
480
481
482
		    if (itemPtr->y2 > y2) {
			y2 = itemPtr->y2;
		    }
		}
	    }
	}
	if (gotAny) {


	    sprintf(interp->result, "%d %d %d %d", x1, y1, x2, y2);

	}
    } else if ((c == 'b') && (strncmp(argv[1], "bind", length) == 0)
	    && (length >= 2)) {
	ClientData object;

	if ((argc < 3) || (argc > 5)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",







>
>
|
>







457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
		    if (itemPtr->y2 > y2) {
			y2 = itemPtr->y2;
		    }
		}
	    }
	}
	if (gotAny) {
	    char buf[TCL_INTEGER_SPACE * 4];
	    
	    sprintf(buf, "%d %d %d %d", x1, y1, x2, y2);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	}
    } else if ((c == 'b') && (strncmp(argv[1], "bind", length) == 0)
	    && (length >= 2)) {
	ClientData object;

	if ((argc < 3) || (argc > 5)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
490
491
492
493
494
495
496

497
498
499
500
501

502
503
504
505
506
507
508
509
510
511
512
513
514
515
	 * item vs. tag).
	 */

	object = 0;
	if (isdigit(UCHAR(argv[2][0]))) {
	    int id;
	    char *end;


	    id = strtoul(argv[2], &end, 0);
	    if (*end != 0) {
		goto bindByTag;
	    }

	    for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
		    itemPtr = itemPtr->nextPtr) {
		if (itemPtr->id == id) {
		    object = (ClientData) itemPtr;
		    break;
		}
	    }
	    if (object == 0) {
		Tcl_AppendResult(interp, "item \"", argv[2],
			"\" doesn't exist", (char *) NULL);
		goto error;
	    }
	} else {
	    bindByTag:







>





>
|
|
<
|
<
|
|







482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497

498

499
500
501
502
503
504
505
506
507
	 * item vs. tag).
	 */

	object = 0;
	if (isdigit(UCHAR(argv[2][0]))) {
	    int id;
	    char *end;
	    Tcl_HashEntry *entryPtr;

	    id = strtoul(argv[2], &end, 0);
	    if (*end != 0) {
		goto bindByTag;
	    }
	    entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id);
	    if (entryPtr != NULL) {
		itemPtr = (Tk_Item *) Tcl_GetHashValue(entryPtr);

		object = (ClientData) itemPtr;

	    }

	    if (object == 0) {
		Tcl_AppendResult(interp, "item \"", argv[2],
			"\" doesn't exist", (char *) NULL);
		goto error;
	    }
	} else {
	    bindByTag:
558
559
560
561
562
563
564










565


566

567

568
569
570
571
572
573

574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593

594
595
596

597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616

617
618
619
620
621
622
623
	    }
	} else if (argc == 4) {
	    char *command;
    
	    command = Tk_GetBinding(interp, canvasPtr->bindingTable,
		    object, argv[3]);
	    if (command == NULL) {










		goto error;


	    }

	    interp->result = command;

	} else {
	    Tk_GetAllBindings(interp, canvasPtr->bindingTable, object);
	}
    } else if ((c == 'c') && (strcmp(argv[1], "canvasx") == 0)) {
	int x;
	double grid;


	if ((argc < 3) || (argc > 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " canvasx screenx ?gridspacing?\"",
		    (char *) NULL);
	    goto error;
	}
	if (Tk_GetPixels(interp, canvasPtr->tkwin, argv[2], &x) != TCL_OK) {
	    goto error;
	}
	if (argc == 4) {
	    if (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3],
		    &grid) != TCL_OK) {
		goto error;
	    }
	} else {
	    grid = 0.0;
	}
	x += canvasPtr->xOrigin;
	Tcl_PrintDouble(interp, GridAlign((double) x, grid), interp->result);

    } else if ((c == 'c') && (strcmp(argv[1], "canvasy") == 0)) {
	int y;
	double grid;


	if ((argc < 3) || (argc > 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " canvasy screeny ?gridspacing?\"",
		    (char *) NULL);
	    goto error;
	}
	if (Tk_GetPixels(interp, canvasPtr->tkwin, argv[2], &y) != TCL_OK) {
	    goto error;
	}
	if (argc == 4) {
	    if (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr,
		    argv[3], &grid) != TCL_OK) {
		goto error;
	    }
	} else {
	    grid = 0.0;
	}
	y += canvasPtr->yOrigin;
	Tcl_PrintDouble(interp, GridAlign((double) y, grid), interp->result);

    } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " cget option\"",
		    (char *) NULL);
	    goto error;







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






>



















|
>



>



















|
>







550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
	    }
	} else if (argc == 4) {
	    char *command;
    
	    command = Tk_GetBinding(interp, canvasPtr->bindingTable,
		    object, argv[3]);
	    if (command == NULL) {
		char *string;

		string = Tcl_GetStringResult(interp); 
		/*
		 * Ignore missing binding errors.  This is a special hack
		 * that relies on the error message returned by FindSequence
		 * in tkBind.c.
		 */

		if (string[0] != '\0') {
		    goto error;
		} else {
		    Tcl_ResetResult(interp);
		}
	    } else {
		Tcl_SetResult(interp, command, TCL_STATIC);
	    }
	} else {
	    Tk_GetAllBindings(interp, canvasPtr->bindingTable, object);
	}
    } else if ((c == 'c') && (strcmp(argv[1], "canvasx") == 0)) {
	int x;
	double grid;
	char buf[TCL_DOUBLE_SPACE];

	if ((argc < 3) || (argc > 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " canvasx screenx ?gridspacing?\"",
		    (char *) NULL);
	    goto error;
	}
	if (Tk_GetPixels(interp, canvasPtr->tkwin, argv[2], &x) != TCL_OK) {
	    goto error;
	}
	if (argc == 4) {
	    if (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3],
		    &grid) != TCL_OK) {
		goto error;
	    }
	} else {
	    grid = 0.0;
	}
	x += canvasPtr->xOrigin;
	Tcl_PrintDouble(interp, GridAlign((double) x, grid), buf);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'c') && (strcmp(argv[1], "canvasy") == 0)) {
	int y;
	double grid;
	char buf[TCL_DOUBLE_SPACE];

	if ((argc < 3) || (argc > 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " canvasy screeny ?gridspacing?\"",
		    (char *) NULL);
	    goto error;
	}
	if (Tk_GetPixels(interp, canvasPtr->tkwin, argv[2], &y) != TCL_OK) {
	    goto error;
	}
	if (argc == 4) {
	    if (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr,
		    argv[3], &grid) != TCL_OK) {
		goto error;
	    }
	} else {
	    grid = 0.0;
	}
	y += canvasPtr->yOrigin;
	Tcl_PrintDouble(interp, GridAlign((double) y, grid), buf);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " cget option\"",
		    (char *) NULL);
	    goto error;
660
661
662
663
664
665
666



667
668
669
670
671
672
673
	    }
	}
    } else if ((c == 'c') && (strncmp(argv[1], "create", length) == 0)
	    && (length >= 2)) {
	Tk_ItemType *typePtr;
	Tk_ItemType *matchPtr = NULL;
	Tk_Item *itemPtr;




	if (argc < 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " create type ?arg arg ...?\"", (char *) NULL);
	    goto error;
	}
	c = argv[2][0];







>
>
>







670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
	    }
	}
    } else if ((c == 'c') && (strncmp(argv[1], "create", length) == 0)
	    && (length >= 2)) {
	Tk_ItemType *typePtr;
	Tk_ItemType *matchPtr = NULL;
	Tk_Item *itemPtr;
	char buf[TCL_INTEGER_SPACE];
	int isNew = 0;
	Tcl_HashEntry *entryPtr;

	if (argc < 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " create type ?arg arg ...?\"", (char *) NULL);
	    goto error;
	}
	c = argv[2][0];
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
	itemPtr->typePtr = typePtr;
	if ((*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr,
		itemPtr, argc-3, argv+3) != TCL_OK) {
	    ckfree((char *) itemPtr);
	    goto error;
	}
	itemPtr->nextPtr = NULL;




	canvasPtr->hotPtr = itemPtr;
	canvasPtr->hotPrevPtr = canvasPtr->lastItemPtr;
	if (canvasPtr->lastItemPtr == NULL) {
	    canvasPtr->firstItemPtr = itemPtr;
	} else {
	    canvasPtr->lastItemPtr->nextPtr = itemPtr;
	}
	canvasPtr->lastItemPtr = itemPtr;
	Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
		itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
	canvasPtr->flags |= REPICK_NEEDED;
	sprintf(interp->result, "%d", itemPtr->id);

    } else if ((c == 'd') && (strncmp(argv[1], "dchars", length) == 0)
	    && (length >= 2)) {
	int first, last;

	if ((argc != 4) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " dchars tagOrId first ?last?\"",







>
>
>
>











|
>







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
	itemPtr->typePtr = typePtr;
	if ((*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr,
		itemPtr, argc-3, argv+3) != TCL_OK) {
	    ckfree((char *) itemPtr);
	    goto error;
	}
	itemPtr->nextPtr = NULL;
	entryPtr = Tcl_CreateHashEntry(&canvasPtr->idTable,
		(char *) itemPtr->id, &isNew);
	Tcl_SetHashValue(entryPtr, itemPtr);
	itemPtr->prevPtr = canvasPtr->lastItemPtr;
	canvasPtr->hotPtr = itemPtr;
	canvasPtr->hotPrevPtr = canvasPtr->lastItemPtr;
	if (canvasPtr->lastItemPtr == NULL) {
	    canvasPtr->firstItemPtr = itemPtr;
	} else {
	    canvasPtr->lastItemPtr->nextPtr = itemPtr;
	}
	canvasPtr->lastItemPtr = itemPtr;
	Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
		itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
	canvasPtr->flags |= REPICK_NEEDED;
	sprintf(buf, "%d", itemPtr->id);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'd') && (strncmp(argv[1], "dchars", length) == 0)
	    && (length >= 2)) {
	int first, last;

	if ((argc != 4) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " dchars tagOrId first ?last?\"",
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
		    itemPtr, first, last);
	    Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
		    itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
	}
    } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)
	    && (length >= 2)) {
	int i;


	for (i = 2; i < argc; i++) {
	    for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
		itemPtr != NULL; itemPtr = NextItem(&search)) {
		Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
			itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
		if (canvasPtr->bindingTable != NULL) {
		    Tk_DeleteAllBindings(canvasPtr->bindingTable,
			    (ClientData) itemPtr);
		}
		(*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr,
			canvasPtr->display);
		if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
		    ckfree((char *) itemPtr->tagPtr);
		}



		if (search.prevPtr == NULL) {






		    canvasPtr->firstItemPtr = itemPtr->nextPtr;
		    if (canvasPtr->firstItemPtr == NULL) {
			canvasPtr->lastItemPtr = NULL;
		    }
		} else {
		    search.prevPtr->nextPtr = itemPtr->nextPtr;
		}
		if (canvasPtr->lastItemPtr == itemPtr) {
		    canvasPtr->lastItemPtr = search.prevPtr;
		}
		ckfree((char *) itemPtr);
		if (itemPtr == canvasPtr->currentItemPtr) {
		    canvasPtr->currentItemPtr = NULL;
		    canvasPtr->flags |= REPICK_NEEDED;
		}
		if (itemPtr == canvasPtr->newCurrentPtr) {







>















>
>
>
|
>
>
>
>
>
>




<
<


|







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
		    itemPtr, first, last);
	    Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
		    itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
	}
    } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)
	    && (length >= 2)) {
	int i;
	Tcl_HashEntry *entryPtr;

	for (i = 2; i < argc; i++) {
	    for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
		itemPtr != NULL; itemPtr = NextItem(&search)) {
		Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
			itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
		if (canvasPtr->bindingTable != NULL) {
		    Tk_DeleteAllBindings(canvasPtr->bindingTable,
			    (ClientData) itemPtr);
		}
		(*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr,
			canvasPtr->display);
		if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
		    ckfree((char *) itemPtr->tagPtr);
		}
		entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable,
			(char *) itemPtr->id);
		Tcl_DeleteHashEntry(entryPtr);
		if (itemPtr->nextPtr != NULL) {
		    itemPtr->nextPtr->prevPtr = itemPtr->prevPtr;
		}
		if (itemPtr->prevPtr != NULL) {
		    itemPtr->prevPtr->nextPtr = itemPtr->nextPtr;
		}
		if (canvasPtr->firstItemPtr == itemPtr) {
		    canvasPtr->firstItemPtr = itemPtr->nextPtr;
		    if (canvasPtr->firstItemPtr == NULL) {
			canvasPtr->lastItemPtr = NULL;
		    }


		}
		if (canvasPtr->lastItemPtr == itemPtr) {
		    canvasPtr->lastItemPtr = itemPtr->prevPtr;
		}
		ckfree((char *) itemPtr);
		if (itemPtr == canvasPtr->currentItemPtr) {
		    canvasPtr->currentItemPtr = NULL;
		    canvasPtr->flags |= REPICK_NEEDED;
		}
		if (itemPtr == canvasPtr->newCurrentPtr) {
849
850
851
852
853
854
855


856

857
858
859
860
861
862
863
		    argv[0], " focus ?tagOrId?\"",
		    (char *) NULL);
	    goto error;
	}
	itemPtr = canvasPtr->textInfo.focusItemPtr;
	if (argc == 2) {
	    if (itemPtr != NULL) {


		sprintf(interp->result, "%d", itemPtr->id);

	    }
	    goto done;
	}
	if ((itemPtr != NULL) && (canvasPtr->textInfo.gotFocus)) {
	    Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
		    itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
	}







>
>
|
>







875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
		    argv[0], " focus ?tagOrId?\"",
		    (char *) NULL);
	    goto error;
	}
	itemPtr = canvasPtr->textInfo.focusItemPtr;
	if (argc == 2) {
	    if (itemPtr != NULL) {
		char buf[TCL_INTEGER_SPACE];
		
		sprintf(buf, "%d", itemPtr->id);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    }
	    goto done;
	}
	if ((itemPtr != NULL) && (canvasPtr->textInfo.gotFocus)) {
	    Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
		    itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
	}
919
920
921
922
923
924
925

926
927
928
929
930
931
932
		Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
			itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
	    && (length >= 3)) {
	int index;


	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " index tagOrId string\"",
		    (char *) NULL);
	    goto error;
	}







>







948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
		Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
			itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
	    && (length >= 3)) {
	int index;
	char buf[TCL_INTEGER_SPACE];

	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " index tagOrId string\"",
		    (char *) NULL);
	    goto error;
	}
941
942
943
944
945
946
947
948

949
950
951
952
953
954
955
		    argv[2], "\"", (char *) NULL);
	    goto error;
	}
	if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr,
		itemPtr, argv[3], &index) != TCL_OK) {
	    goto error;
	}
	sprintf(interp->result, "%d", index);

    } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
	    && (length >= 3)) {
	int beforeThis;

	if (argc != 5) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " insert tagOrId beforeThis string\"",







|
>







971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
		    argv[2], "\"", (char *) NULL);
	    goto error;
	}
	if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr,
		itemPtr, argv[3], &index) != TCL_OK) {
	    goto error;
	}
	sprintf(buf, "%d", index);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
	    && (length >= 3)) {
	int beforeThis;

	if (argc != 5) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " insert tagOrId beforeThis string\"",
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054

1055
1056
1057
1058
1059
1060
1061
1062
1063
		canvasPtr->flags |= REPICK_NEEDED;
	    }
	    if ((result != TCL_OK) || (argc < 5)) {
		break;
	    }
	}
    } else if ((c == 'l') && (strncmp(argv[1], "lower", length) == 0)) {
	Tk_Item *prevPtr;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " lower tagOrId ?belowThis?\"",
		    (char *) NULL);
	    goto error;
	}

	/*
	 * First find the item just after which we'll insert the
	 * named items.
	 */

	if (argc == 3) {
	    prevPtr = NULL;
	} else {
	    prevPtr = StartTagSearch(canvasPtr, argv[3], &search);
	    if (prevPtr != NULL) {
		prevPtr = search.prevPtr;
	    } else {
		Tcl_AppendResult(interp, "tag \"", argv[3],
			"\" doesn't match any items", (char *) NULL);
		goto error;
	    }

	}
	RelinkItems(canvasPtr, argv[2], prevPtr);
    } else if ((c == 'm') && (strncmp(argv[1], "move", length) == 0)) {
	double xAmount, yAmount;

	if (argc != 5) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " move tagOrId xAmount yAmount\"",
		    (char *) NULL);







|














|

|
|
<
<




>

|







1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079


1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
		canvasPtr->flags |= REPICK_NEEDED;
	    }
	    if ((result != TCL_OK) || (argc < 5)) {
		break;
	    }
	}
    } else if ((c == 'l') && (strncmp(argv[1], "lower", length) == 0)) {
	Tk_Item *itemPtr;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " lower tagOrId ?belowThis?\"",
		    (char *) NULL);
	    goto error;
	}

	/*
	 * First find the item just after which we'll insert the
	 * named items.
	 */

	if (argc == 3) {
	    itemPtr = NULL;
	} else {
	    itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
	    if (itemPtr == NULL) {


		Tcl_AppendResult(interp, "tag \"", argv[3],
			"\" doesn't match any items", (char *) NULL);
		goto error;
	    }
	    itemPtr = itemPtr->prevPtr;
	}
	RelinkItems(canvasPtr, argv[2], itemPtr);
    } else if ((c == 'm') && (strncmp(argv[1], "move", length) == 0)) {
	double xAmount, yAmount;

	if (argc != 5) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " move tagOrId xAmount yAmount\"",
		    (char *) NULL);
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
		|| (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr,
		    argv[4], &yOrigin) != TCL_OK)
		|| (Tcl_GetDouble(interp, argv[5], &xScale) != TCL_OK)
		|| (Tcl_GetDouble(interp, argv[6], &yScale) != TCL_OK)) {
	    goto error;
	}
	if ((xScale == 0.0) || (yScale == 0.0)) {
	    interp->result = "scale factor cannot be zero";
	    goto error;
	}
	for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
		itemPtr != NULL; itemPtr = NextItem(&search)) {
	    Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
		    itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
	    (void) (*itemPtr->typePtr->scaleProc)((Tk_Canvas) canvasPtr,







|







1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
		|| (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr,
		    argv[4], &yOrigin) != TCL_OK)
		|| (Tcl_GetDouble(interp, argv[5], &xScale) != TCL_OK)
		|| (Tcl_GetDouble(interp, argv[6], &yScale) != TCL_OK)) {
	    goto error;
	}
	if ((xScale == 0.0) || (yScale == 0.0)) {
	    Tcl_SetResult(interp, "scale factor cannot be zero", TCL_STATIC);
	    goto error;
	}
	for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
		itemPtr != NULL; itemPtr = NextItem(&search)) {
	    Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
		    itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
	    (void) (*itemPtr->typePtr->scaleProc)((Tk_Canvas) canvasPtr,
1260
1261
1262
1263
1264
1265
1266

1267
1268

1269
1270
1271
1272
1273
1274
1275
	} else if ((c == 'i') && (strncmp(argv[2], "item", length) == 0)) {
	    if (argc != 3) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
			argv[0], " select item\"", (char *) NULL);
		goto error;
	    }
	    if (canvasPtr->textInfo.selItemPtr != NULL) {

		sprintf(interp->result, "%d",
			canvasPtr->textInfo.selItemPtr->id);

	    }
	} else if ((c == 't') && (strncmp(argv[2], "to", length) == 0)) {
	    if (argc != 5) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
			argv[0], " select to tagOrId index\"",
			(char *) NULL);
		goto error;







>
|
|
>







1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
	} else if ((c == 'i') && (strncmp(argv[2], "item", length) == 0)) {
	    if (argc != 3) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
			argv[0], " select item\"", (char *) NULL);
		goto error;
	    }
	    if (canvasPtr->textInfo.selItemPtr != NULL) {
		char buf[TCL_INTEGER_SPACE];
		
		sprintf(buf, "%d", canvasPtr->textInfo.selItemPtr->id);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    }
	} else if ((c == 't') && (strncmp(argv[2], "to", length) == 0)) {
	    if (argc != 5) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
			argv[0], " select to tagOrId index\"",
			(char *) NULL);
		goto error;
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " type tag\"", (char *) NULL);
	    goto error;
	}
	itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
	if (itemPtr != NULL) {
	    interp->result = itemPtr->typePtr->name;
	}
    } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
	int count, type;
	int newX = 0;		/* Initialization needed only to prevent
				 * gcc warnings. */
	double fraction;

	if (argc == 2) {
	    PrintScrollFractions(canvasPtr->xOrigin + canvasPtr->inset,
		    canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)
		    - canvasPtr->inset, canvasPtr->scrollX1,
		    canvasPtr->scrollX2, interp->result);
	} else {
	    type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
	    switch (type) {
		case TK_SCROLL_ERROR:
		    goto error;
		case TK_SCROLL_MOVETO:
		    newX = canvasPtr->scrollX1 - canvasPtr->inset







|











|







1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " type tag\"", (char *) NULL);
	    goto error;
	}
	itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
	if (itemPtr != NULL) {
	    Tcl_SetResult(interp, itemPtr->typePtr->name, TCL_STATIC);
	}
    } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
	int count, type;
	int newX = 0;		/* Initialization needed only to prevent
				 * gcc warnings. */
	double fraction;

	if (argc == 2) {
	    PrintScrollFractions(canvasPtr->xOrigin + canvasPtr->inset,
		    canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)
		    - canvasPtr->inset, canvasPtr->scrollX1,
		    canvasPtr->scrollX2, Tcl_GetStringResult(interp));
	} else {
	    type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
	    switch (type) {
		case TK_SCROLL_ERROR:
		    goto error;
		case TK_SCROLL_MOVETO:
		    newX = canvasPtr->scrollX1 - canvasPtr->inset
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
				 * gcc warnings. */
	double fraction;

	if (argc == 2) {
	    PrintScrollFractions(canvasPtr->yOrigin + canvasPtr->inset,
		    canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)
		    - canvasPtr->inset, canvasPtr->scrollY1,
		    canvasPtr->scrollY2, interp->result);
	} else {
	    type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
	    switch (type) {
		case TK_SCROLL_ERROR:
		    goto error;
		case TK_SCROLL_MOVETO:
		    newY = canvasPtr->scrollY1 - canvasPtr->inset







|







1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
				 * gcc warnings. */
	double fraction;

	if (argc == 2) {
	    PrintScrollFractions(canvasPtr->yOrigin + canvasPtr->inset,
		    canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)
		    - canvasPtr->inset, canvasPtr->scrollY1,
		    canvasPtr->scrollY2, Tcl_GetStringResult(interp));
	} else {
	    type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
	    switch (type) {
		case TK_SCROLL_ERROR:
		    goto error;
		case TK_SCROLL_MOVETO:
		    newY = canvasPtr->scrollY1 - canvasPtr->inset
1430
1431
1432
1433
1434
1435
1436

1437
1438
1439
1440
1441
1442
1443

    /*
     * Free up all the stuff that requires special handling,
     * then let Tk_FreeOptions handle all the standard option-related
     * stuff.
     */


    if (canvasPtr->pixmapGC != None) {
	Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC);
    }
    Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler);
    if (canvasPtr->bindingTable != NULL) {
	Tk_DeleteBindingTable(canvasPtr->bindingTable);
    }







>







1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476

    /*
     * Free up all the stuff that requires special handling,
     * then let Tk_FreeOptions handle all the standard option-related
     * stuff.
     */

    Tcl_DeleteHashTable(&canvasPtr->idTable);
    if (canvasPtr->pixmapGC != None) {
	Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC);
    }
    Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler);
    if (canvasPtr->bindingTable != NULL) {
	Tk_DeleteBindingTable(canvasPtr->bindingTable);
    }
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a canvas widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, border width,
 *	etc. get set for canvasPtr;  old resources get freed,
 *	if there were any.
 *
 *----------------------------------------------------------------------







|







1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a canvas widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, border width,
 *	etc. get set for canvasPtr;  old resources get freed,
 *	if there were any.
 *
 *----------------------------------------------------------------------
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
    tkLineType.nextPtr = &tkPolygonType;
    tkPolygonType.nextPtr = &tkImageType;
    tkImageType.nextPtr = &tkOvalType;
    tkOvalType.nextPtr = &tkBitmapType;
    tkBitmapType.nextPtr = &tkArcType;
    tkArcType.nextPtr = &tkWindowType;
    tkWindowType.nextPtr = NULL;
    allUid = Tk_GetUid("all");
    currentUid = Tk_GetUid("current");
}

/*
 *--------------------------------------------------------------
 *
 * StartTagSearch --
 *







<
<







2153
2154
2155
2156
2157
2158
2159


2160
2161
2162
2163
2164
2165
2166
    tkLineType.nextPtr = &tkPolygonType;
    tkPolygonType.nextPtr = &tkImageType;
    tkImageType.nextPtr = &tkOvalType;
    tkOvalType.nextPtr = &tkBitmapType;
    tkBitmapType.nextPtr = &tkArcType;
    tkArcType.nextPtr = &tkWindowType;
    tkWindowType.nextPtr = NULL;


}

/*
 *--------------------------------------------------------------
 *
 * StartTagSearch --
 *
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168





2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185

2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200

2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
    TkCanvas *canvasPtr;		/* Canvas whose items are to be
					 * searched. */
    char *tag;				/* String giving tag value. */
    TagSearch *searchPtr;		/* Record describing tag search;
					 * will be initialized here. */
{
    int id;
    Tk_Item *itemPtr, *prevPtr;
    Tk_Uid *tagPtr;
    Tk_Uid uid;
    int count;






    /*
     * Initialize the search.
     */

    searchPtr->canvasPtr = canvasPtr;
    searchPtr->searchOver = 0;

    /*
     * Find the first matching item in one of several ways. If the tag
     * is a number then it selects the single item with the matching
     * identifier.  In this case see if the item being requested is the
     * hot item, in which case the search can be skipped.
     */

    if (isdigit(UCHAR(*tag))) {
	char *end;


	numIdSearches++;
	id = strtoul(tag, &end, 0);
	if (*end == 0) {
	    itemPtr = canvasPtr->hotPtr;
	    prevPtr = canvasPtr->hotPrevPtr;
	    if ((itemPtr == NULL) || (itemPtr->id != id) || (prevPtr == NULL)
		    || (prevPtr->nextPtr != itemPtr)) {
		numSlowSearches++;
		for (prevPtr = NULL, itemPtr = canvasPtr->firstItemPtr;
			itemPtr != NULL;
			prevPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
		    if (itemPtr->id == id) {
			break;
		    }

		}
	    }
	    searchPtr->prevPtr = prevPtr;
	    searchPtr->searchOver = 1;
	    canvasPtr->hotPtr = itemPtr;
	    canvasPtr->hotPrevPtr = prevPtr;
	    return itemPtr;
	}
    }

    searchPtr->tag = uid = Tk_GetUid(tag);
    if (uid == allUid) {

	/*
	 * All items match.
	 */

	searchPtr->tag = NULL;
	searchPtr->prevPtr = NULL;
	searchPtr->currentPtr = canvasPtr->firstItemPtr;
	return canvasPtr->firstItemPtr;
    }

    /*
     * None of the above.  Search for an item with a matching tag.
     */

    for (prevPtr = NULL, itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
	    prevPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
	for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
		count > 0; tagPtr++, count--) {
	    if (*tagPtr == uid) {
		searchPtr->prevPtr = prevPtr;
		searchPtr->currentPtr = itemPtr;
		return itemPtr;
	    }
	}
    }
    searchPtr->prevPtr = prevPtr;
    searchPtr->searchOver = 1;
    return NULL;
}

/*
 *--------------------------------------------------------------
 *







|



>
>
>
>
>

















>

|



|
|
|
|
|
|
|
|
<
|
>


|


|





|






|








|
|



|





|







2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235

2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
    TkCanvas *canvasPtr;		/* Canvas whose items are to be
					 * searched. */
    char *tag;				/* String giving tag value. */
    TagSearch *searchPtr;		/* Record describing tag search;
					 * will be initialized here. */
{
    int id;
    Tk_Item *itemPtr, *lastPtr;
    Tk_Uid *tagPtr;
    Tk_Uid uid;
    int count;
    TkWindow *tkwin;
    TkDisplay *dispPtr;

    tkwin = (TkWindow *) canvasPtr->tkwin;
    dispPtr = tkwin->dispPtr;

    /*
     * Initialize the search.
     */

    searchPtr->canvasPtr = canvasPtr;
    searchPtr->searchOver = 0;

    /*
     * Find the first matching item in one of several ways. If the tag
     * is a number then it selects the single item with the matching
     * identifier.  In this case see if the item being requested is the
     * hot item, in which case the search can be skipped.
     */

    if (isdigit(UCHAR(*tag))) {
	char *end;
	Tcl_HashEntry *entryPtr;

	dispPtr->numIdSearches++;
	id = strtoul(tag, &end, 0);
	if (*end == 0) {
	    itemPtr = canvasPtr->hotPtr;
            lastPtr = canvasPtr->hotPrevPtr;
	    if ((itemPtr == NULL) || (itemPtr->id != id) || (lastPtr == NULL)
		    || (lastPtr->nextPtr != itemPtr)) {
		dispPtr->numSlowSearches++;
		entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id);
		if (entryPtr != NULL) {
		    itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr);
		    lastPtr = itemPtr->prevPtr;

		} else {
		    lastPtr = itemPtr = NULL;
		}
	    }
	    searchPtr->lastPtr = lastPtr;
	    searchPtr->searchOver = 1;
	    canvasPtr->hotPtr = itemPtr;
	    canvasPtr->hotPrevPtr = lastPtr;
	    return itemPtr;
	}
    }

    searchPtr->tag = uid = Tk_GetUid(tag);
    if (uid == Tk_GetUid("all")) {

	/*
	 * All items match.
	 */

	searchPtr->tag = NULL;
	searchPtr->lastPtr = NULL;
	searchPtr->currentPtr = canvasPtr->firstItemPtr;
	return canvasPtr->firstItemPtr;
    }

    /*
     * None of the above.  Search for an item with a matching tag.
     */

    for (lastPtr = NULL, itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
	    lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
	for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
		count > 0; tagPtr++, count--) {
	    if (*tagPtr == uid) {
		searchPtr->lastPtr = lastPtr;
		searchPtr->currentPtr = itemPtr;
		return itemPtr;
	    }
	}
    }
    searchPtr->lastPtr = lastPtr;
    searchPtr->searchOver = 1;
    return NULL;
}

/*
 *--------------------------------------------------------------
 *
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
 */

static Tk_Item *
NextItem(searchPtr)
    TagSearch *searchPtr;		/* Record describing search in
					 * progress. */
{
    Tk_Item *itemPtr, *prevPtr;
    int count;
    Tk_Uid uid;
    Tk_Uid *tagPtr;

    /*
     * Find next item in list (this may not actually be a suitable
     * one to return), and return if there are no items left.
     */

    prevPtr = searchPtr->prevPtr;
    if (prevPtr == NULL) {
	itemPtr = searchPtr->canvasPtr->firstItemPtr;
    } else {
	itemPtr = prevPtr->nextPtr;
    }
    if ((itemPtr == NULL) || (searchPtr->searchOver)) {
	searchPtr->searchOver = 1;
	return NULL;
    }
    if (itemPtr != searchPtr->currentPtr) {
	/*
	 * The structure of the list has changed.  Probably the
	 * previously-returned item was removed from the list.
	 * In this case, don't advance prevPtr;  just return
	 * its new successor (i.e. do nothing here).
	 */
    } else {
	prevPtr = itemPtr;
	itemPtr = prevPtr->nextPtr;
    }

    /*
     * Handle special case of "all" search by returning next item.
     */

    uid = searchPtr->tag;
    if (uid == NULL) {
	searchPtr->prevPtr = prevPtr;
	searchPtr->currentPtr = itemPtr;
	return itemPtr;
    }

    /*
     * Look for an item with a particular tag.
     */

    for ( ; itemPtr != NULL; prevPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
	for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
		count > 0; tagPtr++, count--) {
	    if (*tagPtr == uid) {
		searchPtr->prevPtr = prevPtr;
		searchPtr->currentPtr = itemPtr;
		return itemPtr;
	    }
	}
    }
    searchPtr->prevPtr = prevPtr;
    searchPtr->searchOver = 1;
    return NULL;
}

/*
 *--------------------------------------------------------------
 *
 * DoItem --
 *
 *	This is a utility procedure called by FindItems.  It
 *	either adds itemPtr's id to the result forming in interp,
 *	or it adds a new tag to itemPtr, depending on the value
 *	of tag.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If tag is NULL then itemPtr's id is added as a list element
 *	to interp->result;  otherwise tag is added to itemPtr's
 *	list of tags.
 *
 *--------------------------------------------------------------
 */

static void
DoItem(interp, itemPtr, tag)







|









|
|


|









|



|
|








|








|



|





|



















|







2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
 */

static Tk_Item *
NextItem(searchPtr)
    TagSearch *searchPtr;		/* Record describing search in
					 * progress. */
{
    Tk_Item *itemPtr, *lastPtr;
    int count;
    Tk_Uid uid;
    Tk_Uid *tagPtr;

    /*
     * Find next item in list (this may not actually be a suitable
     * one to return), and return if there are no items left.
     */

    lastPtr = searchPtr->lastPtr;
    if (lastPtr == NULL) {
	itemPtr = searchPtr->canvasPtr->firstItemPtr;
    } else {
	itemPtr = lastPtr->nextPtr;
    }
    if ((itemPtr == NULL) || (searchPtr->searchOver)) {
	searchPtr->searchOver = 1;
	return NULL;
    }
    if (itemPtr != searchPtr->currentPtr) {
	/*
	 * The structure of the list has changed.  Probably the
	 * previously-returned item was removed from the list.
	 * In this case, don't advance lastPtr;  just return
	 * its new successor (i.e. do nothing here).
	 */
    } else {
	lastPtr = itemPtr;
	itemPtr = lastPtr->nextPtr;
    }

    /*
     * Handle special case of "all" search by returning next item.
     */

    uid = searchPtr->tag;
    if (uid == NULL) {
	searchPtr->lastPtr = lastPtr;
	searchPtr->currentPtr = itemPtr;
	return itemPtr;
    }

    /*
     * Look for an item with a particular tag.
     */

    for ( ; itemPtr != NULL; lastPtr = itemPtr, itemPtr = itemPtr->nextPtr) {
	for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
		count > 0; tagPtr++, count--) {
	    if (*tagPtr == uid) {
		searchPtr->lastPtr = lastPtr;
		searchPtr->currentPtr = itemPtr;
		return itemPtr;
	    }
	}
    }
    searchPtr->lastPtr = lastPtr;
    searchPtr->searchOver = 1;
    return NULL;
}

/*
 *--------------------------------------------------------------
 *
 * DoItem --
 *
 *	This is a utility procedure called by FindItems.  It
 *	either adds itemPtr's id to the result forming in interp,
 *	or it adds a new tag to itemPtr, depending on the value
 *	of tag.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If tag is NULL then itemPtr's id is added as a list element
 *	to the interp's result;  otherwise tag is added to itemPtr's
 *	list of tags.
 *
 *--------------------------------------------------------------
 */

static void
DoItem(interp, itemPtr, tag)
2362
2363
2364
2365
2366
2367
2368
2369

2370
2371
2372
2373
2374
2375
2376
    int count;

    /*
     * Handle the "add-to-result" case and return, if appropriate.
     */

    if (tag == NULL) {
	char msg[30];

	sprintf(msg, "%d", itemPtr->id);
	Tcl_AppendElement(interp, msg);
	return;
    }

    for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
	    count > 0; tagPtr++, count--) {







|
>







2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
    int count;

    /*
     * Handle the "add-to-result" case and return, if appropriate.
     */

    if (tag == NULL) {
	char msg[TCL_INTEGER_SPACE];

	sprintf(msg, "%d", itemPtr->id);
	Tcl_AppendElement(interp, msg);
	return;
    }

    for (tagPtr = itemPtr->tagPtr, count = itemPtr->numTags;
	    count > 0; tagPtr++, count--) {
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
 *	"find" and "addtag" options of the canvas widget command,
 *	which locate items that have certain features (location,
 *	tags, position in display list, etc.).
 *
 * Results:
 *	A standard Tcl return value.  If newTag is NULL, then a
 *	list of ids from all the items that match argc/argv is
 *	returned in interp->result.  If newTag is NULL, then
 *	the normal interp->result is an empty string.  If an error
 *	occurs, then interp->result will hold an error message.
 *
 * Side effects:
 *	If newTag is non-NULL, then all the items that match the
 *	information in argc/argv have that tag added to their
 *	lists of tags.
 *
 *--------------------------------------------------------------







|
|
|







2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
 *	"find" and "addtag" options of the canvas widget command,
 *	which locate items that have certain features (location,
 *	tags, position in display list, etc.).
 *
 * Results:
 *	A standard Tcl return value.  If newTag is NULL, then a
 *	list of ids from all the items that match argc/argv is
 *	returned in the interp's result.  If newTag is NULL, then
 *	the normal the interp's result is an empty string.  If an error
 *	occurs, then the interp's result will hold an error message.
 *
 * Side effects:
 *	If newTag is non-NULL, then all the items that match the
 *	information in argc/argv have that tag added to their
 *	lists of tags.
 *
 *--------------------------------------------------------------
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
					 * greater than zero. */
    char **argv;			/* Arguments that describe what items
					 * to search for (see user doc on
					 * "find" and "addtag" options). */
    char *newTag;			/* If non-NULL, gives new tag to set
					 * on all found items;  if NULL, then
					 * ids of found items are returned
					 * in interp->result. */
    char *cmdName;			/* Name of original Tcl command, for
					 * use in error messages. */
    char *option;			/* For error messages:  gives option
					 * from Tcl command and other stuff
					 * up to what's in argc/argv. */
{
    int c;







|







2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
					 * greater than zero. */
    char **argv;			/* Arguments that describe what items
					 * to search for (see user doc on
					 * "find" and "addtag" options). */
    char *newTag;			/* If non-NULL, gives new tag to set
					 * on all found items;  if NULL, then
					 * ids of found items are returned
					 * in the interp's result. */
    char *cmdName;			/* Name of original Tcl command, for
					 * use in error messages. */
    char *option;			/* For error messages:  gives option
					 * from Tcl command and other stuff
					 * up to what's in argc/argv. */
{
    int c;
2489
2490
2491
2492
2493
2494
2495


2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
	}

	for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
		itemPtr = itemPtr->nextPtr) {
	    DoItem(interp, itemPtr, uid);
	}
    } else if ((c == 'b') && (strncmp(argv[0], "below", length) == 0)) {


	if (argc != 2) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    cmdName, option, " below tagOrId", (char *) NULL);
	    return TCL_ERROR;
	}
	(void) StartTagSearch(canvasPtr, argv[1], &search);
	if (search.prevPtr != NULL) {
	    DoItem(interp, search.prevPtr, uid);
	}
    } else if ((c == 'c') && (strncmp(argv[0], "closest", length) == 0)) {
	double closestDist;
	Tk_Item *startPtr, *closestPtr;
	double coords[2], halo;
	int x1, y1, x2, y2;








>
>





|
|
|







2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
	}

	for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
		itemPtr = itemPtr->nextPtr) {
	    DoItem(interp, itemPtr, uid);
	}
    } else if ((c == 'b') && (strncmp(argv[0], "below", length) == 0)) {
	Tk_Item *itemPtr;

	if (argc != 2) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    cmdName, option, " below tagOrId", (char *) NULL);
	    return TCL_ERROR;
	}
	itemPtr = StartTagSearch(canvasPtr, argv[1], &search);
	if (itemPtr->prevPtr != NULL) {
	    DoItem(interp, itemPtr->prevPtr, uid);
	}
    } else if ((c == 'c') && (strncmp(argv[0], "closest", length) == 0)) {
	double closestDist;
	Tk_Item *startPtr, *closestPtr;
	double coords[2], halo;
	int x1, y1, x2, y2;

2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
 *
 *	This procedure implements area searches for the "find"
 *	and "addtag" options.
 *
 * Results:
 *	A standard Tcl return value.  If newTag is NULL, then a
 *	list of ids from all the items overlapping or enclosed
 *	by the rectangle given by argc is returned in interp->result.
 *	If newTag is NULL, then the normal interp->result is an
 *	empty string.  If an error occurs, then interp->result will
 *	hold an error message.
 *
 * Side effects:
 *	If uid is non-NULL, then all the items overlapping
 *	or enclosed by the area in argv have that tag added to
 *	their lists of tags.
 *







|
|
|







2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
 *
 *	This procedure implements area searches for the "find"
 *	and "addtag" options.
 *
 * Results:
 *	A standard Tcl return value.  If newTag is NULL, then a
 *	list of ids from all the items overlapping or enclosed
 *	by the rectangle given by argc is returned in the interp's result.
 *	If newTag is NULL, then the normal the interp's result is an
 *	empty string.  If an error occurs, then the interp's result will
 *	hold an error message.
 *
 * Side effects:
 *	If uid is non-NULL, then all the items overlapping
 *	or enclosed by the area in argv have that tag added to
 *	their lists of tags.
 *
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
					 * searched. */
    char **argv;			/* Array of four arguments that
					 * give the coordinates of the
					 * rectangular area to search. */
    Tk_Uid uid;				/* If non-NULL, gives new tag to set
					 * on all found items;  if NULL, then
					 * ids of found items are returned
					 * in interp->result. */
    int enclosed;			/* 0 means overlapping or enclosed
					 * items are OK, 1 means only enclosed
					 * items are OK. */
{
    double rect[4], tmp;
    int x1, y1, x2, y2;
    Tk_Item *itemPtr;







|







2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
					 * searched. */
    char **argv;			/* Array of four arguments that
					 * give the coordinates of the
					 * rectangular area to search. */
    Tk_Uid uid;				/* If non-NULL, gives new tag to set
					 * on all found items;  if NULL, then
					 * ids of found items are returned
					 * in the interp's result. */
    int enclosed;			/* 0 means overlapping or enclosed
					 * items are OK, 1 means only enclosed
					 * items are OK. */
{
    double rect[4], tmp;
    int x1, y1, x2, y2;
    Tk_Item *itemPtr;
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778



2779
2780



2781
2782
2783
2784
2785
2786

2787
2788

2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805



2806
2807
2808



2809



2810
2811
2812
2813
2814
2815
2816
	    itemPtr != NULL; itemPtr = NextItem(&search)) {
	if (itemPtr == prevPtr) {
	    /*
	     * Item after which insertion is to occur is being
	     * moved!  Switch to insert after its predecessor.
	     */

	    prevPtr = search.prevPtr;
	}
	if (search.prevPtr == NULL) {



	    canvasPtr->firstItemPtr = itemPtr->nextPtr;
	} else {



	    search.prevPtr->nextPtr = itemPtr->nextPtr;
	}
	if (canvasPtr->lastItemPtr == itemPtr) {
	    canvasPtr->lastItemPtr = search.prevPtr;
	}
	if (firstMovePtr == NULL) {

	    firstMovePtr = itemPtr;
	} else {

	    lastMovePtr->nextPtr = itemPtr;
	}
	lastMovePtr = itemPtr;
	Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, itemPtr->x1, itemPtr->y1,
		itemPtr->x2, itemPtr->y2);
	canvasPtr->flags |= REPICK_NEEDED;
    }

    /*
     * Insert the list of to-be-moved items back into the canvas's
     * at the desired position.
     */

    if (firstMovePtr == NULL) {
	return;
    }
    if (prevPtr == NULL) {



	lastMovePtr->nextPtr = canvasPtr->firstItemPtr;
	canvasPtr->firstItemPtr = firstMovePtr;
    } else {



	lastMovePtr->nextPtr = prevPtr->nextPtr;



	prevPtr->nextPtr = firstMovePtr;
    }
    if (canvasPtr->lastItemPtr == prevPtr) {
	canvasPtr->lastItemPtr = lastMovePtr;
    }
}








|

|
>
>
>


>
>
>
|


|


>


>

















>
>
>



>
>
>

>
>
>







2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
	    itemPtr != NULL; itemPtr = NextItem(&search)) {
	if (itemPtr == prevPtr) {
	    /*
	     * Item after which insertion is to occur is being
	     * moved!  Switch to insert after its predecessor.
	     */

	    prevPtr = prevPtr->prevPtr;
	}
	if (itemPtr->prevPtr == NULL) {
	    if (itemPtr->nextPtr != NULL) {
		itemPtr->nextPtr->prevPtr = NULL;
	    }
	    canvasPtr->firstItemPtr = itemPtr->nextPtr;
	} else {
	    if (itemPtr->nextPtr != NULL) {
		itemPtr->nextPtr->prevPtr = itemPtr->prevPtr;
	    }
	    itemPtr->prevPtr->nextPtr = itemPtr->nextPtr;
	}
	if (canvasPtr->lastItemPtr == itemPtr) {
	    canvasPtr->lastItemPtr = itemPtr->prevPtr;
	}
	if (firstMovePtr == NULL) {
	    itemPtr->prevPtr = NULL;
	    firstMovePtr = itemPtr;
	} else {
	    itemPtr->prevPtr = lastMovePtr;
	    lastMovePtr->nextPtr = itemPtr;
	}
	lastMovePtr = itemPtr;
	Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, itemPtr->x1, itemPtr->y1,
		itemPtr->x2, itemPtr->y2);
	canvasPtr->flags |= REPICK_NEEDED;
    }

    /*
     * Insert the list of to-be-moved items back into the canvas's
     * at the desired position.
     */

    if (firstMovePtr == NULL) {
	return;
    }
    if (prevPtr == NULL) {
	if (canvasPtr->firstItemPtr != NULL) {
	    canvasPtr->firstItemPtr->prevPtr = lastMovePtr;
	}
	lastMovePtr->nextPtr = canvasPtr->firstItemPtr;
	canvasPtr->firstItemPtr = firstMovePtr;
    } else {
	if (prevPtr->nextPtr != NULL) {
	    prevPtr->nextPtr->prevPtr = lastMovePtr;
	}
	lastMovePtr->nextPtr = prevPtr->nextPtr;
	if (firstMovePtr != NULL) {
	    firstMovePtr->prevPtr = prevPtr;
	}
	prevPtr->nextPtr = firstMovePtr;
    }
    if (canvasPtr->lastItemPtr == prevPtr) {
	canvasPtr->lastItemPtr = lastMovePtr;
    }
}

3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
	/*
	 * The check below is needed because there could be an event
	 * handler for <LeaveNotify> that deletes the current item.
	 */

	if ((itemPtr == canvasPtr->currentItemPtr) && !buttonDown) {
	    for (i = itemPtr->numTags-1; i >= 0; i--) {
		if (itemPtr->tagPtr[i] == currentUid) {
		    itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1];
		    itemPtr->numTags--;
		    break;
		}
	    }
	}
    







|







3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
	/*
	 * The check below is needed because there could be an event
	 * handler for <LeaveNotify> that deletes the current item.
	 */

	if ((itemPtr == canvasPtr->currentItemPtr) && !buttonDown) {
	    for (i = itemPtr->numTags-1; i >= 0; i--) {
		if (itemPtr->tagPtr[i] == Tk_GetUid("current")) {
		    itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1];
		    itemPtr->numTags--;
		    break;
		}
	    }
	}
    
3103
3104
3105
3106
3107
3108
3109
3110

3111
3112
3113
3114
3115
3116
3117
     */

    canvasPtr->flags &= ~LEFT_GRABBED_ITEM;
    canvasPtr->currentItemPtr = canvasPtr->newCurrentPtr;
    if (canvasPtr->currentItemPtr != NULL) {
	XEvent event;

	DoItem((Tcl_Interp *) NULL, canvasPtr->currentItemPtr, currentUid);

	event = canvasPtr->pickEvent;
	event.type = EnterNotify;
	event.xcrossing.detail = NotifyAncestor;
	CanvasDoEvent(canvasPtr, &event);
    }
}








|
>







3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
     */

    canvasPtr->flags &= ~LEFT_GRABBED_ITEM;
    canvasPtr->currentItemPtr = canvasPtr->newCurrentPtr;
    if (canvasPtr->currentItemPtr != NULL) {
	XEvent event;

	DoItem((Tcl_Interp *) NULL, canvasPtr->currentItemPtr, 
                Tk_GetUid("current"));
	event = canvasPtr->pickEvent;
	event.type = EnterNotify;
	event.xcrossing.detail = NotifyAncestor;
	CanvasDoEvent(canvasPtr, &event);
    }
}

3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
    numObjects = itemPtr->numTags + 2;
    if (numObjects <= NUM_STATIC) {
	objectPtr = staticObjects;
    } else {
	objectPtr = (ClientData *) ckalloc((unsigned)
		(numObjects * sizeof(ClientData)));
    }
    objectPtr[0] = (ClientData) allUid;
    for (i = itemPtr->numTags-1; i >= 0; i--) {
	objectPtr[i+1] = (ClientData) itemPtr->tagPtr[i];
    }
    objectPtr[itemPtr->numTags+1] = (ClientData) itemPtr;

    /*
     * Invoke the binding system, then free up the object array if







|







3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
    numObjects = itemPtr->numTags + 2;
    if (numObjects <= NUM_STATIC) {
	objectPtr = staticObjects;
    } else {
	objectPtr = (ClientData *) ckalloc((unsigned)
		(numObjects * sizeof(ClientData)));
    }
    objectPtr[0] = (ClientData) Tk_GetUid("all");
    for (i = itemPtr->numTags-1; i >= 0; i--) {
	objectPtr[i+1] = (ClientData) itemPtr->tagPtr[i];
    }
    objectPtr[itemPtr->numTags+1] = (ClientData) itemPtr;

    /*
     * Invoke the binding system, then free up the object array if

Changes to generic/tkCanvas.h.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkCanvas.h --
 *
 *	Declarations shared among all the files that implement
 *	canvas widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkCanvas.h 1.41 96/02/15 18:51:28
 */

#ifndef _TKCANVAS
#define _TKCANVAS

#ifndef _TK
#include "tk.h"








>




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tkCanvas.h --
 *
 *	Declarations shared among all the files that implement
 *	canvas widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkCanvas.h,v 1.1.4.2 1998/11/25 21:16:31 stanton Exp $
 */

#ifndef _TKCANVAS
#define _TKCANVAS

#ifndef _TK
#include "tk.h"
204
205
206
207
208
209
210

211
212
213
214
215
216
217
    int nextId;			/* Number to use as id for next item
				 * created in widget. */
    struct TkPostscriptInfo *psInfoPtr;
				/* Pointer to information used for generating
				 * Postscript for the canvas.  NULL means
				 * no Postscript is currently being
				 * generated. */

} TkCanvas;

/*
 * Flag bits for canvases:
 *
 * REDRAW_PENDING -		1 means a DoWhenIdle handler has already
 *				been created to redraw some or all of the







>







205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
    int nextId;			/* Number to use as id for next item
				 * created in widget. */
    struct TkPostscriptInfo *psInfoPtr;
				/* Pointer to information used for generating
				 * Postscript for the canvas.  NULL means
				 * no Postscript is currently being
				 * generated. */
    Tcl_HashTable idTable;	/* Table of integer indices. */
} TkCanvas;

/*
 * Flag bits for canvases:
 *
 * REDRAW_PENDING -		1 means a DoWhenIdle handler has already
 *				been created to redraw some or all of the

Changes to generic/tkClipboard.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tkClipboard.c --
 *
 * 	This file manages the clipboard for the Tk toolkit,
 * 	maintaining a collection of data buffers that will be
 * 	supplied on demand to requesting applications.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkClipboard.c 1.15 96/05/03 10:51:08
 */

#include "tkInt.h"
#include "tkPort.h"
#include "tkSelect.h"

/*








|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tkClipboard.c --
 *
 * 	This file manages the clipboard for the Tk toolkit,
 * 	maintaining a collection of data buffers that will be
 * 	supplied on demand to requesting applications.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkClipboard.c,v 1.1.4.2 1998/09/30 02:16:50 stanton Exp $
 */

#include "tkInt.h"
#include "tkPort.h"
#include "tkSelect.h"

/*
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
 *
 *	Take control of the clipboard and clear out the previous
 *	contents.  This procedure must be invoked before any
 *	calls to Tk_AppendToClipboard.
 *
 * Results:
 *	A standard Tcl result.  If an error occurs, an error message is
 *	left in interp->result.
 *
 * Side effects:
 *	From now on, requests for the CLIPBOARD selection will be
 *	directed to the clipboard manager routines associated with
 *	clipWindow for the display of tkwin.  In order to guarantee
 *	atomicity, no event handling should occur between
 *	Tk_ClipboardClear and the following Tk_AppendToClipboard







|







222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
 *
 *	Take control of the clipboard and clear out the previous
 *	contents.  This procedure must be invoked before any
 *	calls to Tk_AppendToClipboard.
 *
 * Results:
 *	A standard Tcl result.  If an error occurs, an error message is
 *	left in the interp's result.
 *
 * Side effects:
 *	From now on, requests for the CLIPBOARD selection will be
 *	directed to the clipboard manager routines associated with
 *	clipWindow for the display of tkwin.  In order to guarantee
 *	atomicity, no event handling should occur between
 *	Tk_ClipboardClear and the following Tk_AppendToClipboard
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
 *	be returned.  Tk_ClipboardClear must be called before a sequence
 *	of Tk_ClipboardAppend calls can be issued.  In order to guarantee
 *	atomicity, no event handling should occur between Tk_ClipboardClear
 *	and the following Tk_AppendToClipboard calls.
 *
 * Results:
 *	A standard Tcl result.  If an error is returned, an error message
 *	is left in interp->result.
 *
 * Side effects:
 * 	The specified buffer will be copied onto the end of the clipboard.
 *	The clipboard maintains a list of buffers which will be used to
 *	supply the data for a selection get request.  The first time a given
 *	type is appended, Tk_ClipboardAppend will register a selection
 * 	handler of the appropriate type.







|







307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
 *	be returned.  Tk_ClipboardClear must be called before a sequence
 *	of Tk_ClipboardAppend calls can be issued.  In order to guarantee
 *	atomicity, no event handling should occur between Tk_ClipboardClear
 *	and the following Tk_AppendToClipboard calls.
 *
 * Results:
 *	A standard Tcl result.  If an error is returned, an error message
 *	is left in the interp's result.
 *
 * Side effects:
 * 	The specified buffer will be copied onto the end of the clipboard.
 *	The clipboard maintains a list of buffers which will be used to
 *	supply the data for a selection get request.  The first time a given
 *	type is appended, Tk_ClipboardAppend will register a selection
 * 	handler of the appropriate type.
524
525
526
527
528
529
530

531
532
533

534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
	    tkwin = Tk_NameToWindow(interp, path, tkwin);
	}
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
	return Tk_ClipboardClear(interp, tkwin);
    } else {

	sprintf(interp->result,
		"bad option \"%.50s\": must be clear or append",
		argv[1]);

	return TCL_ERROR;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkClipInit --
 *
 *	This procedure is called to initialize the window for claiming
 *	clipboard ownership and for receiving selection get results.  This
 *	function is called from tkSelect.c as well as tkClipboard.c.
 *
 * Results:
 *	The result is a standard Tcl return value, which is normally TCL_OK.
 *	If an error occurs then an error message is left in interp->result
 *	and TCL_ERROR is returned.
 *
 * Side effects:
 *	Sets up the clipWindow and related data structures.
 *
 *----------------------------------------------------------------------
 */








>
|
|
<
>















|
|







524
525
526
527
528
529
530
531
532
533

534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
	    tkwin = Tk_NameToWindow(interp, path, tkwin);
	}
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
	return Tk_ClipboardClear(interp, tkwin);
    } else {
	char buf[100 + TCL_INTEGER_SPACE];
	
	sprintf(buf, "bad option \"%.50s\": must be clear or append", argv[1]);

	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	return TCL_ERROR;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkClipInit --
 *
 *	This procedure is called to initialize the window for claiming
 *	clipboard ownership and for receiving selection get results.  This
 *	function is called from tkSelect.c as well as tkClipboard.c.
 *
 * Results:
 *	The result is a standard Tcl return value, which is normally TCL_OK.
 *	If an error occurs then an error message is left in the interp's
 *	result and TCL_ERROR is returned.
 *
 * Side effects:
 *	Sets up the clipWindow and related data structures.
 *
 *----------------------------------------------------------------------
 */

Changes to generic/tkCmds.c.

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
/* 
 * tkCmds.c --
 *
 *	This file contains a collection of Tk-related Tcl commands
 *	that didn't fit in any particular file of the toolkit.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkCmds.c 1.125 97/05/20 16:16:33
 */

#include "tkPort.h"
#include "tkInt.h"
#include <errno.h>










/*
 * Forward declarations for procedures defined later in this file:
 */

static TkWindow *	GetToplevel _ANSI_ARGS_((Tk_Window tkwin));
static char *		WaitVariableProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, char *name1, char *name2,
			    int flags));
static void		WaitVisibilityProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		WaitWindowProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));

/*
 *----------------------------------------------------------------------
 *
 * Tk_BellCmd --
 *
 *	This procedure is invoked to process the "bell" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tk_BellCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{

    Tk_Window tkwin = (Tk_Window) clientData;

    size_t length;

    if ((argc != 1) && (argc != 3)) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" ?-displayof window?\"", (char *) NULL);
	return TCL_ERROR;
    }

    if (argc == 3) {
	length = strlen(argv[1]);
	if ((length < 2) || (strncmp(argv[1], "-displayof", length) != 0)) {
	    Tcl_AppendResult(interp, "bad option \"", argv[1],
		    "\": must be -displayof", (char *) NULL);
	    return TCL_ERROR;
	}


	tkwin = Tk_NameToWindow(interp, argv[2], tkwin);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
    }
    XBell(Tk_Display(tkwin), 0);
    XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);
    XFlush(Tk_Display(tkwin));







|




|





>
>
>
>
>
>
>
>
>

















|














|


|
|

>

>
|

|
<
|



|
|
|
<
<


>
>
|







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
/* 
 * tkCmds.c --
 *
 *	This file contains a collection of Tk-related Tcl commands
 *	that didn't fit in any particular file of the toolkit.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkCmds.c,v 1.1.4.5 1999/03/10 07:13:38 stanton Exp $
 */

#include "tkPort.h"
#include "tkInt.h"
#include <errno.h>

#if defined(__WIN32__)
#include "tkWinInt.h"
#elif defined(MAC_TCL)
#include "tkMacInt.h"
#else
#include "tkUnixInt.h"
#endif


/*
 * Forward declarations for procedures defined later in this file:
 */

static TkWindow *	GetToplevel _ANSI_ARGS_((Tk_Window tkwin));
static char *		WaitVariableProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, char *name1, char *name2,
			    int flags));
static void		WaitVisibilityProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		WaitWindowProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));

/*
 *----------------------------------------------------------------------
 *
 * Tk_BellObjCmd --
 *
 *	This procedure is invoked to process the "bell" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tk_BellObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window associated with interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    static char *bellOptions[] = {"-displayof", (char *) NULL};
    Tk_Window tkwin = (Tk_Window) clientData;
    char *displayName;
    int index;

    if ((objc != 1) && (objc != 3)) {

	Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window?");
	return TCL_ERROR;
    }

    if (objc == 3) {
	if (Tcl_GetIndexFromObj(interp, objv[1], bellOptions, "option", 0,
		&index) != TCL_OK) {


	    return TCL_ERROR;
	}
	displayName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
	
	tkwin = Tk_NameToWindow(interp, displayName, tkwin);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
    }
    XBell(Tk_Display(tkwin), 0);
    XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);
    XFlush(Tk_Display(tkwin));
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161

	command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,
		object, argv[2]);
	if (command == NULL) {
	    Tcl_ResetResult(interp);
	    return TCL_OK;
	}
	interp->result = command;
    } else {
	Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
    }
    return TCL_OK;
}

/*







|







157
158
159
160
161
162
163
164
165
166
167
168
169
170
171

	command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,
		object, argv[2]);
	if (command == NULL) {
	    Tcl_ResetResult(interp);
	    return TCL_OK;
	}
	Tcl_SetResult(interp, command, TCL_STATIC);
    } else {
	Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
    }
    return TCL_OK;
}

/*
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
void
TkBindEventProc(winPtr, eventPtr)
    TkWindow *winPtr;			/* Pointer to info about window. */
    XEvent *eventPtr;			/* Information about event. */
{
#define MAX_OBJS 20
    ClientData objects[MAX_OBJS], *objPtr;
    static Tk_Uid allUid = NULL;
    TkWindow *topLevPtr;
    int i, count;
    char *p;
    Tcl_HashEntry *hPtr;

    if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
	return;







<







189
190
191
192
193
194
195

196
197
198
199
200
201
202
void
TkBindEventProc(winPtr, eventPtr)
    TkWindow *winPtr;			/* Pointer to info about window. */
    XEvent *eventPtr;			/* Information about event. */
{
#define MAX_OBJS 20
    ClientData objects[MAX_OBJS], *objPtr;

    TkWindow *topLevPtr;
    int i, count;
    char *p;
    Tcl_HashEntry *hPtr;

    if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
	return;
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
	}
	if ((winPtr != topLevPtr) && (topLevPtr != NULL)) {
	    count = 4;
	    objPtr[2] = (ClientData) topLevPtr->pathName;
	} else {
	    count = 3;
	}
	if (allUid == NULL) {
	    allUid = Tk_GetUid("all");
	}
	objPtr[count-1] = (ClientData) allUid;
    }
    Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr,
	    count, objPtr);
    if (objPtr != objects) {
	ckfree((char *) objPtr);
    }
}







<
<
<
|







236
237
238
239
240
241
242



243
244
245
246
247
248
249
250
	}
	if ((winPtr != topLevPtr) && (topLevPtr != NULL)) {
	    count = 4;
	    objPtr[2] = (ClientData) topLevPtr->pathName;
	} else {
	    count = 3;
	}



	objPtr[count-1] = (ClientData) Tk_GetUid("all");
    }
    Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr,
	    count, objPtr);
    if (objPtr != objects) {
	ckfree((char *) objPtr);
    }
}
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
Tk_LowerCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    Tk_Window main = (Tk_Window) clientData;
    Tk_Window tkwin, other;

    if ((argc != 2) && (argc != 3)) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " window ?belowThis?\"", (char *) NULL);
	return TCL_ERROR;
    }

    tkwin = Tk_NameToWindow(interp, argv[1], main);
    if (tkwin == NULL) {
	return TCL_ERROR;
    }
    if (argc == 2) {
	other = NULL;
    } else {
	other = Tk_NameToWindow(interp, argv[2], main);
	if (other == NULL) {
	    return TCL_ERROR;
	}
    }
    if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {
	Tcl_AppendResult(interp, "can't lower \"", argv[1], "\" below \"",
		argv[2], "\"", (char *) NULL);







|








|






|







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
Tk_LowerCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    Tk_Window mainwin = (Tk_Window) clientData;
    Tk_Window tkwin, other;

    if ((argc != 2) && (argc != 3)) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " window ?belowThis?\"", (char *) NULL);
	return TCL_ERROR;
    }

    tkwin = Tk_NameToWindow(interp, argv[1], mainwin);
    if (tkwin == NULL) {
	return TCL_ERROR;
    }
    if (argc == 2) {
	other = NULL;
    } else {
	other = Tk_NameToWindow(interp, argv[2], mainwin);
	if (other == NULL) {
	    return TCL_ERROR;
	}
    }
    if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {
	Tcl_AppendResult(interp, "can't lower \"", argv[1], "\" below \"",
		argv[2], "\"", (char *) NULL);
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
Tk_RaiseCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    Tk_Window main = (Tk_Window) clientData;
    Tk_Window tkwin, other;

    if ((argc != 2) && (argc != 3)) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " window ?aboveThis?\"", (char *) NULL);
	return TCL_ERROR;
    }

    tkwin = Tk_NameToWindow(interp, argv[1], main);
    if (tkwin == NULL) {
	return TCL_ERROR;
    }
    if (argc == 2) {
	other = NULL;
    } else {
	other = Tk_NameToWindow(interp, argv[2], main);
	if (other == NULL) {
	    return TCL_ERROR;
	}
    }
    if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {
	Tcl_AppendResult(interp, "can't raise \"", argv[1], "\" above \"",
		argv[2], "\"", (char *) NULL);







|








|






|







509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
Tk_RaiseCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    Tk_Window mainwin = (Tk_Window) clientData;
    Tk_Window tkwin, other;

    if ((argc != 2) && (argc != 3)) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " window ?aboveThis?\"", (char *) NULL);
	return TCL_ERROR;
    }

    tkwin = Tk_NameToWindow(interp, argv[1], mainwin);
    if (tkwin == NULL) {
	return TCL_ERROR;
    }
    if (argc == 2) {
	other = NULL;
    } else {
	other = Tk_NameToWindow(interp, argv[2], mainwin);
	if (other == NULL) {
	    return TCL_ERROR;
	}
    }
    if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {
	Tcl_AppendResult(interp, "can't raise \"", argv[1], "\" above \"",
		argv[2], "\"", (char *) NULL);
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
	        Tcl_WrongNumArgs(interp, 2, objv, "?newName?");
		return TCL_ERROR;
	    }
	    if (objc == 3) {
		string = Tcl_GetStringFromObj(objv[2], NULL);
		winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string));
	    }
	    Tcl_SetStringObj(Tcl_GetObjResult(interp), winPtr->nameUid, -1);
	    break;
	}
	case TK_SCALING: {
	    Screen *screenPtr;
	    int skip, width, height;
	    double d;
	    







|







597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
	        Tcl_WrongNumArgs(interp, 2, objv, "?newName?");
		return TCL_ERROR;
	    }
	    if (objc == 3) {
		string = Tcl_GetStringFromObj(objv[2], NULL);
		winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string));
	    }
	    Tcl_AppendResult(interp, winPtr->nameUid, NULL);
	    break;
	}
	case TK_SCALING: {
	    Screen *screenPtr;
	    int skip, width, height;
	    double d;
	    
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822

823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
	*donePtr = 1;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_UpdateCmd --
 *
 *	This procedure is invoked to process the "update" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tk_UpdateCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{

    int flags;
    TkDisplay *dispPtr;

    if (argc == 1) {
	flags = TCL_DONT_WAIT;
    } else if (argc == 2) {
	if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) {
	    Tcl_AppendResult(interp, "bad option \"", argv[1],
		    "\": must be idletasks", (char *) NULL);
	    return TCL_ERROR;
	}
	flags = TCL_IDLE_EVENTS;
    } else {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " ?idletasks?\"", (char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Handle all pending events, sync all displays, and repeat over
     * and over again until all pending events have been handled.
     * Special note:  it's possible that the entire application could
     * be destroyed by an event handler that occurs during the update.
     * Thus, don't use any information from tkwin after calling
     * Tcl_DoOneEvent.
     */

    while (1) {
	while (Tcl_DoOneEvent(flags) != 0) {
	    /* Empty loop body */
	}
	for (dispPtr = tkDisplayList; dispPtr != NULL;
		dispPtr = dispPtr->nextPtr) {
	    XSync(dispPtr->display, False);
	}
	if (Tcl_DoOneEvent(flags) == 0) {
	    break;
	}
    }







|















|



|
|

>
|


|

|
|
<
|




<
|











|




|







799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836

837
838
839
840
841

842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
	*donePtr = 1;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_UpdateObjCmd --
 *
 *	This procedure is invoked to process the "update" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tk_UpdateObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    static char *updateOptions[] = {"idletasks", (char *) NULL};
    int flags, index;
    TkDisplay *dispPtr;

    if (objc == 1) {
	flags = TCL_DONT_WAIT;
    } else if (objc == 2) {
	if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, "option", 0,

		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	flags = TCL_IDLE_EVENTS;
    } else {

        Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
	return TCL_ERROR;
    }

    /*
     * Handle all pending events, sync all displays, and repeat over
     * and over again until all pending events have been handled.
     * Special note:  it's possible that the entire application could
     * be destroyed by an event handler that occurs during the update.
     * Thus, don't use any information from tkwin after calling
     * Tcl_DoOneEvent.
     */
  
    while (1) {
	while (Tcl_DoOneEvent(flags) != 0) {
	    /* Empty loop body */
	}
	for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
		dispPtr = dispPtr->nextPtr) {
	    XSync(dispPtr->display, False);
	}
	if (Tcl_DoOneEvent(flags) == 0) {
	    break;
	}
    }
891
892
893
894
895
896
897
898
899
900
901

902
903
904
905
906
907
908
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    int index, x, y, width, height, useX, useY, class, skip;
    char buf[128];
    char *string;
    TkWindow *winPtr;
    Tk_Window tkwin;


    static TkStateMap visualMap[] = {
	{PseudoColor,	"pseudocolor"},
	{GrayScale,	"grayscale"},
	{DirectColor,	"directcolor"},
	{TrueColor,	"truecolor"},
	{StaticColor,	"staticcolor"},







<



>







896
897
898
899
900
901
902

903
904
905
906
907
908
909
910
911
912
913
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    int index, x, y, width, height, useX, useY, class, skip;

    char *string;
    TkWindow *winPtr;
    Tk_Window tkwin;
    Tcl_Obj *resultPtr;

    static TkStateMap visualMap[] = {
	{PseudoColor,	"pseudocolor"},
	{GrayScale,	"grayscale"},
	{DirectColor,	"directcolor"},
	{TrueColor,	"truecolor"},
	{StaticColor,	"staticcolor"},
967
968
969
970
971
972
973

974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010

1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022


1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
	string = Tcl_GetStringFromObj(objv[2], NULL);
	tkwin = Tk_NameToWindow(interp, string, tkwin);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
    }
    winPtr = (TkWindow *) tkwin;


    switch ((enum options) index) {
	case WIN_CELLS: {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
		    Tk_Visual(tkwin)->map_entries);
	    break;
	}
	case WIN_CHILDREN: {
	    Tcl_Obj *strPtr;

	    Tcl_ResetResult(interp);
	    winPtr = winPtr->childList;
	    for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) {
		strPtr = Tcl_NewStringObj(winPtr->pathName, -1);
		Tcl_ListObjAppendElement(NULL,
		     Tcl_GetObjResult(interp), strPtr);
	    }
	    break;
	}
	case WIN_CLASS: {
	    Tcl_ResetResult(interp);
	    Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_Class(tkwin), -1);
	    break;
	}
	case WIN_COLORMAPFULL: {
	    Tcl_ResetResult(interp);
	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
		    TkpCmapStressed(tkwin, Tk_Colormap(tkwin)));
	    break;
	}
	case WIN_DEPTH: {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Depth(tkwin));
	    break;
	}
	case WIN_GEOMETRY: {

	    Tcl_ResetResult(interp);
	    sprintf(buf, "%dx%d+%d+%d", Tk_Width(tkwin), Tk_Height(tkwin),
		    Tk_X(tkwin), Tk_Y(tkwin));
	    Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
	    break;
	}
	case WIN_HEIGHT: {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Height(tkwin));
	    break;
	}
	case WIN_ID: {


	    Tk_MakeWindowExist(tkwin);
	    TkpPrintWindowId(buf, Tk_WindowId(tkwin));
	    Tcl_ResetResult(interp);
	    Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
	    break;
	}
	case WIN_ISMAPPED: {
	    Tcl_ResetResult(interp);
	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
		    (int) Tk_IsMapped(tkwin));
	    break;
	}
	case WIN_MANAGER: {
	    Tcl_ResetResult(interp);
	    if (winPtr->geomMgrPtr != NULL) {
		Tcl_SetStringObj(Tcl_GetObjResult(interp),
		        winPtr->geomMgrPtr->name, -1);
	    }
	    break;
	}
	case WIN_NAME: {
	    Tcl_ResetResult(interp);
	    Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_Name(tkwin), -1);
	    break;
	}
	case WIN_PARENT: {
	    Tcl_ResetResult(interp);
	    if (winPtr->parentPtr != NULL) {
		Tcl_SetStringObj(Tcl_GetObjResult(interp),
		        winPtr->parentPtr->pathName, -1);
	    }
	    break;
	}
	case WIN_POINTERX: {
	    useX = 1;
	    useY = 0;
	    goto pointerxy;







>



<
<
|





<



|
<




<
|



<
|




<
|



>
|


|



<
|



>
>


<
|



<
<
|



<

<
|




<
|



<

<
|







972
973
974
975
976
977
978
979
980
981
982


983
984
985
986
987
988

989
990
991
992

993
994
995
996

997
998
999
1000

1001
1002
1003
1004
1005

1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017

1018
1019
1020
1021
1022
1023
1024
1025

1026
1027
1028
1029


1030
1031
1032
1033

1034

1035
1036
1037
1038
1039

1040
1041
1042
1043

1044

1045
1046
1047
1048
1049
1050
1051
1052
	string = Tcl_GetStringFromObj(objv[2], NULL);
	tkwin = Tk_NameToWindow(interp, string, tkwin);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
    }
    winPtr = (TkWindow *) tkwin;
    resultPtr = Tcl_GetObjResult(interp);

    switch ((enum options) index) {
	case WIN_CELLS: {


	    Tcl_SetIntObj(resultPtr, Tk_Visual(tkwin)->map_entries);
	    break;
	}
	case WIN_CHILDREN: {
	    Tcl_Obj *strPtr;


	    winPtr = winPtr->childList;
	    for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) {
		strPtr = Tcl_NewStringObj(winPtr->pathName, -1);
		Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);

	    }
	    break;
	}
	case WIN_CLASS: {

	    Tcl_SetStringObj(resultPtr, Tk_Class(tkwin), -1);
	    break;
	}
	case WIN_COLORMAPFULL: {

	    Tcl_SetBooleanObj(resultPtr,
		    TkpCmapStressed(tkwin, Tk_Colormap(tkwin)));
	    break;
	}
	case WIN_DEPTH: {

	    Tcl_SetIntObj(resultPtr, Tk_Depth(tkwin));
	    break;
	}
	case WIN_GEOMETRY: {
	    char buf[16 + TCL_INTEGER_SPACE * 4];

	    sprintf(buf, "%dx%d+%d+%d", Tk_Width(tkwin), Tk_Height(tkwin),
		    Tk_X(tkwin), Tk_Y(tkwin));
	    Tcl_SetStringObj(resultPtr, buf, -1);
	    break;
	}
	case WIN_HEIGHT: {

	    Tcl_SetIntObj(resultPtr, Tk_Height(tkwin));
	    break;
	}
	case WIN_ID: {
	    char buf[TCL_INTEGER_SPACE];
	    
	    Tk_MakeWindowExist(tkwin);
	    TkpPrintWindowId(buf, Tk_WindowId(tkwin));

	    Tcl_SetStringObj(resultPtr, buf, -1);
	    break;
	}
	case WIN_ISMAPPED: {


	    Tcl_SetBooleanObj(resultPtr, (int) Tk_IsMapped(tkwin));
	    break;
	}
	case WIN_MANAGER: {

	    if (winPtr->geomMgrPtr != NULL) {

		Tcl_SetStringObj(resultPtr, winPtr->geomMgrPtr->name, -1);
	    }
	    break;
	}
	case WIN_NAME: {

	    Tcl_SetStringObj(resultPtr, Tk_Name(tkwin), -1);
	    break;
	}
	case WIN_PARENT: {

	    if (winPtr->parentPtr != NULL) {

		Tcl_SetStringObj(resultPtr, winPtr->parentPtr->pathName, -1);
	    }
	    break;
	}
	case WIN_POINTERX: {
	    useX = 1;
	    useY = 0;
	    goto pointerxy;
1071
1072
1073
1074
1075
1076
1077
1078
1079


1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111


1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200

1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
	    winPtr = GetToplevel(tkwin);
	    if (winPtr == NULL) {
		x = -1;
		y = -1;
	    } else {
		TkGetPointerCoords((Tk_Window) winPtr, &x, &y);
	    }
	    Tcl_ResetResult(interp);
	    if (useX & useY) {


		sprintf(buf, "%d %d", x, y);
		Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
	    } else if (useX) {
		Tcl_SetIntObj(Tcl_GetObjResult(interp), x);
	    } else {
		Tcl_SetIntObj(Tcl_GetObjResult(interp), y);
	    }
	    break;
	}
	case WIN_REQHEIGHT: {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_ReqHeight(tkwin));
	    break;
	}
	case WIN_REQWIDTH: {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_ReqWidth(tkwin));
	    break;
	}
	case WIN_ROOTX: {
	    Tk_GetRootCoords(tkwin, &x, &y);
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), x);
	    break;
	}
	case WIN_ROOTY: {
	    Tk_GetRootCoords(tkwin, &x, &y);
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), y);
	    break;
	}
	case WIN_SCREEN: {


	    sprintf(buf, "%d", Tk_ScreenNumber(tkwin));
	    Tcl_ResetResult(interp);
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		    Tk_DisplayName(tkwin), ".", buf, NULL);
	    break;
	}
	case WIN_SCREENCELLS: {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
		    CellsOfScreen(Tk_Screen(tkwin)));
	    break;
	}
	case WIN_SCREENDEPTH: {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
		    DefaultDepthOfScreen(Tk_Screen(tkwin)));
	    break;
	}
	case WIN_SCREENHEIGHT: {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
		    HeightOfScreen(Tk_Screen(tkwin)));
	    break;
	}
	case WIN_SCREENWIDTH: {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
		    WidthOfScreen(Tk_Screen(tkwin)));
	    break;
	}
	case WIN_SCREENMMHEIGHT: {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
		    HeightMMOfScreen(Tk_Screen(tkwin)));
	    break;
	}
	case WIN_SCREENMMWIDTH: {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp),
		    WidthMMOfScreen(Tk_Screen(tkwin)));
	    break;
	}
	case WIN_SCREENVISUAL: {
	    class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class;
	    goto visual;
	}
	case WIN_SERVER: {
	    TkGetServerInfo(interp, tkwin);
	    break;
	}
	case WIN_TOPLEVEL: {
	    winPtr = GetToplevel(tkwin);
	    if (winPtr != NULL) {
		Tcl_ResetResult(interp);
		Tcl_SetStringObj(Tcl_GetObjResult(interp),
			winPtr->pathName, -1);
	    }
	    break;
	}
	case WIN_VIEWABLE: {
	    int viewable;

	    viewable = 0;
	    for ( ; ; winPtr = winPtr->parentPtr) {
		if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) {
		    break;
		}
		if (winPtr->flags & TK_TOP_LEVEL) {
		    viewable = 1;
		    break;
		}
	    }
	    Tcl_ResetResult(interp);
	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), viewable);
	    break;
	}
	case WIN_VISUAL: {
	    class = Tk_Visual(tkwin)->class;

	    visual:
	    string = TkFindStateString(visualMap, class);
	    if (string == NULL) {
		string = "unknown";
	    }
	    Tcl_ResetResult(interp);
	    Tcl_SetStringObj(Tcl_GetObjResult(interp), string, -1);
	    break;
	}
	case WIN_VISUALID: {

	    Tcl_ResetResult(interp);
	    sprintf(buf, "0x%x",
		    (unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin)));
	    Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
	    break;
	}
	case WIN_VROOTHEIGHT: {
	    Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), height);
	    break;
	}
	case WIN_VROOTWIDTH: {
	    Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), width);
	    break;
	}
	case WIN_VROOTX: {
	    Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), x);
	    break;
	}
	case WIN_VROOTY: {
	    Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), y);
	    break;
	}
	case WIN_WIDTH: {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Width(tkwin));
	    break;
	}
	case WIN_X: {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_X(tkwin));
	    break;
	}
	case WIN_Y: {
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Y(tkwin));
	    break;
	}

	/*
	 * Uses -displayof.
	 */
	 
	case WIN_ATOM: {
	    skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
	    if (skip < 0) {
		return TCL_ERROR;
	    }
	    if (objc - skip != 3) {
	        Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? name");
		return TCL_ERROR;
	    }
	    objv += skip;
	    string = Tcl_GetStringFromObj(objv[2], NULL);
	    Tcl_ResetResult(interp);
	    Tcl_SetLongObj(Tcl_GetObjResult(interp),
		    (long) Tk_InternAtom(tkwin, string));
	    break;
	}
	case WIN_ATOMNAME: {
	    char *name;
	    long id;
	    
	    skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
	    if (skip < 0) {
		return TCL_ERROR;
	    }
	    if (objc - skip != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
		return TCL_ERROR;
	    }
	    objv += skip;
	    if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_ResetResult(interp);
	    name = Tk_GetAtomName(tkwin, (Atom) id);
	    if (strcmp(name, "?bad atom?") == 0) {
		string = Tcl_GetStringFromObj(objv[2], NULL);
		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			"no atom exists with id \"", string, "\"", NULL);
		return TCL_ERROR;
	    }
	    Tcl_SetStringObj(Tcl_GetObjResult(interp), name, -1);
	    break;
	}
	case WIN_CONTAINING: {
	    skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
	    if (skip < 0) {
		return TCL_ERROR;
	    }







<

>
>

|

|

|




<
|



<
|




<
|




<
|



>
>

<
|
|



<
<
|



<
<
|



<
<
|



<
<
|



<
<
|



<
<
|













<
<
|
















<
|










<
|



>
|


|




<
|




<
|




<
|




<
|



<
|



<
|



<
|


















<
<
|


















<



|



|







1064
1065
1066
1067
1068
1069
1070

1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083

1084
1085
1086
1087

1088
1089
1090
1091
1092

1093
1094
1095
1096
1097

1098
1099
1100
1101
1102
1103
1104

1105
1106
1107
1108
1109


1110
1111
1112
1113


1114
1115
1116
1117


1118
1119
1120
1121


1122
1123
1124
1125


1126
1127
1128
1129


1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143


1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160

1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171

1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184

1185
1186
1187
1188
1189

1190
1191
1192
1193
1194

1195
1196
1197
1198
1199

1200
1201
1202
1203

1204
1205
1206
1207

1208
1209
1210
1211

1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230


1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249

1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
	    winPtr = GetToplevel(tkwin);
	    if (winPtr == NULL) {
		x = -1;
		y = -1;
	    } else {
		TkGetPointerCoords((Tk_Window) winPtr, &x, &y);
	    }

	    if (useX & useY) {
		char buf[TCL_INTEGER_SPACE * 2];
		
		sprintf(buf, "%d %d", x, y);
		Tcl_SetStringObj(resultPtr, buf, -1);
	    } else if (useX) {
		Tcl_SetIntObj(resultPtr, x);
	    } else {
		Tcl_SetIntObj(resultPtr, y);
	    }
	    break;
	}
	case WIN_REQHEIGHT: {

	    Tcl_SetIntObj(resultPtr, Tk_ReqHeight(tkwin));
	    break;
	}
	case WIN_REQWIDTH: {

	    Tcl_SetIntObj(resultPtr, Tk_ReqWidth(tkwin));
	    break;
	}
	case WIN_ROOTX: {
	    Tk_GetRootCoords(tkwin, &x, &y);

	    Tcl_SetIntObj(resultPtr, x);
	    break;
	}
	case WIN_ROOTY: {
	    Tk_GetRootCoords(tkwin, &x, &y);

	    Tcl_SetIntObj(resultPtr, y);
	    break;
	}
	case WIN_SCREEN: {
	    char buf[TCL_INTEGER_SPACE];
	    
	    sprintf(buf, "%d", Tk_ScreenNumber(tkwin));

	    Tcl_AppendStringsToObj(resultPtr, Tk_DisplayName(tkwin), ".",
		    buf, NULL);
	    break;
	}
	case WIN_SCREENCELLS: {


	    Tcl_SetIntObj(resultPtr, CellsOfScreen(Tk_Screen(tkwin)));
	    break;
	}
	case WIN_SCREENDEPTH: {


	    Tcl_SetIntObj(resultPtr, DefaultDepthOfScreen(Tk_Screen(tkwin)));
	    break;
	}
	case WIN_SCREENHEIGHT: {


	    Tcl_SetIntObj(resultPtr, HeightOfScreen(Tk_Screen(tkwin)));
	    break;
	}
	case WIN_SCREENWIDTH: {


	    Tcl_SetIntObj(resultPtr, WidthOfScreen(Tk_Screen(tkwin)));
	    break;
	}
	case WIN_SCREENMMHEIGHT: {


	    Tcl_SetIntObj(resultPtr, HeightMMOfScreen(Tk_Screen(tkwin)));
	    break;
	}
	case WIN_SCREENMMWIDTH: {


	    Tcl_SetIntObj(resultPtr, WidthMMOfScreen(Tk_Screen(tkwin)));
	    break;
	}
	case WIN_SCREENVISUAL: {
	    class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class;
	    goto visual;
	}
	case WIN_SERVER: {
	    TkGetServerInfo(interp, tkwin);
	    break;
	}
	case WIN_TOPLEVEL: {
	    winPtr = GetToplevel(tkwin);
	    if (winPtr != NULL) {


		Tcl_SetStringObj(resultPtr, winPtr->pathName, -1);
	    }
	    break;
	}
	case WIN_VIEWABLE: {
	    int viewable;

	    viewable = 0;
	    for ( ; ; winPtr = winPtr->parentPtr) {
		if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) {
		    break;
		}
		if (winPtr->flags & TK_TOP_LEVEL) {
		    viewable = 1;
		    break;
		}
	    }

	    Tcl_SetBooleanObj(resultPtr, viewable);
	    break;
	}
	case WIN_VISUAL: {
	    class = Tk_Visual(tkwin)->class;

	    visual:
	    string = TkFindStateString(visualMap, class);
	    if (string == NULL) {
		string = "unknown";
	    }

	    Tcl_SetStringObj(resultPtr, string, -1);
	    break;
	}
	case WIN_VISUALID: {
	    char buf[TCL_INTEGER_SPACE];

	    sprintf(buf, "0x%x",
		    (unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin)));
	    Tcl_SetStringObj(resultPtr, buf, -1);
	    break;
	}
	case WIN_VROOTHEIGHT: {
	    Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);

	    Tcl_SetIntObj(resultPtr, height);
	    break;
	}
	case WIN_VROOTWIDTH: {
	    Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);

	    Tcl_SetIntObj(resultPtr, width);
	    break;
	}
	case WIN_VROOTX: {
	    Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);

	    Tcl_SetIntObj(resultPtr, x);
	    break;
	}
	case WIN_VROOTY: {
	    Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);

	    Tcl_SetIntObj(resultPtr, y);
	    break;
	}
	case WIN_WIDTH: {

	    Tcl_SetIntObj(resultPtr, Tk_Width(tkwin));
	    break;
	}
	case WIN_X: {

	    Tcl_SetIntObj(resultPtr, Tk_X(tkwin));
	    break;
	}
	case WIN_Y: {

	    Tcl_SetIntObj(resultPtr, Tk_Y(tkwin));
	    break;
	}

	/*
	 * Uses -displayof.
	 */
	 
	case WIN_ATOM: {
	    skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
	    if (skip < 0) {
		return TCL_ERROR;
	    }
	    if (objc - skip != 3) {
	        Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? name");
		return TCL_ERROR;
	    }
	    objv += skip;
	    string = Tcl_GetStringFromObj(objv[2], NULL);


	    Tcl_SetLongObj(resultPtr, (long) Tk_InternAtom(tkwin, string));
	    break;
	}
	case WIN_ATOMNAME: {
	    char *name;
	    long id;
	    
	    skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
	    if (skip < 0) {
		return TCL_ERROR;
	    }
	    if (objc - skip != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
		return TCL_ERROR;
	    }
	    objv += skip;
	    if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
		return TCL_ERROR;
	    }

	    name = Tk_GetAtomName(tkwin, (Atom) id);
	    if (strcmp(name, "?bad atom?") == 0) {
		string = Tcl_GetStringFromObj(objv[2], NULL);
		Tcl_AppendStringsToObj(resultPtr, 
			"no atom exists with id \"", string, "\"", NULL);
		return TCL_ERROR;
	    }
	    Tcl_SetStringObj(resultPtr, name, -1);
	    break;
	}
	case WIN_CONTAINING: {
	    skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
	    if (skip < 0) {
		return TCL_ERROR;
	    }
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
	    }
	    string = Tcl_GetStringFromObj(objv[3], NULL);
	    if (Tk_GetPixels(interp, tkwin, string, &y) != TCL_OK) {
		return TCL_ERROR;
	    }
	    tkwin = Tk_CoordsToWindow(x, y, tkwin);
	    if (tkwin != NULL) {
		Tcl_ResetResult(interp);
		Tcl_SetStringObj(Tcl_GetObjResult(interp),
			Tk_PathName(tkwin), -1);
	    }
	    break;
	}
	case WIN_INTERPS: {
	    int result;
	    
	    skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);







<
<
|







1274
1275
1276
1277
1278
1279
1280


1281
1282
1283
1284
1285
1286
1287
1288
	    }
	    string = Tcl_GetStringFromObj(objv[3], NULL);
	    if (Tk_GetPixels(interp, tkwin, string, &y) != TCL_OK) {
		return TCL_ERROR;
	    }
	    tkwin = Tk_CoordsToWindow(x, y, tkwin);
	    if (tkwin != NULL) {


		Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
	    }
	    break;
	}
	case WIN_INTERPS: {
	    int result;
	    
	    skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388



1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440

1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468


1469
1470
1471
1472
1473
1474
1475
	    if (TkpScanWindowId(interp, string, &id) != TCL_OK) {
		return TCL_ERROR;
	    }
	    winPtr = (TkWindow *)
	            Tk_IdToWindow(Tk_Display(tkwin), (Window) id);
	    if ((winPtr == NULL) ||
		    (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
		Tcl_ResetResult(interp);
		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			"window id \"", string,
			"\" doesn't exist in this application", (char *) NULL);
		return TCL_ERROR;
	    }

	    /*
	     * If the window is a utility window with no associated path
	     * (such as a wrapper window or send communication window), just
	     * return an empty string.
	     */

	    tkwin = (Tk_Window) winPtr;
	    if (Tk_PathName(tkwin) != NULL) {
		Tcl_ResetResult(interp);
		Tcl_SetStringObj(Tcl_GetObjResult(interp),
		        Tk_PathName(tkwin), -1);
	    }
	    break;
	}

	/*
	 * objv[3] is window.
	 */

	case WIN_EXISTS: {
	    int alive;

	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "window");
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[2], NULL);
	    winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);



	    alive = 1;
	    if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) {
		alive = 0;
	    }
	    Tcl_ResetResult(interp); /* clear any error msg */
	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), alive);
	    break;
	}
	case WIN_FPIXELS: {
	    double mm, pixels;

	    if (objc != 4) {
		Tcl_WrongNumArgs(interp, 2, objv, "window number");
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[2], NULL);
	    tkwin = Tk_NameToWindow(interp, string, tkwin);
	    if (tkwin == NULL) {
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[3], NULL);
	    if (Tk_GetScreenMM(interp, tkwin, string, &mm) != TCL_OK) {
		return TCL_ERROR;
	    }
	    pixels = mm * WidthOfScreen(Tk_Screen(tkwin))
		/ WidthMMOfScreen(Tk_Screen(tkwin));
	    Tcl_ResetResult(interp);
	    Tcl_SetDoubleObj(Tcl_GetObjResult(interp), pixels);
	    break;
	}
	case WIN_PIXELS: {
	    int pixels;
	    
	    if (objc != 4) {
		Tcl_WrongNumArgs(interp, 2, objv, "window number");
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[2], NULL);
	    tkwin = Tk_NameToWindow(interp, string, tkwin);
	    if (tkwin == NULL) {
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[3], NULL);
	    if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_ResetResult(interp);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), pixels);
	    break;
	}
	case WIN_RGB: {
	    XColor *colorPtr;


	    if (objc != 4) {
		Tcl_WrongNumArgs(interp, 2, objv, "window colorName");
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[2], NULL);
	    tkwin = Tk_NameToWindow(interp, string, tkwin);
	    if (tkwin == NULL) {
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[3], NULL);
	    colorPtr = Tk_GetColor(interp, tkwin, string);
	    if (colorPtr == NULL) {
		return TCL_ERROR;
	    }
	    sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green,
		    colorPtr->blue);
	    Tk_FreeColor(colorPtr);
	    Tcl_ResetResult(interp);
	    Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
	    break;
	}
	case WIN_VISUALSAVAILABLE: {
	    XVisualInfo template, *visInfoPtr;
	    int count, i;
	    char visualIdString[16];
	    int includeVisualId;
	    Tcl_Obj *strPtr;



	    if (objc == 3) {
		includeVisualId = 0;
	    } else if ((objc == 4)
		    && (strcmp(Tcl_GetStringFromObj(objv[3], NULL),
			    "includeids") == 0)) {
		includeVisualId = 1;







<
<
|












<
<
|

















>
>
>




<
|



















|
<
|


















<
|




>


















<
|





<


>
>







1311
1312
1313
1314
1315
1316
1317


1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330


1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355

1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376

1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395

1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419

1420
1421
1422
1423
1424
1425

1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
	    if (TkpScanWindowId(interp, string, &id) != TCL_OK) {
		return TCL_ERROR;
	    }
	    winPtr = (TkWindow *)
	            Tk_IdToWindow(Tk_Display(tkwin), (Window) id);
	    if ((winPtr == NULL) ||
		    (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {


		Tcl_AppendStringsToObj(resultPtr, "window id \"", string,
			"\" doesn't exist in this application", (char *) NULL);
		return TCL_ERROR;
	    }

	    /*
	     * If the window is a utility window with no associated path
	     * (such as a wrapper window or send communication window), just
	     * return an empty string.
	     */

	    tkwin = (Tk_Window) winPtr;
	    if (Tk_PathName(tkwin) != NULL) {


		Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
	    }
	    break;
	}

	/*
	 * objv[3] is window.
	 */

	case WIN_EXISTS: {
	    int alive;

	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "window");
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[2], NULL);
	    winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
	    Tcl_ResetResult(interp);
	    resultPtr = Tcl_GetObjResult(interp);

	    alive = 1;
	    if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) {
		alive = 0;
	    }

	    Tcl_SetBooleanObj(resultPtr, alive);
	    break;
	}
	case WIN_FPIXELS: {
	    double mm, pixels;

	    if (objc != 4) {
		Tcl_WrongNumArgs(interp, 2, objv, "window number");
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[2], NULL);
	    tkwin = Tk_NameToWindow(interp, string, tkwin);
	    if (tkwin == NULL) {
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[3], NULL);
	    if (Tk_GetScreenMM(interp, tkwin, string, &mm) != TCL_OK) {
		return TCL_ERROR;
	    }
	    pixels = mm * WidthOfScreen(Tk_Screen(tkwin))
		    / WidthMMOfScreen(Tk_Screen(tkwin));

	    Tcl_SetDoubleObj(resultPtr, pixels);
	    break;
	}
	case WIN_PIXELS: {
	    int pixels;
	    
	    if (objc != 4) {
		Tcl_WrongNumArgs(interp, 2, objv, "window number");
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[2], NULL);
	    tkwin = Tk_NameToWindow(interp, string, tkwin);
	    if (tkwin == NULL) {
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[3], NULL);
	    if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {
		return TCL_ERROR;
	    }

	    Tcl_SetIntObj(resultPtr, pixels);
	    break;
	}
	case WIN_RGB: {
	    XColor *colorPtr;
	    char buf[TCL_INTEGER_SPACE * 3];

	    if (objc != 4) {
		Tcl_WrongNumArgs(interp, 2, objv, "window colorName");
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[2], NULL);
	    tkwin = Tk_NameToWindow(interp, string, tkwin);
	    if (tkwin == NULL) {
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[3], NULL);
	    colorPtr = Tk_GetColor(interp, tkwin, string);
	    if (colorPtr == NULL) {
		return TCL_ERROR;
	    }
	    sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green,
		    colorPtr->blue);
	    Tk_FreeColor(colorPtr);

	    Tcl_SetStringObj(resultPtr, buf, -1);
	    break;
	}
	case WIN_VISUALSAVAILABLE: {
	    XVisualInfo template, *visInfoPtr;
	    int count, i;

	    int includeVisualId;
	    Tcl_Obj *strPtr;
	    char buf[16 + TCL_INTEGER_SPACE];
	    char visualIdString[TCL_INTEGER_SPACE];

	    if (objc == 3) {
		includeVisualId = 0;
	    } else if ((objc == 4)
		    && (strcmp(Tcl_GetStringFromObj(objv[3], NULL),
			    "includeids") == 0)) {
		includeVisualId = 1;
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
	    if (tkwin == NULL) { 
		return TCL_ERROR; 
	    }

	    template.screen = Tk_ScreenNumber(tkwin);
	    visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask,
		    &template, &count);
	    Tcl_ResetResult(interp);
	    if (visInfoPtr == NULL) {
		Tcl_SetStringObj(Tcl_GetObjResult(interp),
			"can't find any visuals for screen", -1);
		return TCL_ERROR;
	    }
	    for (i = 0; i < count; i++) {
		string = TkFindStateString(visualMap, visInfoPtr[i].class);
		if (string == NULL) {
		    strcpy(buf, "unknown");
		} else {
		    sprintf(buf, "%s %d", string, visInfoPtr[i].depth);
		}
		if (includeVisualId) {
		    sprintf(visualIdString, " 0x%x",
			    (unsigned int) visInfoPtr[i].visualid);
		    strcat(buf, visualIdString);
		}
		strPtr = Tcl_NewStringObj(buf, -1);
		Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
		        strPtr);
	    }
	    XFree((char *) visInfoPtr);
	    break;
	}
    }
    return TCL_OK;
}







<

|
















|
<







1444
1445
1446
1447
1448
1449
1450

1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469

1470
1471
1472
1473
1474
1475
1476
	    if (tkwin == NULL) { 
		return TCL_ERROR; 
	    }

	    template.screen = Tk_ScreenNumber(tkwin);
	    visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask,
		    &template, &count);

	    if (visInfoPtr == NULL) {
		Tcl_SetStringObj(resultPtr,
			"can't find any visuals for screen", -1);
		return TCL_ERROR;
	    }
	    for (i = 0; i < count; i++) {
		string = TkFindStateString(visualMap, visInfoPtr[i].class);
		if (string == NULL) {
		    strcpy(buf, "unknown");
		} else {
		    sprintf(buf, "%s %d", string, visInfoPtr[i].depth);
		}
		if (includeVisualId) {
		    sprintf(visualIdString, " 0x%x",
			    (unsigned int) visInfoPtr[i].visualid);
		    strcat(buf, visualIdString);
		}
		strPtr = Tcl_NewStringObj(buf, -1);
		Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);

	    }
	    XFree((char *) visInfoPtr);
	    break;
	}
    }
    return TCL_OK;
}

Changes to generic/tkColor.c.

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
/* 
 * tkColor.c --
 *
 *	This file maintains a database of color values for the Tk
 *	toolkit, in order to avoid round-trips to the server to
 *	map color names to pixel values.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkColor.c 1.44 96/11/04 13:55:25
 */

#include <tkColor.h>

/*
 * A two-level data structure is used to manage the color database.
 * The top level consists of one entry for each color name that is
 * currently active, and the bottom level contains one entry for each
 * pixel value that is still in use.  The distinction between
 * levels is necessary because the same pixel may have several
 * different names.  There are two hash tables, one used to index into
 * each of the data structures.  The name hash table is used when
 * allocating colors, and the pixel hash table is used when freeing
 * colors.
 */


/*
 * Hash table for name -> TkColor mapping, and key structure used to
 * index into that table:
 */

static Tcl_HashTable nameTable;
typedef struct {
    Tk_Uid name;		/* Name of desired color. */
    Colormap colormap;		/* Colormap from which color will be
				 * allocated. */
    Display *display;		/* Display for colormap. */
} NameKey;

/*
 * Hash table for value -> TkColor mapping, and key structure used to
 * index into that table:
 */

static Tcl_HashTable valueTable;
typedef struct {
    int red, green, blue;	/* Values for desired color. */
    Colormap colormap;		/* Colormap from which color will be
				 * allocated. */
    Display *display;		/* Display for colormap. */
} ValueKey;

static int initialized = 0;	/* 0 means static structures haven't been



				 * initialized yet. */





/*
 * Forward declarations for procedures defined in this file:
 */

static void		ColorInit _ANSI_ARGS_((void));



















































































































/*
 *----------------------------------------------------------------------
 *
 * Tk_GetColor --
 *
 *	Given a string name for a color, map the name to a corresponding
 *	XColor structure.
 *
 * Results:
 *	The return value is a pointer to an XColor structure that
 *	indicates the red, blue, and green intensities for the color
 *	given by "name", and also specifies a pixel value to use to
 *	draw in that color.  If an error occurs, NULL is returned and
 *	an error message will be left in interp->result.
 *
 * Side effects:
 *	The color is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call
 *	to Tk_FreeColor so that the database is cleaned up when colors
 *	aren't in use anymore.
 *
 *----------------------------------------------------------------------
 */

XColor *
Tk_GetColor(interp, tkwin, name)
    Tcl_Interp *interp;		/* Place to leave error message if
				 * color can't be found. */
    Tk_Window tkwin;		/* Window in which color will be used. */
    Tk_Uid name;		/* Name of color to allocated (in form
				 * suitable for passing to XParseColor). */
{
    NameKey nameKey;
    Tcl_HashEntry *nameHashPtr;
    int new;
    TkColor *tkColPtr;

    Display *display = Tk_Display(tkwin);

    if (!initialized) {
	ColorInit();
    }

    /*
     * First, check to see if there's already a mapping for this color
     * name.
     */

    nameKey.name = name;
    nameKey.colormap = Tk_Colormap(tkwin);
    nameKey.display = display;
    nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &nameKey, &new);
    if (!new) {
	tkColPtr = (TkColor *) Tcl_GetHashValue(nameHashPtr);




	tkColPtr->refCount++;
	return &tkColPtr->color;




    }

    /*
     * The name isn't currently known.  Map from the name to a pixel
     * value.
     */

    tkColPtr = TkpGetColor(tkwin, name);
    if (tkColPtr == NULL) {
	if (interp != NULL) {
	    if (*name == '#') {
		Tcl_AppendResult(interp, "invalid color name \"", name,
			"\"", (char *) NULL);
	    } else {
		Tcl_AppendResult(interp, "unknown color name \"", name,
			"\"", (char *) NULL);
	    }
	}

	Tcl_DeleteHashEntry(nameHashPtr);

	return (XColor *) NULL;
    }

    /*
     * Now create a new TkColor structure and add it to nameTable.

     */

    tkColPtr->magic = COLOR_MAGIC;
    tkColPtr->gc = None;
    tkColPtr->screen = Tk_Screen(tkwin);
    tkColPtr->colormap = nameKey.colormap;
    tkColPtr->visual  = Tk_Visual(tkwin);
    tkColPtr->refCount = 1;

    tkColPtr->tablePtr = &nameTable;
    tkColPtr->hashPtr = nameHashPtr;

    Tcl_SetHashValue(nameHashPtr, tkColPtr);

    return &tkColPtr->color;
}

/*
 *----------------------------------------------------------------------








|




|


|


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


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







|
>
>
>
|
>
>
>
>





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














|















|


<



>
|

|
|







<
<
<
|

|
>
>
>
>
|
|
>
>
>
>


















>
|
>




|
>





|

|
>
|

>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19










20
21



22
23














24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192

193
194
195
196
197
198
199
200
201
202
203
204
205
206
207



208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
/* 
 * tkColor.c --
 *
 *	This file maintains a database of color values for the Tk
 *	toolkit, in order to avoid round-trips to the server to
 *	map color names to pixel values.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkColor.c,v 1.1.4.3 1998/12/13 08:16:03 lfb Exp $
 */

#include "tkColor.h"

/*










 * Structures of the following following type are used as keys for 
 * colorValueTable (in TkDisplay).



 */















typedef struct {
    int red, green, blue;	/* Values for desired color. */
    Colormap colormap;		/* Colormap from which color will be
				 * allocated. */
    Display *display;		/* Display for colormap. */
} ValueKey;


/*
 * The structure below is used to allocate thread-local data. 
 */

typedef struct ThreadSpecificData {
    char rgbString[20];            /* */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations for procedures defined in this file:
 */

static void		ColorInit _ANSI_ARGS_((TkDisplay *dispPtr));
static void		DupColorObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
			    Tcl_Obj *dupObjPtr));
static void		FreeColorObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
static void		InitColorObj _ANSI_ARGS_((Tcl_Obj *objPtr));

/*
 * The following structure defines the implementation of the "color" Tcl
 * object, which maps a string color name to a TkColor object.  The
 * ptr1 field of the Tcl_Obj points to a TkColor object.
 */

static Tcl_ObjType colorObjType = {
    "color",			/* name */
    FreeColorObjProc,		/* freeIntRepProc */
    DupColorObjProc,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL			/* setFromAnyProc */
};

/*
 *----------------------------------------------------------------------
 *
 * Tk_AllocColorFromObj --
 *
 *	Given a Tcl_Obj *, map the value to a corresponding
 *	XColor structure based on the tkwin given.
 *
 * Results:
 *	The return value is a pointer to an XColor structure that
 *	indicates the red, blue, and green intensities for the color
 *	given by the string in objPtr, and also specifies a pixel value 
 *	to use to draw in that color.  If an error occurs, NULL is 
 *	returned and an error message will be left in interp's result
 *	(unless interp is NULL).
 *
 * Side effects:
 *	The color is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call
 *	to Tk_FreeColorFromObj so that the database is cleaned up when colors
 *	aren't in use anymore.
 *
 *----------------------------------------------------------------------
 */

XColor *
Tk_AllocColorFromObj(interp, tkwin, objPtr)
    Tcl_Interp *interp;		/* Used only for error reporting.  If NULL,
				 * then no messages are provided. */
    Tk_Window tkwin;		/* Window in which the color will be used.*/
    Tcl_Obj *objPtr;		/* Object that describes the color; string
				 * value is a color name such as "red" or
				 * "#ff0000".*/
{
    TkColor *tkColPtr;

    if (objPtr->typePtr != &colorObjType) {
	InitColorObj(objPtr);
    }
    tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;

    /*
     * If the object currently points to a TkColor, see if it's the
     * one we want.  If so, increment its reference count and return.
     */

    if (tkColPtr != NULL) {
	if (tkColPtr->resourceRefCount == 0) {
	    /*
	     * This is a stale reference: it refers to a TkColor that's
	     * no longer in use.  Clear the reference.
	     */

	    FreeColorObjProc(objPtr);
	    tkColPtr = NULL;
	} else if ((Tk_Screen(tkwin) == tkColPtr->screen)
		&& (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
	    tkColPtr->resourceRefCount++;
	    return (XColor *) tkColPtr;
	}
    }

    /*
     * The object didn't point to the TkColor that we wanted.  Search
     * the list of TkColors with the same name to see if one of the
     * other TkColors is the right one.
     */

    if (tkColPtr != NULL) {
	TkColor *firstColorPtr = 
		(TkColor *) Tcl_GetHashValue(tkColPtr->hashPtr);
	FreeColorObjProc(objPtr);
	for (tkColPtr = firstColorPtr; tkColPtr != NULL;
		tkColPtr = tkColPtr->nextPtr) {
	    if ((Tk_Screen(tkwin) == tkColPtr->screen)
		    && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
		tkColPtr->resourceRefCount++;
		tkColPtr->objRefCount++;
		objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
		return (XColor *) tkColPtr;
	    }
	}
    }

    /*
     * Still no luck.  Call Tk_GetColor to allocate a new TkColor object.
     */

    tkColPtr = (TkColor *) Tk_GetColor(interp, tkwin, Tcl_GetString(objPtr));
    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
    if (tkColPtr != NULL) {
	tkColPtr->objRefCount++;
    }
    return (XColor *) tkColPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetColor --
 *
 *	Given a string name for a color, map the name to a corresponding
 *	XColor structure.
 *
 * Results:
 *	The return value is a pointer to an XColor structure that
 *	indicates the red, blue, and green intensities for the color
 *	given by "name", and also specifies a pixel value to use to
 *	draw in that color.  If an error occurs, NULL is returned and
 *	an error message will be left in the interp's result.
 *
 * Side effects:
 *	The color is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call
 *	to Tk_FreeColor so that the database is cleaned up when colors
 *	aren't in use anymore.
 *
 *----------------------------------------------------------------------
 */

XColor *
Tk_GetColor(interp, tkwin, name)
    Tcl_Interp *interp;		/* Place to leave error message if
				 * color can't be found. */
    Tk_Window tkwin;		/* Window in which color will be used. */
    char *name;			/* Name of color to be allocated (in form
				 * suitable for passing to XParseColor). */
{

    Tcl_HashEntry *nameHashPtr;
    int new;
    TkColor *tkColPtr;
    TkColor *existingColPtr;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    if (!dispPtr->colorInit) {
	ColorInit(dispPtr);
    }

    /*
     * First, check to see if there's already a mapping for this color
     * name.
     */




    nameHashPtr = Tcl_CreateHashEntry(&dispPtr->colorNameTable, name, &new);
    if (!new) {
	existingColPtr = (TkColor *) Tcl_GetHashValue(nameHashPtr);
	for (tkColPtr = existingColPtr;  tkColPtr != NULL;
		tkColPtr = tkColPtr->nextPtr) {
	    if ((tkColPtr->screen == Tk_Screen(tkwin))
		    && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
		tkColPtr->resourceRefCount++;
		return &tkColPtr->color;
	    }
	}
    } else {
	existingColPtr = NULL;
    }

    /*
     * The name isn't currently known.  Map from the name to a pixel
     * value.
     */

    tkColPtr = TkpGetColor(tkwin, name);
    if (tkColPtr == NULL) {
	if (interp != NULL) {
	    if (*name == '#') {
		Tcl_AppendResult(interp, "invalid color name \"", name,
			"\"", (char *) NULL);
	    } else {
		Tcl_AppendResult(interp, "unknown color name \"", name,
			"\"", (char *) NULL);
	    }
	}
	if (new) {
	    Tcl_DeleteHashEntry(nameHashPtr);
	}
	return (XColor *) NULL;
    }

    /*
     * Now create a new TkColor structure and add it to colorNameTable
     * (in TkDisplay).
     */

    tkColPtr->magic = COLOR_MAGIC;
    tkColPtr->gc = None;
    tkColPtr->screen = Tk_Screen(tkwin);
    tkColPtr->colormap = Tk_Colormap(tkwin);
    tkColPtr->visual  = Tk_Visual(tkwin);
    tkColPtr->resourceRefCount = 1;
    tkColPtr->objRefCount = 0;
    tkColPtr->tablePtr = &dispPtr->colorNameTable;
    tkColPtr->hashPtr = nameHashPtr;
    tkColPtr->nextPtr = existingColPtr;
    Tcl_SetHashValue(nameHashPtr, tkColPtr);

    return &tkColPtr->color;
}

/*
 *----------------------------------------------------------------------
189
190
191
192
193
194
195

196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211

212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229

230
231

232
233
234
235
236
237
238
				 * desired color. */
{
    ValueKey valueKey;
    Tcl_HashEntry *valueHashPtr;
    int new;
    TkColor *tkColPtr;
    Display *display = Tk_Display(tkwin);


    if (!initialized) {
	ColorInit();
    }

    /*
     * First, check to see if there's already a mapping for this color
     * name.
     */

    valueKey.red = colorPtr->red;
    valueKey.green = colorPtr->green;
    valueKey.blue = colorPtr->blue;
    valueKey.colormap = Tk_Colormap(tkwin);
    valueKey.display = display;
    valueHashPtr = Tcl_CreateHashEntry(&valueTable, (char *) &valueKey, &new);

    if (!new) {
	tkColPtr = (TkColor *) Tcl_GetHashValue(valueHashPtr);
	tkColPtr->refCount++;
	return &tkColPtr->color;
    }

    /*
     * The name isn't currently known.  Find a pixel value for this
     * color and add a new structure to valueTable.
     */

    tkColPtr = TkpGetColorByValue(tkwin, colorPtr);
    tkColPtr->magic = COLOR_MAGIC;
    tkColPtr->gc = None;
    tkColPtr->screen = Tk_Screen(tkwin);
    tkColPtr->colormap = valueKey.colormap;
    tkColPtr->visual  = Tk_Visual(tkwin);
    tkColPtr->refCount = 1;

    tkColPtr->tablePtr = &valueTable;
    tkColPtr->hashPtr = valueHashPtr;

    Tcl_SetHashValue(valueHashPtr, tkColPtr);
    return &tkColPtr->color;
}

/*
 *--------------------------------------------------------------
 *







>

|
|












|
>


|





|








|
>
|

>







293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
				 * desired color. */
{
    ValueKey valueKey;
    Tcl_HashEntry *valueHashPtr;
    int new;
    TkColor *tkColPtr;
    Display *display = Tk_Display(tkwin);
    TkDisplay *dispPtr = TkGetDisplay(display);

    if (!dispPtr->colorInit) {
	ColorInit(dispPtr);
    }

    /*
     * First, check to see if there's already a mapping for this color
     * name.
     */

    valueKey.red = colorPtr->red;
    valueKey.green = colorPtr->green;
    valueKey.blue = colorPtr->blue;
    valueKey.colormap = Tk_Colormap(tkwin);
    valueKey.display = display;
    valueHashPtr = Tcl_CreateHashEntry(&dispPtr->colorValueTable, 
            (char *) &valueKey, &new);
    if (!new) {
	tkColPtr = (TkColor *) Tcl_GetHashValue(valueHashPtr);
	tkColPtr->resourceRefCount++;
	return &tkColPtr->color;
    }

    /*
     * The name isn't currently known.  Find a pixel value for this
     * color and add a new structure to colorValueTable (in TkDisplay).
     */

    tkColPtr = TkpGetColorByValue(tkwin, colorPtr);
    tkColPtr->magic = COLOR_MAGIC;
    tkColPtr->gc = None;
    tkColPtr->screen = Tk_Screen(tkwin);
    tkColPtr->colormap = valueKey.colormap;
    tkColPtr->visual  = Tk_Visual(tkwin);
    tkColPtr->resourceRefCount = 1;
    tkColPtr->objRefCount = 0;
    tkColPtr->tablePtr = &dispPtr->colorValueTable;
    tkColPtr->hashPtr = valueHashPtr;
    tkColPtr->nextPtr = NULL;
    Tcl_SetHashValue(valueHashPtr, tkColPtr);
    return &tkColPtr->color;
}

/*
 *--------------------------------------------------------------
 *
256
257
258
259
260
261
262
263

264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
 */

char *
Tk_NameOfColor(colorPtr)
    XColor *colorPtr;		/* Color whose name is desired. */
{
    register TkColor *tkColPtr = (TkColor *) colorPtr;
    static char string[20];


    if ((tkColPtr->magic == COLOR_MAGIC)
	    && (tkColPtr->tablePtr == &nameTable)) {
	return ((NameKey *) tkColPtr->hashPtr->key.words)->name;
    }
    sprintf(string, "#%04x%04x%04x", colorPtr->red, colorPtr->green,
	    colorPtr->blue);
    return string;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GCForColor --
 *







|
>
|
|
<
|

|
|
|







364
365
366
367
368
369
370
371
372
373
374

375
376
377
378
379
380
381
382
383
384
385
386
 */

char *
Tk_NameOfColor(colorPtr)
    XColor *colorPtr;		/* Color whose name is desired. */
{
    register TkColor *tkColPtr = (TkColor *) colorPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    
    if (tkColPtr->magic == COLOR_MAGIC) {

	return tkColPtr->hashPtr->key.string;
    }
    sprintf(tsdPtr->rgbString, "#%04x%04x%04x", colorPtr->red, 
            colorPtr->green, colorPtr->blue);
    return tsdPtr->rgbString;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GCForColor --
 *
343
344
345
346
347
348
349
350
351

352
353
354
355
356
357
358
359
360
361
362
363









364
365
366
367
368




369

















370
371
372
373

























































































































































































































374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392

393

394

395
396
397



















































void
Tk_FreeColor(colorPtr)
    XColor *colorPtr;		/* Color to be released.  Must have been
				 * allocated by Tk_GetColor or
				 * Tk_GetColorByValue. */
{
    register TkColor *tkColPtr = (TkColor *) colorPtr;
    Screen *screen = tkColPtr->screen;


    /*
     * Do a quick sanity check to make sure this color was really
     * allocated by Tk_GetColor.
     */

    if (tkColPtr->magic != COLOR_MAGIC) {
	panic("Tk_FreeColor called with bogus color");
    }

    tkColPtr->refCount--;
    if (tkColPtr->refCount == 0) {









	if (tkColPtr->gc != None) {
	    XFreeGC(DisplayOfScreen(screen), tkColPtr->gc);
	    tkColPtr->gc = None;
	}
	TkpFreeColor(tkColPtr);




	Tcl_DeleteHashEntry(tkColPtr->hashPtr);

















	tkColPtr->magic = 0;
	ckfree((char *) tkColPtr);
    }
}


























































































































































































































/*
 *----------------------------------------------------------------------
 *
 * ColorInit --
 *
 *	Initialize the structure used for color management.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Read the code.
 *
 *----------------------------------------------------------------------
 */

static void
ColorInit()

{

    initialized = 1;

    Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(int));
    Tcl_InitHashTable(&valueTable, sizeof(ValueKey)/sizeof(int));
}

























































|

>










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



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


















|
>

>
|
>
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806

void
Tk_FreeColor(colorPtr)
    XColor *colorPtr;		/* Color to be released.  Must have been
				 * allocated by Tk_GetColor or
				 * Tk_GetColorByValue. */
{
    TkColor *tkColPtr = (TkColor *) colorPtr;
    Screen *screen = tkColPtr->screen;
    TkColor *prevPtr;

    /*
     * Do a quick sanity check to make sure this color was really
     * allocated by Tk_GetColor.
     */

    if (tkColPtr->magic != COLOR_MAGIC) {
	panic("Tk_FreeColor called with bogus color");
    }

    tkColPtr->resourceRefCount--;
    if (tkColPtr->resourceRefCount > 0) {
	return;
    }

    /*
     * This color is no longer being actively used, so free the color
     * resources associated with it and remove it from the hash table.
     * no longer any objects referencing it.
     */

    if (tkColPtr->gc != None) {
	XFreeGC(DisplayOfScreen(screen), tkColPtr->gc);
	tkColPtr->gc = None;
    }
    TkpFreeColor(tkColPtr);

    prevPtr = (TkColor *) Tcl_GetHashValue(tkColPtr->hashPtr);
    if (prevPtr == tkColPtr) {
	if (tkColPtr->nextPtr == NULL) {
	    Tcl_DeleteHashEntry(tkColPtr->hashPtr);
	} else  {
	    Tcl_SetHashValue(tkColPtr->hashPtr, tkColPtr->nextPtr);
	}
    } else {
	while (prevPtr->nextPtr != tkColPtr) {
	    prevPtr = prevPtr->nextPtr;
	}
	prevPtr->nextPtr = tkColPtr->nextPtr;
    }

    /*
     * Free the TkColor structure if there are no objects referencing
     * it.  However, if there are objects referencing it then keep the
     * structure around; it will get freed when the last reference is
     * cleared
     */

    if (tkColPtr->objRefCount == 0) {
	ckfree((char *) tkColPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_FreeColorFromObj --
 *
 *	This procedure is called to release a color allocated by
 *	Tk_AllocColorFromObj. It does not throw away the Tcl_Obj *;
 *	it only gets rid of the hash table entry for this color
 *	and clears the cached value that is normally stored in the object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The reference count associated with the color represented by
 *	objPtr is decremented, and the color is released to X if there are 
 *	no remaining uses for it.
 *
 *----------------------------------------------------------------------
 */

void
Tk_FreeColorFromObj(tkwin, objPtr)
    Tk_Window tkwin;		/* The window this color lives in. Needed
				 * for the screen and colormap values. */
    Tcl_Obj *objPtr;		/* The Tcl_Obj * to be freed. */
{
    Tk_FreeColor(Tk_GetColorFromObj(tkwin, objPtr));
}

/*
 *---------------------------------------------------------------------------
 *
 * FreeColorObjProc -- 
 *
 *	This proc is called to release an object reference to a color.
 *	Called when the object's internal rep is released or when
 *	the cached tkColPtr needs to be changed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object reference count is decremented. When both it
 *	and the hash ref count go to zero, the color's resources
 *	are released.
 *
 *---------------------------------------------------------------------------
 */

static void
FreeColorObjProc(objPtr)
    Tcl_Obj *objPtr;		/* The object we are releasing. */
{
    TkColor *tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;

    if (tkColPtr != NULL) {
	tkColPtr->objRefCount--;
	if ((tkColPtr->objRefCount == 0) 
		&& (tkColPtr->resourceRefCount == 0)) {
	    ckfree((char *) tkColPtr);
	}
	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * DupColorObjProc -- 
 *
 *	When a cached color object is duplicated, this is called to
 *	update the internal reps.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The color's objRefCount is incremented and the internal rep
 *	of the copy is set to point to it.
 *
 *---------------------------------------------------------------------------
 */

static void
DupColorObjProc(srcObjPtr, dupObjPtr)
    Tcl_Obj *srcObjPtr;		/* The object we are copying from. */
    Tcl_Obj *dupObjPtr;		/* The object we are copying to. */
{
    TkColor *tkColPtr = (TkColor *) srcObjPtr->internalRep.twoPtrValue.ptr1;
    
    dupObjPtr->typePtr = srcObjPtr->typePtr;
    dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;

    if (tkColPtr != NULL) {
	tkColPtr->objRefCount++;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetColorFromObj --
 *
 *	Returns the color referred to by a Tcl object.  The color must
 *	already have been allocated via a call to Tk_AllocColorFromObj
 *	or Tk_GetColor.
 *
 * Results:
 *	Returns the XColor * that matches the tkwin and the string rep
 *	of objPtr.
 *
 * Side effects:
 *	If the object is not already a color, the conversion will free
 *	any old internal representation. 
 *
 *----------------------------------------------------------------------
 */

XColor *
Tk_GetColorFromObj(tkwin, objPtr)
    Tk_Window tkwin;		/* The window in which the color will be
				 * used. */
    Tcl_Obj *objPtr;		/* String value contains the name of the
				 * desired color. */
{
    TkColor *tkColPtr;
    Tcl_HashEntry *hashPtr;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    if (objPtr->typePtr != &colorObjType) {
	InitColorObj(objPtr);
    }

    tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
    if (tkColPtr != NULL) {
	if ((tkColPtr->resourceRefCount > 0)
		&& (Tk_Screen(tkwin) == tkColPtr->screen)
		&& (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
	    /*
	     * The object already points to the right TkColor structure.
	     * Just return it.
	     */

	    return (XColor *) tkColPtr;
	}
	hashPtr = tkColPtr->hashPtr;
	FreeColorObjProc(objPtr);
    } else {
	hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, 
                Tcl_GetString(objPtr));
	if (hashPtr == NULL) {
	    goto error;
	}
    }

    /*
     * At this point we've got a hash table entry, off of which hang
     * one or more TkColor structures.  See if any of them will work.
     */

    for (tkColPtr = (TkColor *) Tcl_GetHashValue(hashPtr);
	    (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) {
	if ((Tk_Screen(tkwin) == tkColPtr->screen)
		&& (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
	    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
	    tkColPtr->objRefCount++;
	    return (XColor *) tkColPtr;
	}
    }

    error:
    panic(" Tk_GetColorFromObj called with non-existent color!");
    /*
     * The following code isn't reached; it's just there to please compilers.
     */
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * InitColorObj --
 *
 *	Bookeeping procedure to change an objPtr to a color type.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The old internal rep of the object is freed. The object's
 *	type is set to color with a NULL TkColor pointer (the pointer
 *	will be set later by either Tk_AllocColorFromObj or
 *	Tk_GetColorFromObj).
 *
 *----------------------------------------------------------------------
 */

static void
InitColorObj(objPtr)
    Tcl_Obj *objPtr;		/* The object to convert. */
{
    Tcl_ObjType *typePtr;

    /*
     * Free the old internalRep before setting the new one. 
     */

    Tcl_GetString(objPtr);
    typePtr = objPtr->typePtr;
    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	(*typePtr->freeIntRepProc)(objPtr);
    }
    objPtr->typePtr = &colorObjType;
    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ColorInit --
 *
 *	Initialize the structure used for color management.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Read the code.
 *
 *----------------------------------------------------------------------
 */

static void
ColorInit(dispPtr)
    TkDisplay *dispPtr;
{
    if (!dispPtr->colorInit) {
        dispPtr->colorInit = 1;
	Tcl_InitHashTable(&dispPtr->colorNameTable, TCL_STRING_KEYS);
	Tcl_InitHashTable(&dispPtr->colorValueTable, 
                sizeof(ValueKey)/sizeof(int));
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkDebugColor --
 *
 *	This procedure returns debugging information about a color.
 *
 * Results:
 *	The return value is a list with one sublist for each TkColor
 *	corresponding to "name".  Each sublist has two elements that
 *	contain the resourceRefCount and objRefCount fields from the
 *	TkColor structure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TkDebugColor(tkwin, name)
    Tk_Window tkwin;		/* The window in which the color will be
				 * used (not currently used). */
    char *name;			/* Name of the desired color. */
{
    TkColor *tkColPtr;
    Tcl_HashEntry *hashPtr;
    Tcl_Obj *resultPtr, *objPtr;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    resultPtr = Tcl_NewObj();
    hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, name);
    if (hashPtr != NULL) {
	tkColPtr = (TkColor *) Tcl_GetHashValue(hashPtr);
	if (tkColPtr == NULL) {
	    panic("TkDebugColor found empty hash table entry");
	}
	for ( ; (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) {
	    objPtr = Tcl_NewObj();
	    Tcl_ListObjAppendElement(NULL, objPtr,
		    Tcl_NewIntObj(tkColPtr->resourceRefCount));
	    Tcl_ListObjAppendElement(NULL, objPtr,
		    Tcl_NewIntObj(tkColPtr->objRefCount)); 
	    Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
	}
    }
    return resultPtr;
}

Changes to generic/tkColor.h.

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
/*
 * tkColor.h --
 *
 *	Declarations of data types and functions used by the
 *	Tk color module.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkColor.h 1.1 96/10/22 16:53:09
 */

#ifndef _TKCOLOR
#define _TKCOLOR

#include <tkInt.h>






/*
 * One of the following data structures is used to keep track of
 * each color that the color module has allocated from the X display
 * server.

 */

#define COLOR_MAGIC ((unsigned int) 0x46140277)

typedef struct TkColor {
    XColor color;		/* Information about this color. */
    unsigned int magic;		/* Used for quick integrity check on this
				 * structure.   Must always have the
				 * value COLOR_MAGIC. */
    GC gc;			/* Simple gc with this color as foreground
				 * color and all other fields defaulted.
				 * May be None. */
    Screen *screen;		/* Screen where this color is valid.  Used
				 * to delete it, and to find its display. */
    Colormap colormap;		/* Colormap from which this entry was
				 * allocated. */
    Visual *visual;             /* Visual associated with colormap. */











    int refCount;		/* Number of uses of this structure. */
    Tcl_HashTable *tablePtr;	/* Hash table that indexes this structure
				 * (needed when deleting structure). */
    Tcl_HashEntry *hashPtr;	/* Pointer to hash table entry for this
				 * structure. (for use in deleting entry). */








} TkColor;

/*
 * Common APIs exported from all platform-specific implementations.
 */

#ifndef TkpFreeColor
EXTERN void		TkpFreeColor _ANSI_ARGS_((TkColor *tkColPtr));
#endif
EXTERN TkColor *	TkpGetColor _ANSI_ARGS_((Tk_Window tkwin,
			    Tk_Uid name));
EXTERN TkColor *	TkpGetColorByValue _ANSI_ARGS_((Tk_Window tkwin,
			    XColor *colorPtr));	




#endif /* _TKCOLOR */






|




|







>
>
>
>
>


|
<
>

















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




>
>
>
>
>
>
>
>














>
>
>

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
/*
 * tkColor.h --
 *
 *	Declarations of data types and functions used by the
 *	Tk color module.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkColor.h,v 1.1.4.2 1998/09/30 02:16:51 stanton Exp $
 */

#ifndef _TKCOLOR
#define _TKCOLOR

#include <tkInt.h>

#ifdef BUILD_tk
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * One of the following data structures is used to keep track of
 * each color that is being used by the application; typically there

 * is a colormap entry allocated for each of these colors.
 */

#define COLOR_MAGIC ((unsigned int) 0x46140277)

typedef struct TkColor {
    XColor color;		/* Information about this color. */
    unsigned int magic;		/* Used for quick integrity check on this
				 * structure.   Must always have the
				 * value COLOR_MAGIC. */
    GC gc;			/* Simple gc with this color as foreground
				 * color and all other fields defaulted.
				 * May be None. */
    Screen *screen;		/* Screen where this color is valid.  Used
				 * to delete it, and to find its display. */
    Colormap colormap;		/* Colormap from which this entry was
				 * allocated. */
    Visual *visual;             /* Visual associated with colormap. */
    int resourceRefCount;	/* Number of active uses of this color (each
				 * active use corresponds to a call to
				 * Tk_AllocColorFromObj or Tk_GetColor).
				 * If this count is 0, then this TkColor
				 * structure is no longer valid and it isn't
				 * present in a hash table: it is being
				 * kept around only because there are objects
				 * referring to it.  The structure is freed
				 * when resourceRefCount and objRefCount
				 * are both 0. */
    int objRefCount;		/* The number of Tcl objects that reference
				 * this structure. */
    Tcl_HashTable *tablePtr;	/* Hash table that indexes this structure
				 * (needed when deleting structure). */
    Tcl_HashEntry *hashPtr;	/* Pointer to hash table entry for this
				 * structure. (for use in deleting entry). */
    struct TkColor *nextPtr;	/* Points to the next TkColor structure with
				 * the same color name.  Colors with the
				 * same name but different screens or
				 * colormaps are chained together off a
				 * single entry in nameTable.  For colors in
				 * valueTable (those allocated by
				 * Tk_GetColorByValue) this field is always
				 * NULL. */
} TkColor;

/*
 * Common APIs exported from all platform-specific implementations.
 */

#ifndef TkpFreeColor
EXTERN void		TkpFreeColor _ANSI_ARGS_((TkColor *tkColPtr));
#endif
EXTERN TkColor *	TkpGetColor _ANSI_ARGS_((Tk_Window tkwin,
			    Tk_Uid name));
EXTERN TkColor *	TkpGetColorByValue _ANSI_ARGS_((Tk_Window tkwin,
			    XColor *colorPtr));	

# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TKCOLOR */

Changes to generic/tkConfig.c.

1
2
3
4

5
6
7
8
9
10
11


12


13
14











15
16
17
18



19

20














21


















22







23

24



25
26
27





















28
29
30
31
32
33































































































































34






35











































36





37













































































38









39




40





























































41




42








































43



44








45


































































































































































































































































































































































































































































































46

47
48


49






50











51
52













53





54








55
56








57



















58

59
60




61










62





















63

64
65
66
67
68
69

70
71

72

73
74




75
76
77

78
79


80

81
82
83

84
85
86
87
88
89





90

91




92
93



94




95






96
97


98
99
100
101


102
103



104
105
106
107

108

109


110




111
112


113
114


115

116
117



118

119

120





121
122


123
124
125
126


127
128



129




130
131
132



133

134
135
136
137
138
139
140
141
142


143
144
145
146

147



148
149



150
151
152
153
154
155
156













157
158


159



160
161
162
163
164
165
166



167
168
169

170
171

172
173

174



175
176


177
178
179

180



181

182
183
184
185
186


187
188









189

190







191

192
193
194
195



196

197
198




199




200


201
202
203
204


205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325

326
327
328
329
330
331
332
333


334

335


336





337
338
339



340
341


342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363


364
365

366
367
368
369





370
371
372
373
374
375
376
377
378
379
380


381
382
383


384
385
386
387
388

389
390
391

392
393
394
395
396

397


398
399

400



401
402

403
404
405
406
407
408

409
410
411
412
413


414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435



436
437


438
439
440
441
442

443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460



461
462



463
464


465


466
467
468
469
470
471
472
473
474
475

476
477
478

479
480

481
482
483



484

485
486
487
488
489
490
491
492
493
494

495

496
497
498
499
500
501
502
503
504


505
506
507
508
509
510
511
512
513

514
515
516
517
518
519
520
521
522



523
524
525
526
527
528
529
530
531
532
533
534






535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558

559
560

561
562
563
564
565
566
567
568
569
570
571
572
573

574
575




576
577
578
579
580
581
582
583
584

585
586
587
588
589
590

591
592
593
594
595

596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623


624
625
626
627
628
629
630
631
632
633

634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675



676



677











678






679








680


681





682







683



















684












685
686

687


688
689
690


691
692










693



694


695


696
697


698


699
700


701
702


703
704



705
706

707

708


709
710





711






























712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744

745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807

808
809
810
811
812
813
814
815
816
817
818
819
820

821
822
823
824

825
826
827
828
829





830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868

869
870
871
872
873


874



875
876
877
878
879
880
881
882
883
884

885
886
887
888
889
890
891
892
893
894
895
896

897
898
899
900
901
902
903
904

905
906


907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949

950

951
952
953
954
955
956
957
958
959
960
961
962
963
964

965
966
967
968

969

970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989

990
/* 
 * tkConfig.c --
 *
 *	This file contains the Tk_ConfigureWidget procedure.

 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *


 * SCCS: @(#) tkConfig.c 1.53 96/04/26 10:29:31


 */












#include "tkPort.h"
#include "tk.h"

/*



 * Values for "flags" field of Tk_ConfigSpec structures.  Be sure

 * to coordinate these values with those defined in tk.h














 * (TK_CONFIG_COLOR_ONLY, etc.).  There must not be overlap!


















 *







 * INIT -		Non-zero means (char *) things have been

 *			converted to Tk_Uid's.



 */

#define INIT		0x20






















/*
 * Forward declarations for procedures defined later in this file:
 */

static int		DoConfig _ANSI_ARGS_((Tcl_Interp *interp,































































































































			    Tk_Window tkwin, Tk_ConfigSpec *specPtr,






			    Tk_Uid value, int valueIsUid, char *widgRec));











































static Tk_ConfigSpec *	FindConfigSpec _ANSI_ARGS_((Tcl_Interp *interp,





			    Tk_ConfigSpec *specs, char *argvName,













































































			    int needFlags, int hateFlags));









static char *		FormatConfigInfo _ANSI_ARGS_((Tcl_Interp *interp,




			    Tk_Window tkwin, Tk_ConfigSpec *specPtr,





























































			    char *widgRec));




static char *		FormatConfigValue _ANSI_ARGS_((Tcl_Interp *interp,








































			    Tk_Window tkwin, Tk_ConfigSpec *specPtr,



			    char *widgRec, char *buffer,








			    Tcl_FreeProc **freeProcPtr));




































































































































































































































































































































































































































































































/*
 *--------------------------------------------------------------


 *






 * Tk_ConfigureWidget --











 *
 *	Process command-line options and database options to













 *	fill in fields of a widget record with resources and





 *	other parameters.








 *
 * Results:








 *	A standard Tcl return value.  In case of an error,



















 *	interp->result will hold an error message.

 *
 * Side effects:




 *	The fields of widgRec get filled in with information










 *	from argc/argv and the option database.  Old information





















 *	in widgRec's fields gets recycled.

 *
 *--------------------------------------------------------------
 */

int
Tk_ConfigureWidget(interp, tkwin, specs, argc, argv, widgRec, flags)

    Tcl_Interp *interp;		/* Interpreter for error reporting. */
    Tk_Window tkwin;		/* Window containing widget (needed to

				 * set up X resources). */

    Tk_ConfigSpec *specs;	/* Describes legal options. */
    int argc;			/* Number of elements in argv. */




    char **argv;		/* Command-line options. */
    char *widgRec;		/* Record whose fields are to be
				 * modified.  Values must be properly

				 * initialized. */
    int flags;			/* Used to specify additional flags


				 * that must be present in config specs

				 * for them to be considered.  Also,
				 * may have TK_CONFIG_ARGV_ONLY set. */
{

    register Tk_ConfigSpec *specPtr;
    Tk_Uid value;		/* Value of option from database. */
    int needFlags;		/* Specs must contain this set of flags
				 * or else they are not considered. */
    int hateFlags;		/* If a spec contains any bits here, it's
				 * not considered. */







    needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);




    if (Tk_Depth(tkwin) <= 1) {
	hateFlags = TK_CONFIG_COLOR_ONLY;



    } else {




	hateFlags = TK_CONFIG_MONO_ONLY;






    }



    /*
     * Pass one:  scan through all the option specs, replacing strings
     * with Tk_Uids (if this hasn't been done already) and clearing
     * the TK_CONFIG_OPTION_SPECIFIED flags.


     */




    for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
	if (!(specPtr->specFlags & INIT) && (specPtr->argvName != NULL)) {
	    if (specPtr->dbName != NULL) {
		specPtr->dbName = Tk_GetUid(specPtr->dbName);

	    }

	    if (specPtr->dbClass != NULL) {


		specPtr->dbClass = Tk_GetUid(specPtr->dbClass);




	    }
	    if (specPtr->defValue != NULL) {


		specPtr->defValue = Tk_GetUid(specPtr->defValue);
	    }


	}

	specPtr->specFlags = (specPtr->specFlags & ~TK_CONFIG_OPTION_SPECIFIED)
		| INIT;



    }



    /*





     * Pass two:  scan through all of the arguments, processing those
     * that match entries in the specs.


     */

    for ( ; argc > 0; argc -= 2, argv += 2) {
	specPtr = FindConfigSpec(interp, specs, *argv, needFlags, hateFlags);


	if (specPtr == NULL) {
	    return TCL_ERROR;



	}





	/*
	 * Process the entry.



	 */


	if (argc < 2) {
	    Tcl_AppendResult(interp, "value for \"", *argv,
		    "\" missing", (char *) NULL);
	    return TCL_ERROR;
	}
	if (DoConfig(interp, tkwin, specPtr, argv[1], 0, widgRec) != TCL_OK) {
	    char msg[100];



	    sprintf(msg, "\n    (processing \"%.40s\" option)",
		    specPtr->argvName);
	    Tcl_AddErrorInfo(interp, msg);
	    return TCL_ERROR;

	}



	specPtr->specFlags |= TK_CONFIG_OPTION_SPECIFIED;
    }




    /*
     * Pass three:  scan through all of the specs again;  if no
     * command-line argument matched a spec, then check for info
     * in the option database.  If there was nothing in the
     * database, then use the default.
     */














    if (!(flags & TK_CONFIG_ARGV_ONLY)) {


	for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {



	    if ((specPtr->specFlags & TK_CONFIG_OPTION_SPECIFIED)
		    || (specPtr->argvName == NULL)
		    || (specPtr->type == TK_CONFIG_SYNONYM)) {
		continue;
	    }
	    if (((specPtr->specFlags & needFlags) != needFlags)
		    || (specPtr->specFlags & hateFlags)) {



		continue;
	    }
	    value = NULL;

	    if (specPtr->dbName != NULL) {
		value = Tk_GetOption(tkwin, specPtr->dbName, specPtr->dbClass);

	    }
	    if (value != NULL) {

		if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=



			TCL_OK) {
		    char msg[200];


    
		    sprintf(msg, "\n    (%s \"%.50s\" in widget \"%.50s\")",
			    "database entry for",

			    specPtr->dbName, Tk_PathName(tkwin));



		    Tcl_AddErrorInfo(interp, msg);

		    return TCL_ERROR;
		}
	    } else {
		value = specPtr->defValue;
		if ((value != NULL) && !(specPtr->specFlags


			& TK_CONFIG_DONT_SET_DEFAULT)) {
		    if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=









			    TCL_OK) {

			char msg[200];







	

			sprintf(msg,
				"\n    (%s \"%.50s\" in widget \"%.50s\")",
				"default value for",
				specPtr->dbName, Tk_PathName(tkwin));



			Tcl_AddErrorInfo(interp, msg);

			return TCL_ERROR;
		    }




		}




	    }


	}
    }

    return TCL_OK;


}

/*
 *--------------------------------------------------------------
 *
 * FindConfigSpec --
 *
 *	Search through a table of configuration specs, looking for
 *	one that matches a given argvName.
 *
 * Results:
 *	The return value is a pointer to the matching entry, or NULL
 *	if nothing matched.  In that case an error message is left
 *	in interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static Tk_ConfigSpec *
FindConfigSpec(interp, specs, argvName, needFlags, hateFlags)
    Tcl_Interp *interp;		/* Used for reporting errors. */
    Tk_ConfigSpec *specs;	/* Pointer to table of configuration
				 * specifications for a widget. */
    char *argvName;		/* Name (suitable for use in a "config"
				 * command) identifying particular option. */
    int needFlags;		/* Flags that must be present in matching
				 * entry. */
    int hateFlags;		/* Flags that must NOT be present in
				 * matching entry. */
{
    register Tk_ConfigSpec *specPtr;
    register char c;		/* First character of current argument. */
    Tk_ConfigSpec *matchPtr;	/* Matching spec, or NULL. */
    size_t length;

    c = argvName[1];
    length = strlen(argvName);
    matchPtr = NULL;
    for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
	if (specPtr->argvName == NULL) {
	    continue;
	}
	if ((specPtr->argvName[1] != c)
		|| (strncmp(specPtr->argvName, argvName, length) != 0)) {
	    continue;
	}
	if (((specPtr->specFlags & needFlags) != needFlags)
		|| (specPtr->specFlags & hateFlags)) {
	    continue;
	}
	if (specPtr->argvName[length] == 0) {
	    matchPtr = specPtr;
	    goto gotMatch;
	}
	if (matchPtr != NULL) {
	    Tcl_AppendResult(interp, "ambiguous option \"", argvName,
		    "\"", (char *) NULL);
	    return (Tk_ConfigSpec *) NULL;
	}
	matchPtr = specPtr;
    }

    if (matchPtr == NULL) {
	Tcl_AppendResult(interp, "unknown option \"", argvName,
		"\"", (char *) NULL);
	return (Tk_ConfigSpec *) NULL;
    }

    /*
     * Found a matching entry.  If it's a synonym, then find the
     * entry that it's a synonym for.
     */

    gotMatch:
    specPtr = matchPtr;
    if (specPtr->type == TK_CONFIG_SYNONYM) {
	for (specPtr = specs; ; specPtr++) {
	    if (specPtr->type == TK_CONFIG_END) {
		Tcl_AppendResult(interp,
			"couldn't find synonym for option \"",
			argvName, "\"", (char *) NULL);
		return (Tk_ConfigSpec *) NULL;
	    }
	    if ((specPtr->dbName == matchPtr->dbName) 
		    && (specPtr->type != TK_CONFIG_SYNONYM)
		    && ((specPtr->specFlags & needFlags) == needFlags)
		    && !(specPtr->specFlags & hateFlags)) {
		break;
	    }
	}
    }
    return specPtr;
}

/*
 *--------------------------------------------------------------
 *
 * DoConfig --
 *
 *	This procedure applies a single configuration option
 *	to a widget record.
 *
 * Results:
 *	A standard Tcl return value.
 *
 * Side effects:
 *	WidgRec is modified as indicated by specPtr and value.
 *	The old value is recycled, if that is appropriate for
 *	the value type.
 *
 *--------------------------------------------------------------
 */

static int
DoConfig(interp, tkwin, specPtr, value, valueIsUid, widgRec)
    Tcl_Interp *interp;		/* Interpreter for error reporting. */
    Tk_Window tkwin;		/* Window containing widget (needed to
				 * set up X resources). */

    Tk_ConfigSpec *specPtr;	/* Specifier to apply. */
    char *value;		/* Value to use to fill in widgRec. */
    int valueIsUid;		/* Non-zero means value is a Tk_Uid;
				 * zero means it's an ordinary string. */
    char *widgRec;		/* Record whose fields are to be
				 * modified.  Values must be properly
				 * initialized. */
{


    char *ptr;

    Tk_Uid uid;


    int nullValue;






    nullValue = 0;
    if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) {



	nullValue = 1;
    }



    do {
	ptr = widgRec + specPtr->offset;
	switch (specPtr->type) {
	    case TK_CONFIG_BOOLEAN:
		if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_INT:
		if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_DOUBLE:
		if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_STRING: {
		char *old, *new;



		if (nullValue) {
		    new = NULL;

		} else {
		    new = (char *) ckalloc((unsigned) (strlen(value) + 1));
		    strcpy(new, value);
		}





		old = *((char **) ptr);
		if (old != NULL) {
		    ckfree(old);
		}
		*((char **) ptr) = new;
		break;
	    }
	    case TK_CONFIG_UID:
		if (nullValue) {
		    *((Tk_Uid *) ptr) = NULL;
		} else {


		    uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		    *((Tk_Uid *) ptr) = uid;
		}


		break;
	    case TK_CONFIG_COLOR: {
		XColor *newPtr, *oldPtr;

		if (nullValue) {

		    newPtr = NULL;
		} else {
		    uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);

		    newPtr = Tk_GetColor(interp, tkwin, uid);
		    if (newPtr == NULL) {
			return TCL_ERROR;
		    }
		}

		oldPtr = *((XColor **) ptr);


		if (oldPtr != NULL) {
		    Tk_FreeColor(oldPtr);

		}



		*((XColor **) ptr) = newPtr;
		break;

	    }
	    case TK_CONFIG_FONT: {
		Tk_Font new;

		if (nullValue) {
		    new = NULL;

		} else {
		    new = Tk_GetFont(interp, tkwin, value);
		    if (new == NULL) {
			return TCL_ERROR;
		    }


		}
		Tk_FreeFont(*((Tk_Font *) ptr));
		*((Tk_Font *) ptr) = new;
		break;
	    }
	    case TK_CONFIG_BITMAP: {
		Pixmap new, old;

		if (nullValue) {
		    new = None;
	        } else {
		    uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		    new = Tk_GetBitmap(interp, tkwin, uid);
		    if (new == None) {
			return TCL_ERROR;
		    }
		}
		old = *((Pixmap *) ptr);
		if (old != None) {
		    Tk_FreeBitmap(Tk_Display(tkwin), old);
		}
		*((Pixmap *) ptr) = new;



		break;
	    }


	    case TK_CONFIG_BORDER: {
		Tk_3DBorder new, old;

		if (nullValue) {
		    new = NULL;

		} else {
		    uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		    new = Tk_Get3DBorder(interp, tkwin, uid);
		    if (new == NULL) {
			return TCL_ERROR;
		    }
		}
		old = *((Tk_3DBorder *) ptr);
		if (old != NULL) {
		    Tk_Free3DBorder(old);
		}
		*((Tk_3DBorder *) ptr) = new;
		break;
	    }
	    case TK_CONFIG_RELIEF:
		uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		if (Tk_GetRelief(interp, uid, (int *) ptr) != TCL_OK) {
		    return TCL_ERROR;



		}
		break;



	    case TK_CONFIG_CURSOR:
	    case TK_CONFIG_ACTIVE_CURSOR: {


		Tk_Cursor new, old;



		if (nullValue) {
		    new = None;
		} else {
		    uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		    new = Tk_GetCursor(interp, tkwin, uid);
		    if (new == None) {
			return TCL_ERROR;
		    }
		}

		old = *((Tk_Cursor *) ptr);
		if (old != None) {
		    Tk_FreeCursor(Tk_Display(tkwin), old);

		}
		*((Tk_Cursor *) ptr) = new;

		if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) {
		    Tk_DefineCursor(tkwin, new);
		}



		break;

	    }
	    case TK_CONFIG_JUSTIFY:
		uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		if (Tk_GetJustify(interp, uid, (Tk_Justify *) ptr) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_ANCHOR:
		uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		if (Tk_GetAnchor(interp, uid, (Tk_Anchor *) ptr) != TCL_OK) {

		    return TCL_ERROR;

		}
		break;
	    case TK_CONFIG_CAP_STYLE:
		uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		if (Tk_GetCapStyle(interp, uid, (int *) ptr) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_JOIN_STYLE:


		uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		if (Tk_GetJoinStyle(interp, uid, (int *) ptr) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_PIXELS:
		if (Tk_GetPixels(interp, tkwin, value, (int *) ptr)
			!= TCL_OK) {
		    return TCL_ERROR;

		}
		break;
	    case TK_CONFIG_MM:
		if (Tk_GetScreenMM(interp, tkwin, value, (double *) ptr)
			!= TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_WINDOW: {



		Tk_Window tkwin2;

		if (nullValue) {
		    tkwin2 = NULL;
		} else {
		    tkwin2 = Tk_NameToWindow(interp, value, tkwin);
		    if (tkwin2 == NULL) {
			return TCL_ERROR;
		    }
		}
		*((Tk_Window *) ptr) = tkwin2;
		break;






	    }
	    case TK_CONFIG_CUSTOM:
		if ((*specPtr->customPtr->parseProc)(
			specPtr->customPtr->clientData, interp, tkwin,
			value, widgRec, specPtr->offset) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    default: {
		sprintf(interp->result, "bad config table: unknown type %d",
			specPtr->type);
		return TCL_ERROR;
	    }
	}
	specPtr++;
    } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END));
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_ConfigureInfo --
 *

 *	Return information about the configuration options
 *	for a window, and their current values.

 *
 * Results:
 *	Always returns TCL_OK.  Interp->result will be modified
 *	hold a description of either a single configuration option
 *	available for "widgRec" via "specs", or all the configuration
 *	options available.  In the "all" case, the result will
 *	available for "widgRec" via "specs".  The result will
 *	be a list, each of whose entries describes one option.
 *	Each entry will itself be a list containing the option's
 *	name for use on command lines, database name, database
 *	class, default value, and current value (empty string
 *	if none).  For options that are synonyms, the list will
 *	contain only two values:  name and synonym name.  If the

 *	"name" argument is non-NULL, then the only information
 *	returned is that for the named argument (i.e. the corresponding




 *	entry in the overall list is returned).
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

int

Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags)
    Tcl_Interp *interp;		/* Interpreter for error reporting. */
    Tk_Window tkwin;		/* Window corresponding to widgRec. */
    Tk_ConfigSpec *specs;	/* Describes legal options. */
    char *widgRec;		/* Record whose fields contain current
				 * values for options. */

    char *argvName;		/* If non-NULL, indicates a single option
				 * whose info is to be returned.  Otherwise
				 * info is returned for all options. */
    int flags;			/* Used to specify additional flags
				 * that must be present in config specs

				 * for them to be considered. */
{
    register Tk_ConfigSpec *specPtr;
    int needFlags, hateFlags;
    char *list;
    char *leader = "{";

    needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
    if (Tk_Depth(tkwin) <= 1) {
	hateFlags = TK_CONFIG_COLOR_ONLY;
    } else {
	hateFlags = TK_CONFIG_MONO_ONLY;
    }

    /*
     * If information is only wanted for a single configuration
     * spec, then handle that one spec specially.
     */

    Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
    if (argvName != NULL) {
	specPtr = FindConfigSpec(interp, specs, argvName, needFlags,
		hateFlags);
	if (specPtr == NULL) {
	    return TCL_ERROR;
	}
	interp->result = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
	interp->freeProc = TCL_DYNAMIC;


	return TCL_OK;
    }

    /*
     * Loop through all the specs, creating a big list with all
     * their information.
     */

    for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
	if ((argvName != NULL) && (specPtr->argvName != argvName)) {

	    continue;
	}
	if (((specPtr->specFlags & needFlags) != needFlags)
		|| (specPtr->specFlags & hateFlags)) {
	    continue;
	}
	if (specPtr->argvName == NULL) {
	    continue;
	}
	list = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
	Tcl_AppendResult(interp, leader, list, "}", (char *) NULL);
	ckfree(list);
	leader = " {";
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * FormatConfigInfo --
 *
 *	Create a valid Tcl list holding the configuration information
 *	for a single configuration option.
 *
 * Results:
 *	A Tcl list, dynamically allocated.  The caller is expected to
 *	arrange for this list to be freed eventually.
 *
 * Side effects:
 *	Memory is allocated.
 *
 *--------------------------------------------------------------
 */

static char *
FormatConfigInfo(interp, tkwin, specPtr, widgRec)
    Tcl_Interp *interp;			/* Interpreter to use for things
					 * like floating-point precision. */
    Tk_Window tkwin;			/* Window corresponding to widget. */
    register Tk_ConfigSpec *specPtr;	/* Pointer to information describing
					 * option. */



    char *widgRec;			/* Pointer to record holding current



					 * values of info for widget. */











{






    char *argv[6], *result;








    char buffer[200];


    Tcl_FreeProc *freeProc = (Tcl_FreeProc *) NULL;













    argv[0] = specPtr->argvName;



















    argv[1] = specPtr->dbName;












    argv[2] = specPtr->dbClass;
    argv[3] = specPtr->defValue;

    if (specPtr->type == TK_CONFIG_SYNONYM) {


	return Tcl_Merge(2, argv);
    }
    argv[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer,


	    &freeProc);
    if (argv[1] == NULL) {










	argv[1] = "";



    }


    if (argv[2] == NULL) {


	argv[2] = "";
    }


    if (argv[3] == NULL) {


	argv[3] = "";
    }


    if (argv[4] == NULL) {
	argv[4] = "";


    }
    result = Tcl_Merge(5, argv);



    if (freeProc != NULL) {
	if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) {

	    ckfree(argv[4]);

	} else {


	    (*freeProc)(argv[4]);
	}





    }






























    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * FormatConfigValue --
 *
 *	This procedure formats the current value of a configuration
 *	option.
 *
 * Results:
 *	The return value is the formatted value of the option given
 *	by specPtr and widgRec.  If the value is static, so that it
 *	need not be freed, *freeProcPtr will be set to NULL;  otherwise
 *	*freeProcPtr will be set to the address of a procedure to
 *	free the result, and the caller must invoke this procedure
 *	when it is finished with the result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, freeProcPtr)
    Tcl_Interp *interp;		/* Interpreter for use in real conversions. */
    Tk_Window tkwin;		/* Window corresponding to widget. */
    Tk_ConfigSpec *specPtr;	/* Pointer to information describing option.
				 * Must not point to a synonym option. */
    char *widgRec;		/* Pointer to record holding current
				 * values of info for widget. */

    char *buffer;		/* Static buffer to use for small values.
				 * Must have at least 200 bytes of storage. */
    Tcl_FreeProc **freeProcPtr;	/* Pointer to word to fill in with address
				 * of procedure to free the result, or NULL
				 * if result is static. */
{
    char *ptr, *result;

    *freeProcPtr = NULL;
    ptr = widgRec + specPtr->offset;
    result = "";
    switch (specPtr->type) {
	case TK_CONFIG_BOOLEAN:
	    if (*((int *) ptr) == 0) {
		result = "0";
	    } else {
		result = "1";
	    }
	    break;
	case TK_CONFIG_INT:
	    sprintf(buffer, "%d", *((int *) ptr));
	    result = buffer;
	    break;
	case TK_CONFIG_DOUBLE:
	    Tcl_PrintDouble(interp, *((double *) ptr), buffer);
	    result = buffer;
	    break;
	case TK_CONFIG_STRING:
	    result = (*(char **) ptr);
	    if (result == NULL) {
		result = "";
	    }
	    break;
	case TK_CONFIG_UID: {
	    Tk_Uid uid = *((Tk_Uid *) ptr);
	    if (uid != NULL) {
		result = uid;
	    }
	    break;
	}
	case TK_CONFIG_COLOR: {
	    XColor *colorPtr = *((XColor **) ptr);
	    if (colorPtr != NULL) {
		result = Tk_NameOfColor(colorPtr);
	    }
	    break;
	}
	case TK_CONFIG_FONT: {
	    Tk_Font tkfont = *((Tk_Font *) ptr);
	    if (tkfont != NULL) {
		result = Tk_NameOfFont(tkfont);
	    }
	    break;
	}
	case TK_CONFIG_BITMAP: {
	    Pixmap pixmap = *((Pixmap *) ptr);
	    if (pixmap != None) {
		result = Tk_NameOfBitmap(Tk_Display(tkwin), pixmap);
	    }
	    break;
	}
	case TK_CONFIG_BORDER: {
	    Tk_3DBorder border = *((Tk_3DBorder *) ptr);

	    if (border != NULL) {
		result = Tk_NameOf3DBorder(border);
	    }
	    break;
	}
	case TK_CONFIG_RELIEF:
	    result = Tk_NameOfRelief(*((int *) ptr));
	    break;
	case TK_CONFIG_CURSOR:
	case TK_CONFIG_ACTIVE_CURSOR: {
	    Tk_Cursor cursor = *((Tk_Cursor *) ptr);
	    if (cursor != None) {
		result = Tk_NameOfCursor(Tk_Display(tkwin), cursor);

	    }
	    break;
	}
	case TK_CONFIG_JUSTIFY:

	    result = Tk_NameOfJustify(*((Tk_Justify *) ptr));
	    break;
	case TK_CONFIG_ANCHOR:
	    result = Tk_NameOfAnchor(*((Tk_Anchor *) ptr));
	    break;





	case TK_CONFIG_CAP_STYLE:
	    result = Tk_NameOfCapStyle(*((int *) ptr));
	    break;
	case TK_CONFIG_JOIN_STYLE:
	    result = Tk_NameOfJoinStyle(*((int *) ptr));
	    break;
	case TK_CONFIG_PIXELS:
	    sprintf(buffer, "%d", *((int *) ptr));
	    result = buffer;
	    break;
	case TK_CONFIG_MM:
	    Tcl_PrintDouble(interp, *((double *) ptr), buffer);
	    result = buffer;
	    break;
	case TK_CONFIG_WINDOW: {
	    Tk_Window tkwin;

	    tkwin = *((Tk_Window *) ptr);
	    if (tkwin != NULL) {
		result = Tk_PathName(tkwin);
	    }
	    break;
	}
	case TK_CONFIG_CUSTOM:
	    result = (*specPtr->customPtr->printProc)(
		    specPtr->customPtr->clientData, tkwin, widgRec,
		    specPtr->offset, freeProcPtr);
	    break;
	default: 
	    result = "?? unknown type ??";
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_ConfigureValue --
 *

 *	This procedure returns the current value of a configuration
 *	option for a widget.
 *
 * Results:
 *	The return value is a standard Tcl completion code (TCL_OK or


 *	TCL_ERROR).  Interp->result will be set to hold either the value



 *	of the option given by argvName (if TCL_OK is returned) or
 *	an error message (if TCL_ERROR is returned).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int

Tk_ConfigureValue(interp, tkwin, specs, widgRec, argvName, flags)
    Tcl_Interp *interp;		/* Interpreter for error reporting. */
    Tk_Window tkwin;		/* Window corresponding to widgRec. */
    Tk_ConfigSpec *specs;	/* Describes legal options. */
    char *widgRec;		/* Record whose fields contain current
				 * values for options. */
    char *argvName;		/* Gives the command-line name for the
				 * option whose value is to be returned. */
    int flags;			/* Used to specify additional flags
				 * that must be present in config specs
				 * for them to be considered. */
{

    Tk_ConfigSpec *specPtr;
    int needFlags, hateFlags;

    needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
    if (Tk_Depth(tkwin) <= 1) {
	hateFlags = TK_CONFIG_COLOR_ONLY;
    } else {
	hateFlags = TK_CONFIG_MONO_ONLY;

    }
    specPtr = FindConfigSpec(interp, specs, argvName, needFlags, hateFlags);


    if (specPtr == NULL) {
	return TCL_ERROR;
    }
    interp->result = FormatConfigValue(interp, tkwin, specPtr, widgRec,
	    interp->result, &interp->freeProc);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_FreeOptions --
 *
 *	Free up all resources associated with configuration options.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Any resource in widgRec that is controlled by a configuration
 *	option (e.g. a Tk_3DBorder or XColor) is freed in the appropriate
 *	fashion.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
void
Tk_FreeOptions(specs, widgRec, display, needFlags)
    Tk_ConfigSpec *specs;	/* Describes legal options. */
    char *widgRec;		/* Record whose fields contain current
				 * values for options. */
    Display *display;		/* X display; needed for freeing some
				 * resources. */
    int needFlags;		/* Used to specify additional flags
				 * that must be present in config specs
				 * for them to be considered. */
{
    register Tk_ConfigSpec *specPtr;
    char *ptr;

    for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
	if ((specPtr->specFlags & needFlags) != needFlags) {

	    continue;

	}
	ptr = widgRec + specPtr->offset;
	switch (specPtr->type) {
	    case TK_CONFIG_STRING:
		if (*((char **) ptr) != NULL) {
		    ckfree(*((char **) ptr));
		    *((char **) ptr) = NULL;
		}
		break;
	    case TK_CONFIG_COLOR:
		if (*((XColor **) ptr) != NULL) {
		    Tk_FreeColor(*((XColor **) ptr));
		    *((XColor **) ptr) = NULL;
		}

		break;
	    case TK_CONFIG_FONT:
		Tk_FreeFont(*((Tk_Font *) ptr));
		*((Tk_Font *) ptr) = NULL;

		break;

	    case TK_CONFIG_BITMAP:
		if (*((Pixmap *) ptr) != None) {
		    Tk_FreeBitmap(display, *((Pixmap *) ptr));
		    *((Pixmap *) ptr) = None;
		}
		break;
	    case TK_CONFIG_BORDER:
		if (*((Tk_3DBorder *) ptr) != NULL) {
		    Tk_Free3DBorder(*((Tk_3DBorder *) ptr));
		    *((Tk_3DBorder *) ptr) = NULL;
		}
		break;
	    case TK_CONFIG_CURSOR:
	    case TK_CONFIG_ACTIVE_CURSOR:
		if (*((Tk_Cursor *) ptr) != None) {
		    Tk_FreeCursor(display, *((Tk_Cursor *) ptr));
		    *((Tk_Cursor *) ptr) = None;
		}
	}
    }

}



|
>

<
|




>
>
|
>
>


>
>
>
>
>
>
>
>
>
>
>

|


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


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





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


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





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

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

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

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

>
>
>

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

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

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





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

|


|
<
<




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

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

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

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

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

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





|

>
|
<
>


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







<
>
|
|
|
<
|

>
|
|
|
|
|
>
|

|
<
<
|
|
<
|
<
<
<
<






<
|
|
<
|
|

|
<
>
>
|







|
|
>
|
<
|
|
<

<
<
|
<
<
<
<
<
|





|














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

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





|

|



|
|
<
<
|
|







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

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

|





|

>
|
|


<
>
>
|
>
>
>
|
|







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

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

1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000

1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132

1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159


1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193



1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226

1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245


1246
1247
1248

1249
1250
1251
1252
1253
1254
1255
1256
1257

1258
1259
1260
1261
1262
1263
1264
1265



1266


1267
1268
1269
1270



1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283

1284

1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321

1322
1323

1324
1325
1326
1327
1328
1329
1330
1331
1332
1333

1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372


1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395

1396
1397
1398
1399
1400
1401
1402















1403
















1404


























1405





1406




1407





























1408
1409
1410
1411
1412


1413
1414
1415
1416
1417




1418
1419





1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440

1441
1442
1443
1444







1445












1446
1447
1448
1449
1450
1451
1452



1453
1454
1455
1456
1457



1458
1459




1460

1461
1462
1463


1464
1465
1466


1467

1468
1469
1470

1471
1472
1473

1474

1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489


1490


1491
1492

1493

1494
1495
1496
1497

1498
1499
1500


1501







1502
1503



1504

1505
1506
1507
1508

1509
1510
1511

1512
1513
1514
1515
1516
1517







1518








1519
1520
1521
1522
1523
1524
1525
1526
1527

1528
1529
1530
1531
1532
1533




1534


1535

1536
1537
1538
1539
1540
1541

1542
1543


1544
1545
1546
1547
1548
1549




1550
1551
1552

1553
1554
1555
1556
1557

1558
1559


1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575

1576
1577


1578
1579
1580
1581
1582
1583
1584
1585


1586

1587

1588


1589
1590
1591
1592
1593
1594
1595
1596
1597

1598


1599
1600
1601


1602
1603




1604
1605
1606
1607
1608
1609
1610
1611
1612

1613
1614
1615
1616



1617


1618
1619

1620
1621
1622

1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634

1635
1636
1637
1638

1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650


1651
1652

1653




1654
1655
1656
1657
1658
1659

1660
1661

1662
1663
1664
1665

1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679

1680
1681

1682


1683





1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708

1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803

1804
1805
1806

1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838

1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905


1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918

1919
1920
1921
1922
1923
1924


1925
1926

1927
1928

1929















































1930




1931
1932


1933
1934






1935

1936
1937



1938
1939


1940

1941
1942
1943
1944
1945
















1946


1947
1948

1949






1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964

1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979

1980
1981
1982



1983
1984
1985

1986

1987
1988
1989

1990



1991

1992
1993
1994
1995
1996
1997




1998
1999






























2000


2001


2002
2003
2004
2005
2006










2007

2008
2009


2010
2011
2012
2013
2014
2015
2016
2017




2018

2019
2020





2021
2022

2023
2024
/* 
 * tkConfig.c --
 *
 *	This file contains procedures that manage configuration options
 *	for widgets and other things.
 *

 * Copyright (c) 1997-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkConfig.c,v 1.1.4.3 1999/03/10 07:13:38 stanton Exp $
 */

/*
 * Temporary flag for working on new config package.
 */

#if 0

/*
 * used only for removing the old config code
 */

#define __NO_OLD_CONFIG
#endif

#include "tk.h"
#include "tkInt.h"
#include "tkPort.h"
#include "tkFont.h"

/*
 * The following definition is an AssocData key used to keep track of
 * all of the option tables that have been created for an interpreter.
 */

#define OPTION_HASH_KEY "TkOptionTable"

/*
 * The following two structures are used along with Tk_OptionSpec
 * structures to manage configuration options.  Tk_OptionSpecs are
 * static templates that are compiled into the code of a widget
 * or other object manager.  However, to look up options efficiently
 * we need to supplement the static information with additional
 * dynamic information, and this dynamic information may be different
 * for each application.  Thus we create structures of the following
 * two types to hold all of the dynamic information; this is done
 * by Tk_CreateOptionTable.
 * 
 * One of the following structures corresponds to each Tk_OptionSpec.
 * These structures exist as arrays inside TkOptionTable structures.
 */

typedef struct TkOption {
    CONST Tk_OptionSpec *specPtr;	/* The original spec from the template
					 * passed to Tk_CreateOptionTable.*/
    Tk_Uid dbNameUID;		 	/* The Uid form of the option database 
					 * name. */
    Tk_Uid dbClassUID;			/* The Uid form of the option database
					 * class name. */
    Tcl_Obj *defaultPtr;		/* Default value for this option. */
    union {
	Tcl_Obj *monoColorPtr;		/* For color and border options, this
					 * is an alternate default value to
					 * use on monochrome displays. */
	struct TkOption *synonymPtr;	/* For synonym options, this points to
					 * the master entry. */
    } extra;
    int flags;				/* Miscellaneous flag values; see
					 * below for definitions. */
} Option;

/*
 * Flag bits defined for Option structures:
 *
 * OPTION_NEEDS_FREEING -	1 means that FreeResources must be
 *				invoke to free resources associated with
 *				the option when it is no longer needed.
 */

#define OPTION_NEEDS_FREEING		1

/*
 * One of the following exists for each Tk_OptionSpec array that has
 * been passed to Tk_CreateOptionTable.
 */

typedef struct OptionTable {
    int refCount;			/* Counts the number of uses of this
					 * table (the number of times
					 * Tk_CreateOptionTable has returned
					 * it).  This can be greater than 1 if
					 * it is shared along several option
					 * table  chains, or if the same table
					 * is used for multiple purposes. */
    Tcl_HashEntry *hashEntryPtr;	/* Hash table entry that refers to this
					 * table; used to delete the entry. */
    struct OptionTable *nextPtr;	/* If templatePtr was part of a chain
					 * of templates, this points to the
					 * table corresponding to the next
					 * template in the chain. */
    int numOptions;			/* The number of items in the options
					 * array below. */
    Option options[1];			/* Information about the individual
					 * options in the table.  This must be
					 * the last field in the structure:
					 * the actual size of the array will
					 * be numOptions, not 1. */
} OptionTable;

/*
 * Forward declarations for procedures defined later in this file:
 */

static int		DoObjConfig _ANSI_ARGS_((Tcl_Interp *interp,
			    char *recordPtr, Option *optionPtr,
			    Tcl_Obj *valuePtr, Tk_Window tkwin, 
			    Tk_SavedOption *savePtr));
static void		DestroyOptionHashTable _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp));
static void		FreeResources _ANSI_ARGS_((Option *optionPtr, 
			    Tcl_Obj *objPtr, char *internalPtr,
			    Tk_Window tkwin));
static Tcl_Obj *	GetConfigList _ANSI_ARGS_((char *recordPtr,
			    Option *optionPtr, Tk_Window tkwin));
static Tcl_Obj *	GetObjectForOption _ANSI_ARGS_((char *recordPtr,
			    Option *optionPtr, Tk_Window tkwin));
static Option *		GetOptionFromObj _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr, OptionTable *tablePtr));
static int		ObjectIsEmpty _ANSI_ARGS_((Tcl_Obj *objPtr));
static int		SetOptionFromAny _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr));

/*
 * The structure below defines an object type that is used to cache the
 * result of looking up an option name.  If an object has this type, then
 * its internalPtr1 field points to the OptionTable in which it was looked up,
 * and the internalPtr2 field points to the entry that matched.
 */

Tcl_ObjType optionType = {
    "option",				/* name */
    (Tcl_FreeInternalRepProc *) NULL,	/* freeIntRepProc */
    (Tcl_DupInternalRepProc *) NULL,	/* dupIntRepProc */
    (Tcl_UpdateStringProc *) NULL,	/* updateStringProc */
    SetOptionFromAny			/* setFromAnyProc */
};

/*
 *--------------------------------------------------------------
 *
 * Tk_CreateOptionTable --
 *
 *	Given a template for configuration options, this procedure
 *	creates a table that may be used to look up options efficiently.
 *
 * Results:
 *	Returns a token to a structure that can be passed to procedures
 *	such as Tk_InitOptions, Tk_SetOptions, and Tk_FreeConfigOptions.
 *
 * Side effects:
 *	Storage is allocated.
 *
 *--------------------------------------------------------------
 */

Tk_OptionTable
Tk_CreateOptionTable(interp, templatePtr)
    Tcl_Interp *interp;			/* Interpreter associated with the
					 * application in which this table
					 * will be used. */
    CONST Tk_OptionSpec *templatePtr;	/* Static information about the
					 * configuration options. */
{
    Tcl_HashTable *hashTablePtr;
    Tcl_HashEntry *hashEntryPtr;
    int newEntry;
    OptionTable *tablePtr;
    CONST Tk_OptionSpec *specPtr, *specPtr2;
    Option *optionPtr;
    int numOptions, i;

    /*
     * We use an AssocData value in the interpreter to keep a hash
     * table of all the option tables we've created for this application.
     * This is used for two purposes.  First, it allows us to share the
     * tables (e.g. in several chains) and second, we use the deletion
     * callback for the AssocData to delete all the option tables when
     * the interpreter is deleted.  The code below finds the hash table
     * or creates a new one if it doesn't already exist.
     */

    hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY,
	    NULL);
    if (hashTablePtr == NULL) {
	hashTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hashTablePtr, TCL_ONE_WORD_KEYS);
	Tcl_SetAssocData(interp, OPTION_HASH_KEY, DestroyOptionHashTable,
		(ClientData) hashTablePtr);
    }

    /*
     * See if a table has already been created for this template.  If
     * so, just reuse the existing table.
     */

    hashEntryPtr = Tcl_CreateHashEntry(hashTablePtr, (char *) templatePtr,
	    &newEntry);
    if (!newEntry) {
	tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr);
	tablePtr->refCount++;
	return (Tk_OptionTable) tablePtr;
    }

    /*
     * Count the number of options in the template, then create the
     * table structure.
     */

    numOptions = 0;
    for (specPtr = templatePtr; specPtr->type != TK_OPTION_END; specPtr++) {
	numOptions++;
    }
    tablePtr = (OptionTable *) (ckalloc(sizeof(OptionTable)
	    + ((numOptions - 1)  * sizeof(Option))));
    tablePtr->refCount = 1;
    tablePtr->hashEntryPtr = hashEntryPtr;
    tablePtr->nextPtr = NULL;
    tablePtr->numOptions = numOptions;

    /*
     * Initialize all of the Option structures in the table.
     */

    for (specPtr = templatePtr, optionPtr = tablePtr->options;
	    specPtr->type != TK_OPTION_END; specPtr++, optionPtr++) {
	optionPtr->specPtr = specPtr;
	optionPtr->dbNameUID = NULL;
	optionPtr->dbClassUID = NULL;
	optionPtr->defaultPtr = NULL;
	optionPtr->extra.monoColorPtr = NULL;
	optionPtr->flags = 0;

	if (specPtr->type == TK_OPTION_SYNONYM) {
	    /*
	     * This is a synonym option; find the master option that it
	     * refers to and create a pointer from the synonym to the
	     * master.
	     */

	    for (specPtr2 = templatePtr, i = 0; ; specPtr2++, i++) {
		if (specPtr2->type == TK_OPTION_END) {
		    panic("Tk_CreateOptionTable couldn't find synonym");
		}
		if (strcmp(specPtr2->optionName,
			(char *) specPtr->clientData) == 0) {
		    optionPtr->extra.synonymPtr = tablePtr->options + i;
		    break;
		}
	    }
	} else {
	    if (specPtr->dbName != NULL) {
		optionPtr->dbNameUID = Tk_GetUid(specPtr->dbName);
	    }
	    if (specPtr->dbClass != NULL) {
		optionPtr->dbClassUID = 
			Tk_GetUid(specPtr->dbClass);
	    }
	    if (specPtr->defValue != NULL) {
		optionPtr->defaultPtr =
			Tcl_NewStringObj(specPtr->defValue, -1);
		Tcl_IncrRefCount(optionPtr->defaultPtr);
	    }
	    if (((specPtr->type == TK_OPTION_COLOR)
		    || (specPtr->type == TK_OPTION_BORDER))
		    && (specPtr->clientData != NULL)) {
		optionPtr->extra.monoColorPtr =
			Tcl_NewStringObj((char *) specPtr->clientData, -1);
		Tcl_IncrRefCount(optionPtr->extra.monoColorPtr);
	    }
	}
	if (((specPtr->type == TK_OPTION_STRING)
		&& (specPtr->internalOffset >= 0))
		|| (specPtr->type == TK_OPTION_COLOR)
		|| (specPtr->type == TK_OPTION_FONT)
		|| (specPtr->type == TK_OPTION_BITMAP)
		|| (specPtr->type == TK_OPTION_BORDER)
		|| (specPtr->type == TK_OPTION_CURSOR)) {
	    optionPtr->flags |= OPTION_NEEDS_FREEING;
	}
    }
    tablePtr->hashEntryPtr = hashEntryPtr;
    Tcl_SetHashValue(hashEntryPtr, tablePtr);

    /*
     * Finally, check to see if this template chains to another template
     * with additional options.  If so, call ourselves recursively to
     * create the next table(s).
     */

    if (specPtr->clientData != NULL) {
	tablePtr->nextPtr = (OptionTable *) Tk_CreateOptionTable(interp,
		(Tk_OptionSpec *) specPtr->clientData);
    }

    return (Tk_OptionTable) tablePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_DeleteOptionTable --
 *
 *	Called to release resources used by an option table when 
 *	the table is no longer needed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The option table and associated resources (such as additional
 *	option tables chained off it) are destroyed.
 *
 *----------------------------------------------------------------------
 */

void
Tk_DeleteOptionTable(optionTable)
    Tk_OptionTable optionTable;		/* The option table to delete. */
{
    OptionTable *tablePtr = (OptionTable *) optionTable;
    Option *optionPtr;
    int count;

    tablePtr->refCount--;
    if (tablePtr->refCount > 0) {
	return;
    }

    if (tablePtr->nextPtr != NULL) {
	Tk_DeleteOptionTable((Tk_OptionTable) tablePtr->nextPtr);
    }

    for (count = tablePtr->numOptions - 1, optionPtr = tablePtr->options;
	    count > 0;  count--, optionPtr++) {
	if (optionPtr->defaultPtr != NULL) {
	    Tcl_DecrRefCount(optionPtr->defaultPtr);
	}
	if (((optionPtr->specPtr->type == TK_OPTION_COLOR)
		|| (optionPtr->specPtr->type == TK_OPTION_BORDER))
		&& (optionPtr->extra.monoColorPtr != NULL)) {
	    Tcl_DecrRefCount(optionPtr->extra.monoColorPtr);
	}
    }
    Tcl_DeleteHashEntry(tablePtr->hashEntryPtr);
    ckfree((char *) tablePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * DestroyOptionHashTable --
 *
 *	This procedure is the deletion callback associated with the
 *	AssocData entry created by Tk_CreateOptionTable.  It is
 *	invoked when an interpreter is deleted, and deletes all of
 *	the option tables associated with that interpreter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The option hash table is destroyed along with all of the
 *	OptionTable structures that it refers to.
 *
 *----------------------------------------------------------------------
 */

static void
DestroyOptionHashTable(clientData, interp)
    ClientData clientData;	/* The hash table we are destroying */
    Tcl_Interp *interp;		/* The interpreter we are destroying */
{
    Tcl_HashTable *hashTablePtr = (Tcl_HashTable *) clientData;
    Tcl_HashSearch search;
    Tcl_HashEntry *hashEntryPtr;
    OptionTable *tablePtr;

    for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search);
	    hashEntryPtr != NULL;
	    hashEntryPtr = Tcl_NextHashEntry(&search)) {
	tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr);

	/*
	 * The following statements do two tricky things:
	 * 1. They ensure that the option table is deleted, even if
	 *    there are outstanding references to it.
	 * 2. They ensure that Tk_DeleteOptionTable doesn't delete
	 *    other tables chained from this one; we'll do it when
	 *    we come across the hash table entry for the chained
	 *    table (in fact, the chained table may already have
	 *    been deleted).
	 */

	tablePtr->refCount = 1;
	tablePtr->nextPtr = NULL;
	Tk_DeleteOptionTable((Tk_OptionTable) tablePtr);
    }
    Tcl_DeleteHashTable(hashTablePtr);
    ckfree((char *) hashTablePtr);
}

/*
 *--------------------------------------------------------------
 *
 * Tk_InitOptions --
 *
 *	This procedure is invoked when an object such as a widget
 *	is created.  It supplies an initial value for each configuration
 *	option (the value may come from the option database, a system
 *	default, or the default in the option table).
 *
 * Results:
 *	The return value is TCL_OK if the procedure completed
 *	successfully, and TCL_ERROR if one of the initial values was
 *	bogus.  If an error occurs and interp isn't NULL, then an
 *	error message will be left in its result.
 *
 * Side effects:
 *	Fields of recordPtr are filled in with initial values.
 *
 *--------------------------------------------------------------
 */

int
Tk_InitOptions(interp, recordPtr, optionTable, tkwin)
    Tcl_Interp *interp;		/* Interpreter for error reporting.    NULL
				 * means don't leave an error message. */
    char *recordPtr;		/* Pointer to the record to configure.
				 * Note: the caller should have properly
				 * initialized the record with NULL
				 * pointers for each option value. */
    Tk_OptionTable optionTable;	/* The token which matches the config
				 * specs for the widget in question. */
    Tk_Window tkwin;		/* Certain options types (such as
				 * TK_OPTION_COLOR) need fields out
				 * of the window they are used in to
				 * be able to calculate their values.
				 * Not needed unless one of these
				 * options is in the configSpecs record. */
{
    OptionTable *tablePtr = (OptionTable *) optionTable;
    Option *optionPtr;
    int count;
    char *value;
    Tcl_Obj *valuePtr;
    enum {
	OPTION_DATABASE, SYSTEM_DEFAULT, TABLE_DEFAULT
    } source;

    /*
     * If this table chains to other tables, handle their initialization
     * first.  That way, if both tables refer to the same field of the
     * record, the value in the first table will win.
     */

    if (tablePtr->nextPtr != NULL) {
	if (Tk_InitOptions(interp, recordPtr,
		(Tk_OptionTable) tablePtr->nextPtr, tkwin) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    /*
     * Iterate over all of the options in the table, initializing each in
     * turn.
     */

    for (optionPtr = tablePtr->options, count = tablePtr->numOptions;
	    count > 0; optionPtr++, count--) {

	if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
	    continue;
	}
	source = TABLE_DEFAULT;

	/*
	 * We look in three places for the initial value, using the first
	 * non-NULL value that we find.  First, check the option database.
	 */

	valuePtr = NULL;
	if (optionPtr->dbNameUID != NULL) {
	    value = Tk_GetOption(tkwin, optionPtr->dbNameUID, 
		    optionPtr->dbClassUID);
	    if (value != NULL) {
		valuePtr = Tcl_NewStringObj(value, -1);
		source = OPTION_DATABASE;
	    }
	}

	/*
	 * Second, check for a system-specific default value.
	 */

	if ((valuePtr == NULL)
		&& (optionPtr->dbNameUID != NULL)) {
	    valuePtr = TkpGetSystemDefault(tkwin, optionPtr->dbNameUID,
		    optionPtr->dbClassUID);
	    if (valuePtr != NULL) {
		source = SYSTEM_DEFAULT;
	    }
	}

	/*
	 * Third and last, use the default value supplied by the option
	 * table.  In the case of color objects, we pick one of two
	 * values depending on whether the screen is mono or color.
	 */

	if (valuePtr == NULL) {
	    if ((tkwin != NULL) 
		    && ((optionPtr->specPtr->type == TK_OPTION_COLOR)
		    || (optionPtr->specPtr->type == TK_OPTION_BORDER))
		    && (Tk_Depth(tkwin) <= 1) 
		    && (optionPtr->extra.monoColorPtr != NULL)) {
		valuePtr = optionPtr->extra.monoColorPtr;
	    } else {
		valuePtr = optionPtr->defaultPtr;
	    }
	}

	if (valuePtr == NULL) {
	    continue;
	}

	if (DoObjConfig(interp, recordPtr, optionPtr, valuePtr, tkwin,
		(Tk_SavedOption *) NULL) != TCL_OK) {
	    if (interp != NULL) {
		char msg[200];
    
		switch (source) {
		    case OPTION_DATABASE:
			sprintf(msg, "\n    (database entry for \"%.50s\")",
				optionPtr->specPtr->optionName);
			break;
		    case SYSTEM_DEFAULT:
			sprintf(msg, "\n    (system default for \"%.50s\")",
				optionPtr->specPtr->optionName);
			break;
		    case TABLE_DEFAULT:
			sprintf(msg, "\n    (default value for \"%.50s\")",
				optionPtr->specPtr->optionName);
		}
		if (tkwin != NULL) {
		    sprintf(msg + strlen(msg) - 1, " in widget \"%.50s\")",
			    Tk_PathName(tkwin));
		}
		Tcl_AddErrorInfo(interp, msg);
	    }
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * DoObjConfig --
 *
 *	This procedure applies a new value for a configuration option
 *	to the record being configured.
 *
 * Results:
 *	The return value is TCL_OK if the procedure completed
 *	successfully.  If an error occurred then TCL_ERROR is
 *	returned and an error message is left in interp's result, if
 *	interp isn't NULL.  In addition, if oldValuePtrPtr isn't
 *	NULL then it *oldValuePtrPtr is filled in with a pointer
 *	to the option's old value.
 *
 * Side effects:
 *	RecordPtr gets modified to hold the new value in the form of
 *	a Tcl_Obj, an internal representation, or both.  The old
 *	value is freed if oldValuePtrPtr is NULL.
 *
 *--------------------------------------------------------------
 */

static int
DoObjConfig(interp, recordPtr, optionPtr, valuePtr, tkwin, savedOptionPtr)
    Tcl_Interp *interp;		/* Interpreter for error reporting.  If
				 * NULL, then no message is left if an error
				 * occurs. */
    char *recordPtr;		/* The record to modify to hold the new
				 * option value. */
    Option *optionPtr;		/* Pointer to information about the
				 * option. */
    Tcl_Obj *valuePtr;		/* New value for option. */
    Tk_Window tkwin;		/* Window in which option will be used (needed
				 * to allocate resources for some options).
				 * May be NULL if the option doesn't
				 * require window-related resources. */
    Tk_SavedOption *savedOptionPtr;
				/* If NULL, the old value for the option will
				 * be freed. If non-NULL, the old value will
				 * be stored here, and it becomes the property
				 * of the caller (the caller must eventually
				 * free the old value). */
{
    Tcl_Obj **slotPtrPtr, *oldPtr;
    char *internalPtr;		/* Points to location in record where
				 * internal representation of value should
				 * be stored, or NULL. */
    char *oldInternalPtr;	/* Points to location in which to save old
				 * internal representation of value. */
    Tk_SavedOption internal;	/* Used to save the old internal representation
				 * of the value if savedOptionPtr is NULL. */
    CONST Tk_OptionSpec *specPtr;
    int nullOK;

    /*
     * Save the old object form for the value, if there is one.
     */

    specPtr = optionPtr->specPtr;
    if (specPtr->objOffset >= 0) {
	slotPtrPtr = (Tcl_Obj **) (recordPtr + specPtr->objOffset);
	oldPtr = *slotPtrPtr;
    } else {
	slotPtrPtr = NULL;
	oldPtr = NULL;
    }

    /*
     * Apply the new value in a type-specific way.  Also remember the
     * old object and internal forms, if they exist.
     */

    if (specPtr->internalOffset >= 0) {
	internalPtr = recordPtr + specPtr->internalOffset;
    } else {
	internalPtr = NULL;
    }
    if (savedOptionPtr != NULL) {
	savedOptionPtr->optionPtr = optionPtr;
	savedOptionPtr->valuePtr = oldPtr;
	oldInternalPtr = (char *) &savedOptionPtr->internalForm;
    } else {
	oldInternalPtr = (char *) &internal.internalForm;
    }
    nullOK = (optionPtr->specPtr->flags & TK_OPTION_NULL_OK);
    switch (optionPtr->specPtr->type) {
	case TK_OPTION_BOOLEAN: {
	    int new;

	    if (Tcl_GetBooleanFromObj(interp, valuePtr, &new)
		    != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (internalPtr != NULL) {
		*((int *) oldInternalPtr) = *((int *) internalPtr);
		*((int *) internalPtr) = new;
	    }
	    break;
	}
	case TK_OPTION_INT: {
	    int new;
	    
	    if (Tcl_GetIntFromObj(interp, valuePtr, &new) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (internalPtr != NULL) {
		*((int *) oldInternalPtr) = *((int *) internalPtr);
		*((int *) internalPtr) = new;
	    }
	    break;
	}
	case TK_OPTION_DOUBLE: {
	    double new;
	    
	    if (Tcl_GetDoubleFromObj(interp, valuePtr, &new) 
		    != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (internalPtr != NULL) {
		*((double *) oldInternalPtr) = *((double *) internalPtr);
		*((double *) internalPtr) = new;
	    }
	    break;
	}
	case TK_OPTION_STRING: {
	    char *new, *value;
	    int length;

	    if (nullOK && ObjectIsEmpty(valuePtr)) {
		valuePtr = NULL;
	    }
	    if (internalPtr != NULL) {
		if (valuePtr != NULL) {
		    value = Tcl_GetStringFromObj(valuePtr, &length);
		    new = ckalloc((unsigned) (length + 1));
		    strcpy(new, value);
		} else {
		    new = NULL;
		}
		*((char **) oldInternalPtr) = *((char **) internalPtr);
		*((char **) internalPtr) = new;
	    }
	    break;
	}
	case TK_OPTION_STRING_TABLE: {
	    int new;

	    if (Tcl_GetIndexFromObj(interp, valuePtr,
		    (char **) optionPtr->specPtr->clientData,
		    optionPtr->specPtr->optionName+1, 0, &new) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (internalPtr != NULL) {
		*((int *) oldInternalPtr) = *((int *) internalPtr);
		*((int *) internalPtr) = new;
	    }
	    break;
	}
	case TK_OPTION_COLOR: {
	    XColor *newPtr;

	    if (nullOK && ObjectIsEmpty(valuePtr)) {
		valuePtr = NULL;
		newPtr = NULL;
	    } else {
		newPtr = Tk_AllocColorFromObj(interp, tkwin, valuePtr);
		if (newPtr == NULL) {
		    return TCL_ERROR;
		}
	    }
	    if (internalPtr != NULL) {
		*((XColor **) oldInternalPtr) = *((XColor **) internalPtr);
		*((XColor **) internalPtr) = newPtr;
	    }
	    break;
	}
	case TK_OPTION_FONT: {
	    Tk_Font new;

	    if (nullOK && ObjectIsEmpty(valuePtr)) {
		valuePtr = NULL;
		new = NULL;
	    } else {
		new = Tk_AllocFontFromObj(interp, tkwin, valuePtr);
		if (new == NULL) {
		    return TCL_ERROR;
		}
	    }
	    if (internalPtr != NULL) {
		*((Tk_Font *) oldInternalPtr) = *((Tk_Font *) internalPtr);
		*((Tk_Font *) internalPtr) = new;
	    }
	    break;
	}
	case TK_OPTION_BITMAP: {
	    Pixmap new;

	    if (nullOK && ObjectIsEmpty(valuePtr)) {
		valuePtr = NULL;
		new = None;
	    } else {
		new = Tk_AllocBitmapFromObj(interp, tkwin, valuePtr);
		if (new == None) {
		    return TCL_ERROR;
		}
	    }
	    if (internalPtr != NULL) {
		*((Pixmap *) oldInternalPtr) = *((Pixmap *) internalPtr);
		*((Pixmap *) internalPtr) = new;
	    }
	    break;
	}
	case TK_OPTION_BORDER: {
	    Tk_3DBorder new;

	    if (nullOK && ObjectIsEmpty(valuePtr)) {
		valuePtr = NULL;
		new = NULL;
	    } else {
		new = Tk_Alloc3DBorderFromObj(interp, tkwin, valuePtr);
		if (new == NULL) {
		    return TCL_ERROR;
		}
	    }
	    if (internalPtr != NULL) {
		*((Tk_3DBorder *) oldInternalPtr) =
			*((Tk_3DBorder *) internalPtr);
		*((Tk_3DBorder *) internalPtr) = new;
	    }
	    break;
	}
	case TK_OPTION_RELIEF: {
	    int new;

	    if (Tk_GetReliefFromObj(interp, valuePtr, &new) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (internalPtr != NULL) {
		*((int *) oldInternalPtr) = *((int *) internalPtr);
		*((int *) internalPtr) = new;
	    }
	    break;
	}
	case TK_OPTION_CURSOR: {
	    Tk_Cursor new;

	    if (nullOK && ObjectIsEmpty(valuePtr)) {
		new = None;
		valuePtr = NULL;
	    } else {
		new = Tk_AllocCursorFromObj(interp, tkwin, valuePtr);
		if (new == None) {
		    return TCL_ERROR;
		}
	    }
	    if (internalPtr != NULL) {
		*((Tk_Cursor *) oldInternalPtr) = *((Tk_Cursor *) internalPtr);
		*((Tk_Cursor *) internalPtr) = new;
	    }
	    Tk_DefineCursor(tkwin, new);
	    break;
	}
	case TK_OPTION_JUSTIFY: {
	    Tk_Justify new;

	    if (Tk_GetJustifyFromObj(interp, valuePtr, &new) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (internalPtr != NULL) {
		*((Tk_Justify *) oldInternalPtr)
			= *((Tk_Justify *) internalPtr);
		*((Tk_Justify *) internalPtr) = new;
	    }
	    break;
	}
	case TK_OPTION_ANCHOR: {
	    Tk_Anchor new;

	    if (Tk_GetAnchorFromObj(interp, valuePtr, &new) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (internalPtr != NULL) {
		*((Tk_Anchor *) oldInternalPtr)
			= *((Tk_Anchor *) internalPtr);
		*((Tk_Anchor *) internalPtr) = new;
	    }
	    break;
	}
	case TK_OPTION_PIXELS: {
	    int new;
	    
	    if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr,
		    &new) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (internalPtr != NULL) {
		*((int *) oldInternalPtr) = *((int *) internalPtr);
		*((int *) internalPtr) = new;
	    }
	    break;
	}
	case TK_OPTION_WINDOW: {
	    Tk_Window new;

	    if (nullOK && ObjectIsEmpty(valuePtr)) {
		valuePtr = NULL;
		new = None;
	    } else {
		if (TkGetWindowFromObj(interp, tkwin, valuePtr, &new)
			!= TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    if (internalPtr != NULL) {
		*((Tk_Window *) oldInternalPtr) = *((Tk_Window *) internalPtr);
		*((Tk_Window *) internalPtr) = new;
	    }
	    break;
	}
	default: {
	    sprintf(interp->result, "bad config table: unknown type %d",
		    optionPtr->specPtr->type);
	    return TCL_ERROR;
	}
    }

    /*
     * Release resources associated with the old value, if we're not
     * returning it to the caller, then install the new object value into
     * the record.
     */

    if (savedOptionPtr == NULL) {
	if (optionPtr->flags & OPTION_NEEDS_FREEING) {
	    FreeResources(optionPtr, oldPtr, oldInternalPtr, tkwin);
	}
	if (oldPtr != NULL) {
	    Tcl_DecrRefCount(oldPtr);
	}
    }
    if (slotPtrPtr != NULL) {
	*slotPtrPtr = valuePtr;
	if (valuePtr != NULL) {
	    Tcl_IncrRefCount(valuePtr);
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ObjectIsEmpty --
 *
 *	This procedure tests whether the string value of an object is
 *	empty.
 *
 * Results:
 *	The return value is 1 if the string value of objPtr has length
 *	zero, and 0 otherwise.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ObjectIsEmpty(objPtr)
    Tcl_Obj *objPtr;		/* Object to test.  May be NULL. */
{
    int length;

    if (objPtr == NULL) {
	return 1;
    }
    if (objPtr->bytes != NULL) {
	return (objPtr->length == 0);
    }
    Tcl_GetStringFromObj(objPtr, &length);
    return (length == 0);
}

/*
 *----------------------------------------------------------------------
 *
 * GetOptionFromObj --
 *
 *	This procedure searches through a chained option table to find
 *	the entry for a particular option name.
 *
 * Results:
 *	The return value is a pointer to the matching entry, or NULL
 *	if no matching entry could be found.  If NULL is returned and
 *	interp is not NULL than an error message is left in its result.
 *	Note: if the matching entry is a synonym then this procedure
 *	returns a pointer to the synonym entry, *not* the "real" entry
 *	that the synonym refers to.
 *
 * Side effects:
 *	Information about the matching entry is cached in the object
 *	containing the name, so that future lookups can proceed more
 *	quickly.
 *
 *----------------------------------------------------------------------
 */

static Option *
GetOptionFromObj(interp, objPtr, tablePtr)
    Tcl_Interp *interp;		/* Used only for error reporting; if NULL
				 * no message is left after an error. */
    Tcl_Obj *objPtr;		/* Object whose string value is to be
				 * looked up in the option table. */
    OptionTable *tablePtr;	/* Table in which to look up objPtr. */
{
    Option *bestPtr, *optionPtr;
    OptionTable *tablePtr2;
    char *p1, *p2, *name;
    int count;

    /*
     * First, check to see if the object already has the answer cached.
     */

    if (objPtr->typePtr == &optionType) {
	if (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr) {
	    return (Option *) objPtr->internalRep.twoPtrValue.ptr2;
	}
    }

    /*

     * The answer isn't cached.  Search through all of the option tables
     * in the chain to find the best match.  Some tricky aspects:
     *
     * 1. We have to accept unique abbreviations.
     * 2. The same name could appear in different tables in the chain.
     *    If this happens, we use the entry from the first table. We
     *    have to be careful to distinguish this case from an ambiguous
     *    abbreviation.
     */

    bestPtr = NULL;
    name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
    for (tablePtr2 = tablePtr; tablePtr2 != NULL;
	    tablePtr2 = tablePtr2->nextPtr) {
	for (optionPtr = tablePtr2->options, count = tablePtr2->numOptions;
		count > 0; optionPtr++, count--) {
	    for (p1 = name, p2 = optionPtr->specPtr->optionName;
		    *p1 == *p2; p1++, p2++) {
		if (*p1 == 0) {
		    /*
		     * This is an exact match.  We're done.
		     */

		    bestPtr = optionPtr;
		    goto done;
		}
	    }
	    if (*p1 == 0) {
		/*
		 * The name is an abbreviation for this option.  Keep
		 * to make sure that the abbreviation only matches one
		 * option name.  If we've already found a match in the
		 * past, then it is an error unless the full names for
		 * the two options are identical; in this case, the first
		 * option overrides the second.
		 */

		if (bestPtr == NULL) {
		    bestPtr = optionPtr;
		} else {
		    if (strcmp(bestPtr->specPtr->optionName,
			    optionPtr->specPtr->optionName) != 0) {
			goto error;
		    }
		}
	    }
	}
    }
    if (bestPtr == NULL) {
	goto error;
    }

    done:
    if ((objPtr->typePtr != NULL)
	    && (objPtr->typePtr->freeIntRepProc != NULL)) {
	objPtr->typePtr->freeIntRepProc(objPtr);
    }
    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tablePtr;
    objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) bestPtr;
    objPtr->typePtr = &optionType;
    return bestPtr;

    error:
    if (interp != NULL) {
	Tcl_AppendResult(interp, "unknown option \"", name,
		"\"", (char *) NULL);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * SetOptionFromAny --
 *
 *	This procedure is called to convert a Tcl object to option
 *	internal form. However, this doesn't make sense (need to have a
 *	table of options in order to do the conversion) so the
 *	procedure always generates an error.
 *
 * Results:
 *	The return value is always TCL_ERROR, and an error message is
 *	left in interp's result if interp isn't NULL. 
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
SetOptionFromAny(interp, objPtr)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr;	/* The object to convert. */
{
    Tcl_AppendToObj(Tcl_GetObjResult(interp),
	    "can't convert value to option except via GetOptionFromObj API",
	    -1);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_SetOptions --
 *
 *	Process one or more name-value pairs for configuration options
 *	and fill in fields of a record with new values.
 *
 * Results:
 *	If all goes well then TCL_OK is returned and the old values of
 *	any modified objects are saved in *savePtr, if it isn't NULL (the
 *	caller must eventually call Tk_RestoreSavedOptions or
 *	Tk_FreeSavedOptions to free the contents of *savePtr).  In
 *	addition, if maskPtr isn't NULL then *maskPtr is filled in with
 *	the OR of the typeMask bits from all modified options.  If an
 *	error occurs then TCL_ERROR is returned and a message 
 *	is left in interp's result unless interp is NULL; nothing is
 *	saved in *savePtr or *maskPtr in this case.
 *
 * Side effects:
 *	The fields of recordPtr get filled in with object pointers
 *	from objc/objv.  Old information in widgRec's fields gets 
 * 	recycled.  Information may be left at *savePtr.
 *
 *--------------------------------------------------------------
 */

int
Tk_SetOptions(interp, recordPtr, optionTable, objc, objv, tkwin, savePtr,
	maskPtr)
    Tcl_Interp *interp;			/* Interpreter for error reporting.

					 * If NULL, then no error message is
					 * returned.*/
    char *recordPtr;	    		/* The record to configure. */
    Tk_OptionTable optionTable;		/* Describes valid options. */
    int objc;				/* The number of elements in objv. */
    Tcl_Obj *CONST objv[];		/* Contains one or more name-value
					 * pairs. */
    Tk_Window tkwin;			/* Window associated with the thing
					 * being configured; needed for some
					 * options (such as colors). */
    Tk_SavedOptions *savePtr;		/* If non-NULL, the old values of
					 * modified options are saved here
					 * so that they can be restored
					 * after an error. */
    int *maskPtr;			/* It non-NULL, this word is modified
					 * on a successful return to hold the
					 * bit-wise OR of the typeMask fields
					 * of all options that were modified
					 * by this call.  Used by the caller
					 * to figure out which options
					 * actually changed. */
{
    OptionTable *tablePtr = (OptionTable *) optionTable;
    Option *optionPtr;
    Tk_SavedOptions *lastSavePtr, *newSavePtr;
    int mask;



    if (savePtr != NULL) {
	savePtr->recordPtr = recordPtr;
	savePtr->tkwin = tkwin;
	savePtr->numItems = 0;
	savePtr->nextPtr = NULL;
    }
    lastSavePtr = savePtr;

    /*
     * Scan through all of the arguments, processing those
     * that match entries in the option table.
     */

    mask = 0;
    for ( ; objc > 0; objc -= 2, objv += 2) {
	optionPtr = GetOptionFromObj(interp, objv[0], tablePtr);
	if (optionPtr == NULL) {
	    goto error;
	}
	if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
	    optionPtr = optionPtr->extra.synonymPtr;
	}

	if (objc < 2) {
	    if (interp != NULL) {
		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
			"value for \"", Tcl_GetStringFromObj(*objv, NULL),
			"\" missing", (char *) NULL);
		goto error;
	    }
	}
	if ((savePtr != NULL)
		&& (lastSavePtr->numItems >= TK_NUM_SAVED_OPTIONS)) {
	    /*



	     * We've run out of space for saving old option values.  Allocate
	     * more space.
	     */

	    newSavePtr = (Tk_SavedOptions *) ckalloc(sizeof(
		    Tk_SavedOptions));
	    newSavePtr->recordPtr = recordPtr;
	    newSavePtr->tkwin = tkwin;
	    newSavePtr->numItems = 0;
	    newSavePtr->nextPtr = NULL;
	    lastSavePtr->nextPtr = newSavePtr;
	    lastSavePtr = newSavePtr;
	}
	if (DoObjConfig(interp, recordPtr, optionPtr, objv[1], tkwin,
		(savePtr != NULL) ? &lastSavePtr->items[lastSavePtr->numItems]
		: (Tk_SavedOption *) NULL) != TCL_OK) {
	    char msg[100];

	    sprintf(msg, "\n    (processing \"%.40s\" option)",
		    Tcl_GetStringFromObj(*objv, NULL));
	    Tcl_AddErrorInfo(interp, msg);
	    goto error;
	}
	if (savePtr != NULL) {
	    lastSavePtr->numItems++;
	}
	mask |= optionPtr->specPtr->typeMask;
    }
    if (maskPtr != NULL) {
	*maskPtr = mask;
    }
    return TCL_OK;


    error:
    if (savePtr != NULL) {
	Tk_RestoreSavedOptions(savePtr);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_RestoreSavedOptions --
 *
 *	This procedure undoes the effect of a previous call to
 *	Tk_SetOptions by restoring all of the options to their value
 *	before the call to Tk_SetOptions.
 *
 * Results:
 *	None.
 *


 * Side effects:
 *	The configutation record is restored and all the information
 *	stored in savePtr is freed.

 *
 *----------------------------------------------------------------------
 */

void
Tk_RestoreSavedOptions(savePtr)
    Tk_SavedOptions *savePtr;	/* Holds saved option information; must
				 * have been passed to Tk_SetOptions. */
{

    int i;
    Option *optionPtr;
    Tcl_Obj *newPtr;		/* New object value of option, which we
				 * replace with old value and free.  Taken
				 * from record. */
    char *internalPtr;		/* Points to internal value of option in
				 * record. */
    CONST Tk_OptionSpec *specPtr;






    /*
     * Be sure to restore the options in the opposite order they were
     * set.  This is important because it's possible that the same
     * option name was used twice in a single call to Tk_SetOptions.



     */

    if (savePtr->nextPtr != NULL) {
	Tk_RestoreSavedOptions(savePtr->nextPtr);
	ckfree((char *) savePtr->nextPtr);
	savePtr->nextPtr = NULL;
    }
    for (i = savePtr->numItems - 1; i >= 0; i--) {
	optionPtr = savePtr->items[i].optionPtr;
	specPtr = optionPtr->specPtr;

	/*
	 * First free the new value of the option, which is currently

	 * in the record.

	 */

	if (specPtr->objOffset >= 0) {
	    newPtr = *((Tcl_Obj **) (savePtr->recordPtr + specPtr->objOffset));
	} else {
	    newPtr = NULL;
	}
	if (specPtr->internalOffset >= 0) {
	    internalPtr = savePtr->recordPtr + specPtr->internalOffset;
	} else {
	    internalPtr = NULL;
	}
	if (optionPtr->flags & OPTION_NEEDS_FREEING) {
	    FreeResources(optionPtr, newPtr, internalPtr, savePtr->tkwin);
	}
	if (newPtr != NULL) {
	    Tcl_DecrRefCount(newPtr);
	}

	/*
	 * Now restore the old value of the option.
	 */

	if (specPtr->objOffset >= 0) {
	    *((Tcl_Obj **) (savePtr->recordPtr + specPtr->objOffset))
		    = savePtr->items[i].valuePtr;
	}
	if (specPtr->internalOffset >= 0) {
	    switch (specPtr->type) {
		case TK_OPTION_BOOLEAN: {
		    *((int *) internalPtr)
			    = *((int *) &savePtr->items[i].internalForm);
		    break;
		}
		case TK_OPTION_INT: {
		    *((int *) internalPtr)
			    = *((int *) &savePtr->items[i].internalForm);

		    break;
		}

		case TK_OPTION_DOUBLE: {
		    *((double *) internalPtr)
			    = *((double *) &savePtr->items[i].internalForm);
		    break;
		}
		case TK_OPTION_STRING: {
		    *((char **) internalPtr)
			    = *((char **) &savePtr->items[i].internalForm);
		    break;
		}

		case TK_OPTION_STRING_TABLE: {
		    *((int *) internalPtr)
			    = *((int *) &savePtr->items[i].internalForm);
		    break;
		}
		case TK_OPTION_COLOR: {
		    *((XColor **) internalPtr)
			    = *((XColor **) &savePtr->items[i].internalForm);
		    break;
		}
		case TK_OPTION_FONT: {
		    *((Tk_Font *) internalPtr)
			    = *((Tk_Font *) &savePtr->items[i].internalForm);
		    break;
		}
		case TK_OPTION_BITMAP: {
		    *((Pixmap *) internalPtr)
			    = *((Pixmap *) &savePtr->items[i].internalForm);
		    break;
		}
		case TK_OPTION_BORDER: {
		    *((Tk_3DBorder *) internalPtr)
			    = *((Tk_3DBorder *) &savePtr->items[i].internalForm);
		    break;
		}
		case TK_OPTION_RELIEF: {
		    *((int *) internalPtr)
			    = *((int *) &savePtr->items[i].internalForm);
		    break;
		}
		case TK_OPTION_CURSOR: {
		    *((Tk_Cursor *) internalPtr)
			    = *((Tk_Cursor *) &savePtr->items[i].internalForm);
		    Tk_DefineCursor(savePtr->tkwin,
			    *((Tk_Cursor *) internalPtr));
		    break;
		}
		case TK_OPTION_JUSTIFY: {
		    *((Tk_Justify *) internalPtr)


			    = *((Tk_Justify *) &savePtr->items[i].internalForm);
		    break;
		}
		case TK_OPTION_ANCHOR: {
		    *((Tk_Anchor *) internalPtr)
			    = *((Tk_Anchor *) &savePtr->items[i].internalForm);
		    break;
		}
		case TK_OPTION_PIXELS: {
		    *((int *) internalPtr)
			    = *((int *) &savePtr->items[i].internalForm);
		    break;
		}
		case TK_OPTION_WINDOW: {
		    *((Tk_Window *) internalPtr)
			    = *((Tk_Window *) &savePtr->items[i].internalForm);
		    break;
		}
		default: {
		    panic("bad option type in Tk_RestoreSavedOptions");
		}
	    }
	}

    }
    savePtr->numItems = 0;
}

/*
 *--------------------------------------------------------------
 *















 * Tk_FreeSavedOptions --
















 *


























 *	Free all of the saved configuration option values from a





 *	previous call to Tk_SetOptions.




 *





























 * Results:
 *	None.
 *
 * Side effects:
 *	Storage and system resources are freed.


 *
 *--------------------------------------------------------------
 */

void




Tk_FreeSavedOptions(savePtr)
    Tk_SavedOptions *savePtr;	/* Contains options saved in a previous





				 * call to Tk_SetOptions. */
{
    int count;
    Tk_SavedOption *savedOptionPtr;

    if (savePtr->nextPtr != NULL) {
	Tk_FreeSavedOptions(savePtr->nextPtr);
	ckfree((char *) savePtr->nextPtr);
    }
    for (count = savePtr->numItems,
	    savedOptionPtr = &savePtr->items[savePtr->numItems-1];
	    count > 0;  count--, savedOptionPtr--) {
	if (savedOptionPtr->optionPtr->flags & OPTION_NEEDS_FREEING) {
	    FreeResources(savedOptionPtr->optionPtr, savedOptionPtr->valuePtr,
		    (char *) &savedOptionPtr->internalForm, savePtr->tkwin);
	}
	if (savedOptionPtr->valuePtr != NULL) {
	    Tcl_DecrRefCount(savedOptionPtr->valuePtr);
	}
    }
}


/*
 *----------------------------------------------------------------------
 *







 * Tk_FreeConfigOptions --












 *
 *	Free all resources associated with configuration options.
 *
 * Results:
 *	None.
 *
 * Side effects:



 *	All of the Tcl_Obj's in recordPtr that are controlled by
 *	configuration options in optionTable are freed.
 *
 *----------------------------------------------------------------------
 */




	/* ARGSUSED */




void

Tk_FreeConfigOptions(recordPtr, optionTable, tkwin)
    char *recordPtr;		/* Record whose fields contain current
				 * values for options. */


    Tk_OptionTable optionTable;	/* Describes legal options. */
    Tk_Window tkwin;		/* Window associated with recordPtr; needed
				 * for freeing some options. */


{

    OptionTable *tablePtr;
    Option *optionPtr;
    int count;

    Tcl_Obj **oldPtrPtr, *oldPtr; 
    char *oldInternalPtr;
    CONST Tk_OptionSpec *specPtr;



    for (tablePtr = (OptionTable *) optionTable; tablePtr != NULL;
	    tablePtr = tablePtr->nextPtr) {
	for (optionPtr = tablePtr->options, count = tablePtr->numOptions;
		count > 0; optionPtr++, count--) {
	    specPtr = optionPtr->specPtr;
	    if (specPtr->type == TK_OPTION_SYNONYM) {
		continue;
	    }
	    if (specPtr->objOffset >= 0) {
		oldPtrPtr = (Tcl_Obj **) (recordPtr + specPtr->objOffset);
		oldPtr = *oldPtrPtr;
		*oldPtrPtr = NULL;
	    } else {
		oldPtr = NULL;
	    }


	    if (specPtr->internalOffset >= 0) {


		oldInternalPtr = recordPtr + specPtr->internalOffset;
	    } else {

		oldInternalPtr = NULL;

	    }
	    if (optionPtr->flags & OPTION_NEEDS_FREEING) {
		FreeResources(optionPtr, oldPtr, oldInternalPtr, tkwin);
	    }

	    if (oldPtr != NULL) {
		Tcl_DecrRefCount(oldPtr);
	    }


	}







    }
}





/*
 *----------------------------------------------------------------------
 *
 * FreeResources --

 *
 *	Free system resources associated with a configuration option,
 *	such as colors or fonts.

 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Any system resources associated with objPtr are released.  However,







 *	objPtr itself is not freed.








 *
 *----------------------------------------------------------------------
 */

static void
FreeResources(optionPtr, objPtr, internalPtr, tkwin)
    Option *optionPtr;		/* Description of the configuration option. */
    Tcl_Obj *objPtr;		/* The current value of the option, specified
				 * as an object. */

    char *internalPtr;		/* A pointer to an internal representation for
				 * the option's value, such as an int or
				 * (XColor *).  Only valid if
				 * optionPtr->specPtr->internalOffset >= 0. */
    Tk_Window tkwin;		/* The window in which this option is used. */
{




    int internalFormExists;




    /*
     * If there exists an internal form for the value, use it to free
     * resources (also zero out the internal form).  If there is no
     * internal form, then use the object form.
     */


    internalFormExists = optionPtr->specPtr->internalOffset >= 0;
    switch (optionPtr->specPtr->type) {


	case TK_OPTION_STRING:
	    if (internalFormExists) {
		if (*((char **) internalPtr) != NULL) {
		    ckfree(*((char **) internalPtr));
		    *((char **) internalPtr) = NULL;
		}




	    }
	    break;
	case TK_OPTION_COLOR:

	    if (internalFormExists) {
		if (*((XColor **) internalPtr) != NULL) {
		    Tk_FreeColor(*((XColor **) internalPtr));
		    *((XColor **) internalPtr) = NULL;
		}

	    } else if (objPtr != NULL) {
		Tk_FreeColorFromObj(tkwin, objPtr);


	    }
	    break;
	case TK_OPTION_FONT:
	    if (internalFormExists) {
		Tk_FreeFont(*((Tk_Font *) internalPtr));
		*((Tk_Font *) internalPtr) = NULL;
	    } else if (objPtr != NULL) {
		Tk_FreeFontFromObj(tkwin, objPtr);
	    }
	    break;
	case TK_OPTION_BITMAP:
	    if (internalFormExists) {
		if (*((Pixmap *) internalPtr) != None) {
		    Tk_FreeBitmap(Tk_Display(tkwin), *((Pixmap *) internalPtr));
		    *((Pixmap *) internalPtr) = None;
		}

	    } else if (objPtr != NULL) {
		Tk_FreeBitmapFromObj(tkwin, objPtr);


	    }
	    break;
	case TK_OPTION_BORDER:
	    if (internalFormExists) {
		if (*((Tk_3DBorder *) internalPtr) != NULL) {
		    Tk_Free3DBorder(*((Tk_3DBorder *) internalPtr));
		    *((Tk_3DBorder *) internalPtr) = NULL;
		}


	    } else if (objPtr != NULL) {

		Tk_Free3DBorderFromObj(tkwin, objPtr);

	    }


	    break;
	case TK_OPTION_CURSOR:
	    if (internalFormExists) {
		if (*((Tk_Cursor *) internalPtr) != None) {
		    Tk_FreeCursor(Tk_Display(tkwin),
			    *((Tk_Cursor *) internalPtr));
		    *((Tk_Cursor *) internalPtr) = None;
		}
	    } else if (objPtr != NULL) {

		Tk_FreeCursorFromObj(tkwin, objPtr);


	    }
	    break;
	default:


	    break;
    }




}

/*
 *--------------------------------------------------------------
 *
 * Tk_GetOptionInfo --
 *
 *	Returns a list object containing complete information about
 *	either a single option or all the configuration options in a

 *	table.
 *
 * Results:
 *	This procedure normally returns a pointer to an object.



 *	If namePtr isn't NULL, then the result object is a list with


 *	five elements: the option's name, its database name, database
 *	class, default value, and current value.  If the option is a

 *	synonym then the list will contain only two values: the option
 *	name and the name of the option it refers to.  If namePtr is
 *	NULL, then information is returned for every option in the

 *	option table: the result will have one sub-list (in the form
 *	described above) for each option in the table.  If an error
 *	occurs (e.g. because namePtr isn't valid) then NULL is returned
 *	and an error message will be left in interp's result unless
 *	interp is NULL.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */


Tcl_Obj *
Tk_GetOptionInfo(interp, recordPtr, optionTable, namePtr, tkwin)
    Tcl_Interp *interp;		/* Interpreter for error reporting.  If	
				 * NULL, then no error message is created. */

    char *recordPtr;		/* Record whose fields contain current
				 * values for options. */
    Tk_OptionTable optionTable;	/* Describes all the legal options. */
    Tcl_Obj *namePtr;		/* If non-NULL, the string value selects
				 * a single option whose info is to be
				 * returned.  Otherwise info is returned for
				 * all options in optionTable. */
    Tk_Window tkwin;		/* Window associated with recordPtr; needed
				 * to compute correct default value for some
				 * options. */
{
    Tcl_Obj *resultPtr;


    OptionTable *tablePtr = (OptionTable *) optionTable;
    Option *optionPtr;

    int count;





    /*
     * If information is only wanted for a single configuration
     * spec, then handle that one spec specially.
     */


    if (namePtr != NULL) {
	optionPtr = GetOptionFromObj(interp, namePtr, tablePtr);

	if (optionPtr == NULL) {
	    return (Tcl_Obj *) NULL;
	}
	if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {

	    optionPtr = optionPtr->extra.synonymPtr;
	}
	return GetConfigList(recordPtr, optionPtr, tkwin);
    }

    /*
     * Loop through all the specs, creating a big list with all
     * their information.
     */

    resultPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
    for (; tablePtr != NULL; tablePtr = tablePtr->nextPtr) {
	for (optionPtr = tablePtr->options, count = tablePtr->numOptions;
		count > 0; optionPtr++, count--) {

	    Tcl_ListObjAppendElement(interp, resultPtr,
		    GetConfigList(recordPtr, optionPtr, tkwin));

	}


    }





    return resultPtr;
}

/*
 *--------------------------------------------------------------
 *
 * GetConfigList --
 *
 *	Create a valid Tcl list holding the configuration information
 *	for a single configuration option.
 *
 * Results:
 *	A Tcl list, dynamically allocated.  The caller is expected to
 *	arrange for this list to be freed eventually.
 *
 * Side effects:
 *	Memory is allocated.
 *
 *--------------------------------------------------------------
 */

static Tcl_Obj *
GetConfigList(recordPtr, optionPtr, tkwin)
    char *recordPtr;		/* Pointer to record holding current
				 * values of configuration options. */

    Option *optionPtr;		/* Pointer to information describing a
				 * particular option. */
    Tk_Window tkwin;		/* Window corresponding to recordPtr. */
{
    Tcl_Obj *listPtr, *elementPtr;

    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
    Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, 
	    Tcl_NewStringObj(optionPtr->specPtr->optionName, -1));

    if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
	elementPtr = Tcl_NewStringObj(
		optionPtr->extra.synonymPtr->specPtr->optionName, -1);
	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
    } else {
	if (optionPtr->dbNameUID == NULL) {
	    elementPtr = Tcl_NewObj();
	} else {
	    elementPtr = Tcl_NewStringObj(optionPtr->dbNameUID, -1);
	}
	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);

	if (optionPtr->dbClassUID == NULL) {
	    elementPtr = Tcl_NewObj();
	} else {
	    elementPtr = Tcl_NewStringObj(optionPtr->dbClassUID, -1);
	}
	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);

	if ((tkwin != NULL) && ((optionPtr->specPtr->type == TK_OPTION_COLOR)
		|| (optionPtr->specPtr->type == TK_OPTION_BORDER))
		&& (Tk_Depth(tkwin) <= 1)
		&& (optionPtr->extra.monoColorPtr != NULL)) {
	    elementPtr = optionPtr->extra.monoColorPtr;
	} else if (optionPtr->defaultPtr != NULL) {
	    elementPtr = optionPtr->defaultPtr;
	} else {
	    elementPtr = Tcl_NewObj();
	}
	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);

	if (optionPtr->specPtr->objOffset >= 0) {
	    elementPtr = *((Tcl_Obj **) (recordPtr
		    + optionPtr->specPtr->objOffset));
	    if (elementPtr == NULL) {
		elementPtr = Tcl_NewObj();
	    }
	} else {
	    elementPtr = GetObjectForOption(recordPtr, optionPtr, tkwin);
	}
	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, elementPtr);
    }
    return listPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * GetObjectForOption --
 *
 *	This procedure is called to create an object that contains the
 *	value for an option.  It is invoked by GetConfigList and
 *	Tk_GetOptionValue when only the internal form of an option is
 *	stored in the record.
 *
 * Results:
 *	The return value is a pointer to a Tcl object.  The caller
 *	must call Tcl_IncrRefCount on this object to preserve it.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
GetObjectForOption(recordPtr, optionPtr, tkwin)
    char *recordPtr;		/* Pointer to record holding current
				 * values of configuration options. */
    Option *optionPtr;		/* Pointer to information describing an
				 * option whose internal value is stored
				 * in *recordPtr. */
    Tk_Window tkwin;		/* Window corresponding to recordPtr. */
{
    Tcl_Obj *objPtr;
    char *internalPtr;		/* Points to internal value of option in
				 * record. */

    internalPtr = recordPtr + optionPtr->specPtr->internalOffset;
    objPtr = NULL;
    switch (optionPtr->specPtr->type) {
	case TK_OPTION_BOOLEAN: {
	    objPtr = Tcl_NewIntObj(*((int *) internalPtr));
	    break;
	}

	case TK_OPTION_INT: {
	    objPtr = Tcl_NewIntObj(*((int *) internalPtr));
	    break;

	}
	case TK_OPTION_DOUBLE: {
	    objPtr = Tcl_NewDoubleObj(*((double *) internalPtr));
	    break;
	}
	case TK_OPTION_STRING: {
	    objPtr = Tcl_NewStringObj(*((char **) internalPtr), -1);
	    break;
	}
	case TK_OPTION_STRING_TABLE: {
	    objPtr = Tcl_NewStringObj(
		    ((char **) optionPtr->specPtr->clientData)[
		    *((int *) internalPtr)], -1);
	    break;
	}
	case TK_OPTION_COLOR: { 
	    XColor *colorPtr = *((XColor **) internalPtr);
	    if (colorPtr != NULL) {
		objPtr = Tcl_NewStringObj(Tk_NameOfColor(colorPtr), -1);
	    }
	    break;
	}
	case TK_OPTION_FONT: {
	    Tk_Font tkfont = *((Tk_Font *) internalPtr);
	    if (tkfont != NULL) {
		objPtr = Tcl_NewStringObj(Tk_NameOfFont(tkfont), -1);
	    }
	    break;
	}
	case TK_OPTION_BITMAP: {
	    Pixmap pixmap = *((Pixmap *) internalPtr);
	    if (pixmap != None) {

		objPtr = Tcl_NewStringObj(Tk_NameOfBitmap(Tk_Display(tkwin),
			pixmap), -1);
	    }
	    break;
	}
	case TK_OPTION_BORDER: {
	    Tk_3DBorder border = *((Tk_3DBorder *) internalPtr);
	    if (border != NULL) {
		objPtr = Tcl_NewStringObj(Tk_NameOf3DBorder(border), -1);
	    }
	    break;
	}
	case TK_OPTION_RELIEF: {
	    objPtr = Tcl_NewStringObj(Tk_NameOfRelief(
		    *((int *) internalPtr)), -1);
	    break;
	}
	case TK_OPTION_CURSOR: {
	    Tk_Cursor cursor = *((Tk_Cursor *) internalPtr);
	    if (cursor != None) {
		objPtr = Tcl_NewStringObj(
			Tk_NameOfCursor(Tk_Display(tkwin), cursor), -1);
	    }
	    break;
	}
	case TK_OPTION_JUSTIFY: {
	    objPtr = Tcl_NewStringObj(Tk_NameOfJustify(
		    *((Tk_Justify *) internalPtr)), -1);
	    break;
	}
	case TK_OPTION_ANCHOR: {
	    objPtr = Tcl_NewStringObj(Tk_NameOfAnchor(
		    *((Tk_Anchor *) internalPtr)), -1);
	    break;
	}
	case TK_OPTION_PIXELS: {
	    objPtr = Tcl_NewIntObj(*((int *) internalPtr));
	    break;
	}
	case TK_OPTION_WINDOW: {
	    Tk_Window tkwin = *((Tk_Window *) internalPtr);
	    if (tkwin != NULL) {
		objPtr = Tcl_NewStringObj(Tk_PathName(tkwin), -1);
	    }
	    break;
	}
	default: {
	    panic("bad option type in GetObjectForOption");
	}
    }
    if (objPtr == NULL) {
	objPtr = Tcl_NewObj();
    }
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetOptionValue --
 *
 *	This procedure returns the current value of a configuration
 *	option.
 *
 * Results:
 *	The return value is the object holding the current value of
 *	the option given by namePtr.  If no such option exists, then


 *	the return value is NULL and an error message is left in
 *	interp's result (if interp isn't NULL).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tk_GetOptionValue(interp, recordPtr, optionTable, namePtr, tkwin)
    Tcl_Interp *interp;		/* Interpreter for error reporting.  If
				 * NULL then no messages are provided for

				 * errors. */
    char *recordPtr;		/* Record whose fields contain current
				 * values for options. */
    Tk_OptionTable optionTable;	/* Describes legal options. */
    Tcl_Obj *namePtr;		/* Gives the command-line name for the
				 * option whose value is to be returned. */


    Tk_Window tkwin;		/* Window corresponding to recordPtr. */
{

    OptionTable *tablePtr = (OptionTable *) optionTable;
    Option *optionPtr;

    Tcl_Obj *resultPtr;




















































    optionPtr = GetOptionFromObj(interp, namePtr, tablePtr);
    if (optionPtr == NULL) {


	return NULL;
    }






    if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {

	optionPtr = optionPtr->extra.synonymPtr;
    }



    if (optionPtr->specPtr->objOffset >= 0) {
	resultPtr = *((Tcl_Obj **) (recordPtr + optionPtr->specPtr->objOffset));


	if (resultPtr == NULL) {

	    /*
	     * This option has a null value and is represented by a null
	     * object pointer.  We can't return the null pointer, since that
	     * would indicate an error.  Instead, return a new empty object.
	     */
















    


	    resultPtr = Tcl_NewObj();
	} 

    } else {






	resultPtr = GetObjectForOption(recordPtr, optionPtr, tkwin);
    }
    return resultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TkDebugConfig --
 *
 *	This is a debugging procedure that returns information about
 *	one of the configuration tables that currently exists for an
 *	interpreter.
 *
 * Results:

 *	If the specified table exists in the given interpreter, then a
 *	list is returned describing the table and any other tables that
 *	it chains to: for each table there will be three list elements
 *	giving the reference count for the table, the number of elements
 *	in the table, and the command-line name for the first option
 *	in the table.  If the table doesn't exist in the interpreter
 *	then an empty object is returned.  The reference count for the
 *	returned object is 0.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */


Tcl_Obj *
TkDebugConfig(interp, table)
    Tcl_Interp *interp;			/* Interpreter in which the table is



					 * defined. */
    Tk_OptionTable table;		/* Table about which information is to
					 * be returned.  May not necessarily

					 * exist in the interpreter anymore. */

{
    OptionTable *tablePtr = (OptionTable *) table;
    Tcl_HashTable *hashTablePtr;

    Tcl_HashEntry *hashEntryPtr;



    Tcl_HashSearch search;

    Tcl_Obj *objPtr;

    objPtr = Tcl_NewObj();
    hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY,
	    NULL);
    if (hashTablePtr == NULL) {




	return objPtr;
    }

































    /*


     * Scan all the tables for this interpreter to make sure that the
     * one we want still is valid.
     */

    for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search);










	    hashEntryPtr != NULL;

	    hashEntryPtr = Tcl_NextHashEntry(&search)) {
	if (tablePtr == (OptionTable *) Tcl_GetHashValue(hashEntryPtr)) {


	    for ( ; tablePtr != NULL; tablePtr = tablePtr->nextPtr) {
		Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
			Tcl_NewIntObj(tablePtr->refCount));
		Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
			Tcl_NewIntObj(tablePtr->numOptions));
		Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
			Tcl_NewStringObj(
				tablePtr->options[0].specPtr->optionName,




			-1));

	    }
	    break;





	}
    }

    return objPtr;
}

Changes to generic/tkConsole.c.

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
/* 
 * tkConsole.c --
 *
 *	This file implements a Tcl console for systems that may not
 *	otherwise have access to a console.  It uses the Text widget
 *	and provides special access via a console command.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkConsole.c 1.54 97/10/17 10:46:08
 */

#include "tk.h"
#include <string.h>



/*
 * A data structure of the following type holds information for each console
 * which a handler (i.e. a Tcl command) has been defined for a particular
 * top-level window.
 */

typedef struct ConsoleInfo {
    Tcl_Interp *consoleInterp;	/* Interpreter for the console. */
    Tcl_Interp *interp;		/* Interpreter to send console commands. */
} ConsoleInfo;


static Tcl_Interp *gStdoutInterp = NULL;



/*
 * Forward declarations for procedures defined later in this file:
 *
 * The first three will be used in the tk app shells...
 */
 
void	TkConsoleCreate _ANSI_ARGS_((void));
int	TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
void	TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
			    int devId, char *buffer, long size));

static int	ConsoleCmd _ANSI_ARGS_((ClientData clientData,
		    Tcl_Interp *interp, int argc, char **argv));
static void	ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));












|




>
>












>
|
>
>







|







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
/* 
 * tkConsole.c --
 *
 *	This file implements a Tcl console for systems that may not
 *	otherwise have access to a console.  It uses the Text widget
 *	and provides special access via a console command.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkConsole.c,v 1.1.4.7 1999/03/27 02:14:19 redman Exp $
 */

#include "tk.h"
#include <string.h>

#include "tkInt.h"

/*
 * A data structure of the following type holds information for each console
 * which a handler (i.e. a Tcl command) has been defined for a particular
 * top-level window.
 */

typedef struct ConsoleInfo {
    Tcl_Interp *consoleInterp;	/* Interpreter for the console. */
    Tcl_Interp *interp;		/* Interpreter to send console commands. */
} ConsoleInfo;

typedef struct ThreadSpecificData {
    Tcl_Interp *gStdoutInterp;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations for procedures defined later in this file:
 *
 * The first three will be used in the tk app shells...
 */
 
void	TkConsoleCreate_ _ANSI_ARGS_((void));
int	TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
void	TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
			    int devId, char *buffer, long size));

static int	ConsoleCmd _ANSI_ARGS_((ClientData clientData,
		    Tcl_Interp *interp, int argc, char **argv));
static void	ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
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
    ConsoleWatch,		/* Watch for events on console. */
    ConsoleHandle,		/* Get a handle from the device. */
};

/*
 *----------------------------------------------------------------------
 *
 * TkConsoleCreate --
 *
 * 	Create the console channels and install them as the standard
 * 	channels.  All I/O will be discarded until TkConsoleInit is
 * 	called to attach the console to a text widget.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates the console channel and installs it as the standard
 *	channels.
 *
 *----------------------------------------------------------------------
 */

void
TkConsoleCreate()
{











    Tcl_Channel consoleChannel;






    consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
	    (ClientData) TCL_STDIN, TCL_READABLE);
    if (consoleChannel != NULL) {
	Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");

    }
    Tcl_SetStdChannel(consoleChannel, TCL_STDIN);







    consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
	    (ClientData) TCL_STDOUT, TCL_WRITABLE);
    if (consoleChannel != NULL) {
	Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");

    }
    Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);







    consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
	    (ClientData) TCL_STDERR, TCL_WRITABLE);
    if (consoleChannel != NULL) {
	Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");

    }
    Tcl_SetStdChannel(consoleChannel, TCL_STDERR);

}

/*
 *----------------------------------------------------------------------
 *
 * TkConsoleInit --
 *







|


















>
>
>
>
>
>
>
>
>
>
>


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







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
    ConsoleWatch,		/* Watch for events on console. */
    ConsoleHandle,		/* Get a handle from the device. */
};

/*
 *----------------------------------------------------------------------
 *
 * TkConsoleCreate, TkConsoleCreate_ --
 *
 * 	Create the console channels and install them as the standard
 * 	channels.  All I/O will be discarded until TkConsoleInit is
 * 	called to attach the console to a text widget.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates the console channel and installs it as the standard
 *	channels.
 *
 *----------------------------------------------------------------------
 */

void
TkConsoleCreate()
{
    /*
     * This function is being diabled so we don't end up calling it
     * twice.  Once from WinMain() and once from Tk_MainEx(). The real
     * function is now tkCreateConsole_ and is only called from Tk_MainEx.
     * All of this is an ugly hack.
     */
}

void
TkConsoleCreate_()
{
    Tcl_Channel consoleChannel;

    /*
     * check for STDIN, otherwise create it
     */

    if (Tcl_GetStdChannel(TCL_STDIN) == NULL) {
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
	        (ClientData) TCL_STDIN, TCL_READABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
	}
	Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
    }

    /*
     * check for STDOUT, otherwise create it
     */

    if (Tcl_GetStdChannel(TCL_STDOUT) == NULL) {
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
	        (ClientData) TCL_STDOUT, TCL_WRITABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
	}
	Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
    }

    /*
     * check for STDERR, otherwise create it
     */

    if (Tcl_GetStdChannel(TCL_STDERR) == NULL) {
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
	        (ClientData) TCL_STDERR, TCL_WRITABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
	}
	Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkConsoleInit --
 *
144
145
146
147
148
149
150


151
152
153
154
155
156
157
int 
TkConsoleInit(interp)
    Tcl_Interp *interp;			/* Interpreter to use for prompting. */
{
    Tcl_Interp *consoleInterp;
    ConsoleInfo *info;
    Tk_Window mainWindow = Tk_MainWindow(interp);


#ifdef MAC_TCL
    static char initCmd[] = "source -rsrc {Console}";
#else
    static char initCmd[] = "source $tk_library/console.tcl";
#endif
    
    consoleInterp = Tcl_CreateInterp();







>
>







183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
int 
TkConsoleInit(interp)
    Tcl_Interp *interp;			/* Interpreter to use for prompting. */
{
    Tcl_Interp *consoleInterp;
    ConsoleInfo *info;
    Tk_Window mainWindow = Tk_MainWindow(interp);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
#ifdef MAC_TCL
    static char initCmd[] = "source -rsrc {Console}";
#else
    static char initCmd[] = "source $tk_library/console.tcl";
#endif
    
    consoleInterp = Tcl_CreateInterp();
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179

    if (Tcl_Init(consoleInterp) != TCL_OK) {
	goto error;
    }
    if (Tk_Init(consoleInterp) != TCL_OK) {
	goto error;
    }
    gStdoutInterp = interp;
    
    /* 
     * Add console commands to the interp 
     */
    info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
    info->interp = interp;
    info->consoleInterp = consoleInterp;







|







206
207
208
209
210
211
212
213
214
215
216
217
218
219
220

    if (Tcl_Init(consoleInterp) != TCL_OK) {
	goto error;
    }
    if (Tk_Init(consoleInterp) != TCL_OK) {
	goto error;
    }
    tsdPtr->gStdoutInterp = interp;
    
    /* 
     * Add console commands to the interp 
     */
    info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
    info->interp = interp;
    info->consoleInterp = consoleInterp;
221
222
223
224
225
226
227



228
229
230
231
232

233
234
235
236
237
238
239
static int
ConsoleOutput(instanceData, buf, toWrite, errorCode)
    ClientData instanceData;		/* Indicates which device to use. */
    char *buf;				/* The data buffer. */
    int toWrite;			/* How many bytes to write? */
    int *errorCode;			/* Where to store error code. */
{



    *errorCode = 0;
    Tcl_SetErrno(0);

    if (gStdoutInterp != NULL) {
	TkConsolePrint(gStdoutInterp, (int) instanceData, buf, toWrite);

    }
    
    return toWrite;
}

/*
 *----------------------------------------------------------------------







>
>
>



|
|
>







262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
static int
ConsoleOutput(instanceData, buf, toWrite, errorCode)
    ClientData instanceData;		/* Indicates which device to use. */
    char *buf;				/* The data buffer. */
    int toWrite;			/* How many bytes to write? */
    int *errorCode;			/* Where to store error code. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    *errorCode = 0;
    Tcl_SetErrno(0);

    if (tsdPtr->gStdoutInterp != NULL) {
	TkConsolePrint(tsdPtr->gStdoutInterp, (int) instanceData, buf, 
                toWrite);
    }
    
    return toWrite;
}

/*
 *----------------------------------------------------------------------
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
    char **argv;			/* Argument strings. */
{
    ConsoleInfo *info = (ConsoleInfo *) clientData;
    char c;
    int length;
    int result;
    Tcl_Interp *consoleInterp;


    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?arg arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    
    c = argv[1][0];
    length = strlen(argv[1]);
    result = TCL_OK;
    consoleInterp = info->consoleInterp;
    Tcl_Preserve((ClientData) consoleInterp);
    if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
	Tcl_DString dString;
	
	Tcl_DStringInit(&dString);

	Tcl_DStringAppend(&dString, "wm title . ", -1);
	if (argc == 3) {
	    Tcl_DStringAppendElement(&dString, argv[2]);
	}
	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
	Tcl_DStringFree(&dString);
    } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
	Tcl_Eval(info->consoleInterp, "wm withdraw .");

    } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
	Tcl_Eval(info->consoleInterp, "wm deiconify .");

    } else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
	if (argc == 3) {
	    Tcl_Eval(info->consoleInterp, argv[2]);


	} else {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " eval command\"", (char *) NULL);
	    return TCL_ERROR;
	}
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be hide, show, or title",
		(char *) NULL);
        result = TCL_ERROR;
    }

    Tcl_Release((ClientData) consoleInterp);
    return result;
}

/*
 *----------------------------------------------------------------------
 *







>












<
|
|
<
>





<

|
>

|
>


|
>
>











>







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
    char **argv;			/* Argument strings. */
{
    ConsoleInfo *info = (ConsoleInfo *) clientData;
    char c;
    int length;
    int result;
    Tcl_Interp *consoleInterp;
    Tcl_DString dString;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?arg arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    
    c = argv[1][0];
    length = strlen(argv[1]);
    result = TCL_OK;
    consoleInterp = info->consoleInterp;
    Tcl_Preserve((ClientData) consoleInterp);

    Tcl_DStringInit(&dString);


    if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
	Tcl_DStringAppend(&dString, "wm title . ", -1);
	if (argc == 3) {
	    Tcl_DStringAppendElement(&dString, argv[2]);
	}
	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));

    } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
	Tcl_DStringAppend(&dString, "wm withdraw . ", -1);
	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
    } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
	Tcl_DStringAppend(&dString, "wm deiconify . ", -1);
	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
    } else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
	if (argc == 3) {
	    result = Tcl_Eval(consoleInterp, argv[2]);
	    Tcl_AppendResult(interp, Tcl_GetStringResult(consoleInterp),
		    (char *) NULL);
	} else {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " eval command\"", (char *) NULL);
	    return TCL_ERROR;
	}
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be hide, show, or title",
		(char *) NULL);
        result = TCL_ERROR;
    }
    Tcl_DStringFree(&dString);
    Tcl_Release((ClientData) consoleInterp);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
462
463
464
465
466
467
468

469
470
471
472
473
474
475
    Tcl_Preserve((ClientData) otherInterp);
    if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
   	result = Tcl_GlobalEval(otherInterp, argv[2]);
    	Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
    } else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) {
   	Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL);
	result = TCL_OK;

    	Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be eval or record",
		(char *) NULL);
	result = TCL_ERROR;
    }







>







511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
    Tcl_Preserve((ClientData) otherInterp);
    if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
   	result = Tcl_GlobalEval(otherInterp, argv[2]);
    	Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
    } else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) {
   	Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL);
	result = TCL_OK;
	Tcl_ResetResult(interp);
    	Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be eval or record",
		(char *) NULL);
	result = TCL_ERROR;
    }
526
527
528
529
530
531
532

533
534



535
536
537
538
539
540
541
542
543
544
545
546
547

548

549
550
551
552
553
554
555
static void
ConsoleEventProc(clientData, eventPtr)
    ClientData clientData;
    XEvent *eventPtr;
{
    ConsoleInfo *info = (ConsoleInfo *) clientData;
    Tcl_Interp *consoleInterp;

    
    if (eventPtr->type == DestroyNotify) {



        consoleInterp = info->consoleInterp;

        /*
         * It is possible that the console interpreter itself has
         * already been deleted. In that case the consoleInterp
         * field will be set to NULL. If the interpreter is already
         * gone, we do not have to do any work here.
         */
        
        if (consoleInterp == (Tcl_Interp *) NULL) {
            return;
        }
        Tcl_Preserve((ClientData) consoleInterp);

	Tcl_Eval(consoleInterp, "tkConsoleExit");

        Tcl_Release((ClientData) consoleInterp);
    }
}

/*
 *----------------------------------------------------------------------
 *







>


>
>
>
|












>
|
>







576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
static void
ConsoleEventProc(clientData, eventPtr)
    ClientData clientData;
    XEvent *eventPtr;
{
    ConsoleInfo *info = (ConsoleInfo *) clientData;
    Tcl_Interp *consoleInterp;
    Tcl_DString dString;
    
    if (eventPtr->type == DestroyNotify) {

	Tcl_DStringInit(&dString);
  
	consoleInterp = info->consoleInterp;

        /*
         * It is possible that the console interpreter itself has
         * already been deleted. In that case the consoleInterp
         * field will be set to NULL. If the interpreter is already
         * gone, we do not have to do any work here.
         */
        
        if (consoleInterp == (Tcl_Interp *) NULL) {
            return;
        }
        Tcl_Preserve((ClientData) consoleInterp);
	Tcl_DStringAppend(&dString, "tkConsoleExit", -1);
	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
	Tcl_DStringFree(&dString);
        Tcl_Release((ClientData) consoleInterp);
    }
}

/*
 *----------------------------------------------------------------------
 *

Changes to generic/tkCursor.c.

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
/* 
 * tkCursor.c --
 *
 *	This file maintains a database of read-only cursors for the Tk
 *	toolkit.  This allows cursors to be shared between widgets and
 *	also avoids round-trips to the X server.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkCursor.c 1.27 96/02/15 18:52:40
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * A TkCursor structure exists for each cursor that is currently
 * active.  Each structure is indexed with two hash tables defined
 * below.  One of the tables is idTable, and the other is either
 * nameTable or dataTable, also defined below.
 */

/*
 * Hash table to map from a textual description of a cursor to the
 * TkCursor record for the cursor, and key structure used in that
 * hash table:
 */

static Tcl_HashTable nameTable;
typedef struct {
    Tk_Uid name;		/* Textual name for desired cursor. */
    Display *display;		/* Display for which cursor will be used. */
} NameKey;

/*
 * Hash table to map from a collection of in-core data about a
 * cursor (bitmap contents, etc.) to a TkCursor structure:
 */

static Tcl_HashTable dataTable;
typedef struct {
    char *source;		/* Cursor bits. */
    char *mask;			/* Mask bits. */
    int width, height;		/* Dimensions of cursor (and data
				 * and mask). */
    int xHot, yHot;		/* Location of cursor hot-spot. */
    Tk_Uid fg, bg;		/* Colors for cursor. */
    Display *display;		/* Display on which cursor will be used. */
} DataKey;

/*
 * Hash table that maps from <display + cursor id> to the TkCursor structure
 * for the cursor.  This table is used by Tk_FreeCursor.
 */

static Tcl_HashTable idTable;
typedef struct {
    Display *display;		/* Display for which cursor was allocated. */
    Tk_Cursor cursor;		/* Cursor identifier. */
} IdKey;

static int initialized = 0;	/* 0 means static structures haven't been
				 * initialized yet. */

/*
 * Forward declarations for procedures defined in this file:
 */

static void		CursorInit _ANSI_ARGS_((void));
























































































































/*
 *----------------------------------------------------------------------
 *
 * Tk_GetCursor --
 *
 *	Given a string describing a cursor, locate (or create if necessary)
 *	a cursor that fits the description.
 *
 * Results:
 *	The return value is the X identifer for the desired cursor,
 *	unless string couldn't be parsed correctly.  In this case,
 *	None is returned and an error message is left in interp->result.
 *	The caller should never modify the cursor that is returned, and
 *	should eventually call Tk_FreeCursor when the cursor is no longer
 *	needed.
 *
 * Side effects:
 *	The cursor is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call
 *	to Tk_FreeCursor, so that the database can be cleaned up when cursors
 *	aren't needed anymore.
 *
 *----------------------------------------------------------------------
 */

Tk_Cursor
Tk_GetCursor(interp, tkwin, string)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
    Tk_Window tkwin;		/* Window in which cursor will be used. */
    Tk_Uid string;		/* Description of cursor.  See manual entry
				 * for details on legal syntax. */
{






    NameKey nameKey;


























    IdKey idKey;







    Tcl_HashEntry *nameHashPtr, *idHashPtr;
    register TkCursor *cursorPtr;

    int new;


    if (!initialized) {
	CursorInit();
    }

    nameKey.name = string;
    nameKey.display = Tk_Display(tkwin);
    nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &nameKey, &new);

    if (!new) {
	cursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr);



	cursorPtr->refCount++;
	return cursorPtr->cursor;




    }

    cursorPtr = TkGetCursorByName(interp, tkwin, string);

    if (cursorPtr == NULL) {

	Tcl_DeleteHashEntry(nameHashPtr);

	return None;
    }

    /*
     * Add information about this cursor to our database.
     */


    cursorPtr->refCount = 1;

    cursorPtr->otherTable = &nameTable;
    cursorPtr->hashPtr = nameHashPtr;
    idKey.display = nameKey.display;
    idKey.cursor = cursorPtr->cursor;
    idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, &new);

    if (!new) {
	panic("cursor already registered in Tk_GetCursor");
    }

    Tcl_SetHashValue(nameHashPtr, cursorPtr);
    Tcl_SetHashValue(idHashPtr, cursorPtr);

    return cursorPtr->cursor;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetCursorFromData --
 *
 *	Given a description of the bits and colors for a cursor,
 *	make a cursor that has the given properties.
 *
 * Results:
 *	The return value is the X identifer for the desired cursor,
 *	unless it couldn't be created properly.  In this case, None is
 *	returned and an error message is left in interp->result.  The
 *	caller should never modify the cursor that is returned, and
 *	should eventually call Tk_FreeCursor when the cursor is no
 *	longer needed.
 *
 * Side effects:
 *	The cursor is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call








|




|








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


<










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




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












|

















|


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

>

>

|
|


<
<
|
>

|
>
>
>
|
|
>
>
>
>





>
|
>
|






>
|
>
|

<
<
|
>



>

|

|













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23


24





25









26
27

28
29
30
31
32
33
34
35
36
37














38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245


246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278


279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
/* 
 * tkCursor.c --
 *
 *	This file maintains a database of read-only cursors for the Tk
 *	toolkit.  This allows cursors to be shared between widgets and
 *	also avoids round-trips to the X server.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkCursor.c,v 1.1.4.5 1999/03/20 01:27:51 redman Exp $
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * A TkCursor structure exists for each cursor that is currently
 * active.  Each structure is indexed with two hash tables defined
 * below.  One of the tables is cursorIdTable, and the other is either


 * cursorNameTable or cursorDataTable, each of which are stored in the





 * TkDisplay structure for the current thread.









 */


typedef struct {
    char *source;		/* Cursor bits. */
    char *mask;			/* Mask bits. */
    int width, height;		/* Dimensions of cursor (and data
				 * and mask). */
    int xHot, yHot;		/* Location of cursor hot-spot. */
    Tk_Uid fg, bg;		/* Colors for cursor. */
    Display *display;		/* Display on which cursor will be used. */
} DataKey;















/*
 * Forward declarations for procedures defined in this file:
 */

static void		CursorInit _ANSI_ARGS_((TkDisplay *dispPtr));
static void		DupCursorObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
			    Tcl_Obj *dupObjPtr));
static void		FreeCursor _ANSI_ARGS_((TkCursor *cursorPtr));
static void		FreeCursorObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
static TkCursor *	GetCursor _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *name));
static TkCursor *	GetCursorFromObj _ANSI_ARGS_((Tk_Window tkwin,
			    Tcl_Obj *objPtr));
static void		InitCursorObj _ANSI_ARGS_((Tcl_Obj *objPtr));

/*
 * The following structure defines the implementation of the "cursor" Tcl
 * object, used for drawing. The color object remembers the hash table
 * entry associated with a color. The actual allocation and deallocation
 * of the color should be done by the configuration package when the cursor
 * option is set.
 */

static Tcl_ObjType cursorObjType = {
    "cursor",			/* name */
    FreeCursorObjProc,		/* freeIntRepProc */
    DupCursorObjProc,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL			/* setFromAnyProc */
};

/*
 *----------------------------------------------------------------------
 *
 * Tk_AllocCursorFromObj --
 *
 *	Given a Tcl_Obj *, map the value to a corresponding
 *	Tk_Cursor structure based on the tkwin given.
 *
 * Results:
 *	The return value is the X identifer for the desired cursor,
 *	unless objPtr couldn't be parsed correctly.  In this case,
 *	None is returned and an error message is left in the interp's result.
 *	The caller should never modify the cursor that is returned, and
 *	should eventually call Tk_FreeCursorFromObj when the cursor is no 
 *	longer needed.
 *
 * Side effects:
 *	The cursor is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call
 *	to Tk_FreeCursorFromObj, so that the database can be cleaned up 
 *	when cursors aren't needed anymore.
 *
 *----------------------------------------------------------------------
 */

Tk_Cursor
Tk_AllocCursorFromObj(interp, tkwin, objPtr)
    Tcl_Interp *interp;		/* Interp for error results. */
    Tk_Window tkwin;		/* Window in which the cursor will be used.*/
    Tcl_Obj *objPtr;		/* Object describing cursor; see manual
				 * entry for description of legal
				 * syntax of this obj's string rep. */
{
    TkCursor *cursorPtr;

    if (objPtr->typePtr != &cursorObjType) {
	InitCursorObj(objPtr);
    }
    cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;

    /*
     * If the object currently points to a TkCursor, see if it's the
     * one we want.  If so, increment its reference count and return.
     */

    if (cursorPtr != NULL) {
	if (cursorPtr->resourceRefCount == 0) {
	    /*
	     * This is a stale reference: it refers to a TkCursor that's
	     * no longer in use.  Clear the reference.
	     */
	    FreeCursorObjProc(objPtr);
	    cursorPtr = NULL;
	} else if (Tk_Display(tkwin) == cursorPtr->display) {
	    cursorPtr->resourceRefCount++;
	    return cursorPtr->cursor;
	}
    }

    /*
     * The object didn't point to the TkCursor that we wanted.  Search
     * the list of TkCursors with the same name to see if one of the
     * other TkCursors is the right one.
     */

    if (cursorPtr != NULL) {
	TkCursor *firstCursorPtr =
		(TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr);
	FreeCursorObjProc(objPtr);
	for (cursorPtr = firstCursorPtr;  cursorPtr != NULL;
		cursorPtr = cursorPtr->nextPtr) {
	    if (Tk_Display(tkwin) == cursorPtr->display) {
		cursorPtr->resourceRefCount++;
		cursorPtr->objRefCount++;
		objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
		return cursorPtr->cursor;
	    }
	}
    }

    /*
     * Still no luck.  Call GetCursor to allocate a new TkCursor object.
     */

    cursorPtr = GetCursor(interp, tkwin, Tcl_GetString(objPtr));
    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
    if (cursorPtr == NULL) {
	return None;
    } else {
	cursorPtr->objRefCount++;
	return cursorPtr->cursor;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetCursor --
 *
 *	Given a string describing a cursor, locate (or create if necessary)
 *	a cursor that fits the description.
 *
 * Results:
 *	The return value is the X identifer for the desired cursor,
 *	unless string couldn't be parsed correctly.  In this case,
 *	None is returned and an error message is left in the interp's result.
 *	The caller should never modify the cursor that is returned, and
 *	should eventually call Tk_FreeCursor when the cursor is no longer
 *	needed.
 *
 * Side effects:
 *	The cursor is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call
 *	to Tk_FreeCursor, so that the database can be cleaned up when cursors
 *	aren't needed anymore.
 *
 *----------------------------------------------------------------------
 */

Tk_Cursor
Tk_GetCursor(interp, tkwin, string)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
    Tk_Window tkwin;		/* Window in which cursor will be used. */
    char *string;		/* Description of cursor.  See manual entry
				 * for details on legal syntax. */
{
    TkCursor *cursorPtr = GetCursor(interp, tkwin, string);
    if (cursorPtr == NULL) {
	return None;
    }
    return cursorPtr->cursor;
}

/*
 *----------------------------------------------------------------------
 *
 * GetCursor --
 *
 *	Given a string describing a cursor, locate (or create if necessary)
 *	a cursor that fits the description. This routine returns the
 *	internal data structure for the cursor, which avoids extra
 *	hash table lookups in Tk_AllocCursorFromObj.
 *
 * Results:
 *	The return value is a pointer to the TkCursor for the desired
 *	cursor, unless string couldn't be parsed correctly.  In this
 *	case, NULL is returned and an error message is left in the
 *	interp's result. The caller should never modify the cursor that
 *	is returned, and should eventually call Tk_FreeCursor when the
 *	cursor is no longer needed.
 *
 * Side effects:
 *	The cursor is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call
 *	to Tk_FreeCursor, so that the database can be cleaned up when cursors
 *	aren't needed anymore.
 *
 *----------------------------------------------------------------------
 */

static TkCursor *
GetCursor(interp, tkwin, string)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
    Tk_Window tkwin;		/* Window in which cursor will be used. */
    char *string;		/* Description of cursor.  See manual entry
				 * for details on legal syntax. */
{
    Tcl_HashEntry *nameHashPtr;
    register TkCursor *cursorPtr;
    TkCursor *existingCursorPtr = NULL;
    int new;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    if (!dispPtr->cursorInit) {
	CursorInit(dispPtr);
    }



    nameHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorNameTable, 
            string, &new);
    if (!new) {
	existingCursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr);
	for (cursorPtr = existingCursorPtr; cursorPtr != NULL;
		cursorPtr = cursorPtr->nextPtr) {
	    if (Tk_Display(tkwin) == cursorPtr->display) {
		cursorPtr->resourceRefCount++;
		return cursorPtr;
	    }
	}
    } else {
	existingCursorPtr = NULL;
    }

    cursorPtr = TkGetCursorByName(interp, tkwin, string);

    if (cursorPtr == NULL) {
	if (new) {
	    Tcl_DeleteHashEntry(nameHashPtr);
	}
	return NULL;
    }

    /*
     * Add information about this cursor to our database.
     */

    cursorPtr->display = Tk_Display(tkwin);
    cursorPtr->resourceRefCount = 1;
    cursorPtr->objRefCount = 0;
    cursorPtr->otherTable = &dispPtr->cursorNameTable;
    cursorPtr->hashPtr = nameHashPtr;


    cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable, 
            (char *) cursorPtr->cursor, &new);
    if (!new) {
	panic("cursor already registered in Tk_GetCursor");
    }
    cursorPtr->nextPtr = existingCursorPtr;
    Tcl_SetHashValue(nameHashPtr, cursorPtr);
    Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);

    return cursorPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetCursorFromData --
 *
 *	Given a description of the bits and colors for a cursor,
 *	make a cursor that has the given properties.
 *
 * Results:
 *	The return value is the X identifer for the desired cursor,
 *	unless it couldn't be created properly.  In this case, None is
 *	returned and an error message is left in the interp's result.  The
 *	caller should never modify the cursor that is returned, and
 *	should eventually call Tk_FreeCursor when the cursor is no
 *	longer needed.
 *
 * Side effects:
 *	The cursor is added to an internal database with a reference count.
 *	For each call to this procedure, there should eventually be a call
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
    char *mask;			/* Bitmap data for cursor mask. */
    int width, height;		/* Dimensions of cursor. */
    int xHot, yHot;		/* Location of hot-spot in cursor. */
    Tk_Uid fg;			/* Foreground color for cursor. */
    Tk_Uid bg;			/* Background color for cursor. */
{
    DataKey dataKey;
    IdKey idKey;
    Tcl_HashEntry *dataHashPtr, *idHashPtr;
    register TkCursor *cursorPtr;
    int new;
    XColor fgColor, bgColor;


    if (!initialized) {

	CursorInit();
    }

    dataKey.source = source;
    dataKey.mask = mask;
    dataKey.width = width;
    dataKey.height = height;
    dataKey.xHot = xHot;
    dataKey.yHot = yHot;
    dataKey.fg = fg;
    dataKey.bg = bg;
    dataKey.display = Tk_Display(tkwin);
    dataHashPtr = Tcl_CreateHashEntry(&dataTable, (char *) &dataKey, &new);

    if (!new) {
	cursorPtr = (TkCursor *) Tcl_GetHashValue(dataHashPtr);
	cursorPtr->refCount++;
	return cursorPtr->cursor;
    }

    /*
     * No suitable cursor exists yet.  Make one using the data
     * available and add it to the database.
     */







<
|



>

|
>
|











|
>


|







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
    char *mask;			/* Bitmap data for cursor mask. */
    int width, height;		/* Dimensions of cursor. */
    int xHot, yHot;		/* Location of hot-spot in cursor. */
    Tk_Uid fg;			/* Foreground color for cursor. */
    Tk_Uid bg;			/* Background color for cursor. */
{
    DataKey dataKey;

    Tcl_HashEntry *dataHashPtr;
    register TkCursor *cursorPtr;
    int new;
    XColor fgColor, bgColor;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;


    if (!dispPtr->cursorInit) {
	CursorInit(dispPtr);
    }

    dataKey.source = source;
    dataKey.mask = mask;
    dataKey.width = width;
    dataKey.height = height;
    dataKey.xHot = xHot;
    dataKey.yHot = yHot;
    dataKey.fg = fg;
    dataKey.bg = bg;
    dataKey.display = Tk_Display(tkwin);
    dataHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorDataTable, 
            (char *) &dataKey, &new);
    if (!new) {
	cursorPtr = (TkCursor *) Tcl_GetHashValue(dataHashPtr);
	cursorPtr->resourceRefCount++;
	return cursorPtr->cursor;
    }

    /*
     * No suitable cursor exists yet.  Make one using the data
     * available and add it to the database.
     */
232
233
234
235
236
237
238
239
240
241
242

243
244
245
246
247
248
249
250
251
252
253
254
255
256
    cursorPtr = TkCreateCursorFromData(tkwin, source, mask, width, height,
	    xHot, yHot, fgColor, bgColor);

    if (cursorPtr == NULL) {
	goto error;
    }

    cursorPtr->refCount = 1;
    cursorPtr->otherTable = &dataTable;
    cursorPtr->hashPtr = dataHashPtr;
    idKey.display = dataKey.display;

    idKey.cursor = cursorPtr->cursor;
    idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, &new);
    if (!new) {
	panic("cursor already registered in Tk_GetCursorFromData");
    }
    Tcl_SetHashValue(dataHashPtr, cursorPtr);
    Tcl_SetHashValue(idHashPtr, cursorPtr);
    return cursorPtr->cursor;

    error:
    Tcl_DeleteHashEntry(dataHashPtr);
    return None;
}








|
|

|
>
|
|




|







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
    cursorPtr = TkCreateCursorFromData(tkwin, source, mask, width, height,
	    xHot, yHot, fgColor, bgColor);

    if (cursorPtr == NULL) {
	goto error;
    }

    cursorPtr->resourceRefCount = 1;
    cursorPtr->otherTable = &dispPtr->cursorDataTable;
    cursorPtr->hashPtr = dataHashPtr;
    cursorPtr->objRefCount = 0;
    cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable, 
            (char *) cursorPtr->cursor, &new);

    if (!new) {
	panic("cursor already registered in Tk_GetCursorFromData");
    }
    Tcl_SetHashValue(dataHashPtr, cursorPtr);
    Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);
    return cursorPtr->cursor;

    error:
    Tcl_DeleteHashEntry(dataHashPtr);
    return None;
}

277
278
279
280
281
282
283
284
285
286

287

288
289
290

291
292
293
294
295
296
297
298
299
300
301
302
303
304


















































305
306
307
308
309
310
311

char *
Tk_NameOfCursor(display, cursor)
    Display *display;		/* Display for which cursor was allocated. */
    Tk_Cursor cursor;		/* Identifier for cursor whose name is
				 * wanted. */
{
    IdKey idKey;
    Tcl_HashEntry *idHashPtr;
    TkCursor *cursorPtr;

    static char string[20];


    if (!initialized) {
	printid:

	sprintf(string, "cursor id 0x%x", (unsigned int) cursor);
	return string;
    }
    idKey.display = display;
    idKey.cursor = cursor;
    idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
    if (idHashPtr == NULL) {
	goto printid;
    }
    cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);
    if (cursorPtr->otherTable != &nameTable) {
	goto printid;
    }
    return ((NameKey *) cursorPtr->hashPtr->key.words)->name;


















































}

/*
 *----------------------------------------------------------------------
 *
 * Tk_FreeCursor --
 *







<


>
|
>

|

>
|
|

<
<
|




|


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







419
420
421
422
423
424
425

426
427
428
429
430
431
432
433
434
435
436
437


438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503

char *
Tk_NameOfCursor(display, cursor)
    Display *display;		/* Display for which cursor was allocated. */
    Tk_Cursor cursor;		/* Identifier for cursor whose name is
				 * wanted. */
{

    Tcl_HashEntry *idHashPtr;
    TkCursor *cursorPtr;
    TkDisplay *dispPtr;

    dispPtr = TkGetDisplay(display);

    if (!dispPtr->cursorInit) {
	printid:
	sprintf(dispPtr->cursorString, "cursor id 0x%x", 
                (unsigned int) cursor);
	return dispPtr->cursorString;
    }


    idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor);
    if (idHashPtr == NULL) {
	goto printid;
    }
    cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);
    if (cursorPtr->otherTable != &dispPtr->cursorNameTable) {
	goto printid;
    }
    return cursorPtr->hashPtr->key.string;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeCursor --
 *
 *	This procedure is invoked by both Tk_FreeCursor and
 *	Tk_FreeCursorFromObj; it does all the real work of deallocating
 *	a cursor.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The reference count associated with cursor is decremented, and
 *	it is officially deallocated if no-one is using it anymore.
 *
 *----------------------------------------------------------------------
 */

static void
FreeCursor(cursorPtr)
    TkCursor *cursorPtr;	/* Cursor to be released. */
{
    TkCursor *prevPtr;

    cursorPtr->resourceRefCount--;
    if (cursorPtr->resourceRefCount > 0) {
	return;
    }

    Tcl_DeleteHashEntry(cursorPtr->idHashPtr);
    prevPtr = (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr);
    if (prevPtr == cursorPtr) {
	if (cursorPtr->nextPtr == NULL) {
	    Tcl_DeleteHashEntry(cursorPtr->hashPtr);
	} else {
	    Tcl_SetHashValue(cursorPtr->hashPtr, cursorPtr->nextPtr);
	}
    } else {
	while (prevPtr->nextPtr != cursorPtr) {
	    prevPtr = prevPtr->nextPtr;
	}
	prevPtr->nextPtr = cursorPtr->nextPtr;
    }
    TkpFreeCursor(cursorPtr);
    if (cursorPtr->objRefCount == 0) {
	ckfree((char *) cursorPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_FreeCursor --
 *
323
324
325
326
327
328
329
330
331
332

333
334
335
336
337
338
339
340
341
342
343
344



























































345




































346








































































347







348










349











































350


351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370

371
372
373
374
375
376
377
378
379
380
381


382
383





384





















































 */

void
Tk_FreeCursor(display, cursor)
    Display *display;		/* Display for which cursor was allocated. */
    Tk_Cursor cursor;		/* Identifier for cursor to be released. */
{
    IdKey idKey;
    Tcl_HashEntry *idHashPtr;
    register TkCursor *cursorPtr;


    if (!initialized) {
	panic("Tk_FreeCursor called before Tk_GetCursor");
    }

    idKey.display = display;
    idKey.cursor = cursor;
    idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
    if (idHashPtr == NULL) {
	panic("Tk_FreeCursor received unknown cursor argument");
    }
    cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);



























































    cursorPtr->refCount--;




































    if (cursorPtr->refCount == 0) {








































































	Tcl_DeleteHashEntry(cursorPtr->hashPtr);







	Tcl_DeleteHashEntry(idHashPtr);










	TkFreeCursor(cursorPtr);











































    }


}

/*
 *----------------------------------------------------------------------
 *
 * CursorInit --
 *
 *	Initialize the structures used for cursor management.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Read the code.
 *
 *----------------------------------------------------------------------
 */

static void
CursorInit()

{
    initialized = 1;
    Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(int));
    Tcl_InitHashTable(&dataTable, sizeof(DataKey)/sizeof(int));

    /*
     * The call below is tricky:  can't use sizeof(IdKey) because it
     * gets padded with extra unpredictable bytes on some 64-bit
     * machines.
     */



    Tcl_InitHashTable(&idTable, (sizeof(Display *) + sizeof(Tk_Cursor))
	    /sizeof(int));





}




























































<

<
>

|



<
<
|



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

>
>



















|
>

<
|
|







>
>
|
|
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
515
516
517
518
519
520
521

522

523
524
525
526
527
528


529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790

791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
 */

void
Tk_FreeCursor(display, cursor)
    Display *display;		/* Display for which cursor was allocated. */
    Tk_Cursor cursor;		/* Identifier for cursor to be released. */
{

    Tcl_HashEntry *idHashPtr;

    TkDisplay *dispPtr = TkGetDisplay(display);

    if (!dispPtr->cursorInit) {
	panic("Tk_FreeCursor called before Tk_GetCursor");
    }



    idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor);
    if (idHashPtr == NULL) {
	panic("Tk_FreeCursor received unknown cursor argument");
    }
    FreeCursor((TkCursor *) Tcl_GetHashValue(idHashPtr));
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_FreeCursorFromObj --
 *
 *	This procedure is called to release a cursor allocated by
 *	Tk_AllocCursorFromObj. It does not throw away the Tcl_Obj *;
 *	it only gets rid of the hash table entry for this cursor
 *	and clears the cached value that is normally stored in the object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The reference count associated with the cursor represented by
 *	objPtr is decremented, and the cursor is released to X if there are 
 *	no remaining uses for it.
 *
 *----------------------------------------------------------------------
 */

void
Tk_FreeCursorFromObj(tkwin, objPtr)
    Tk_Window tkwin;		/* The window this cursor lives in. Needed
				 * for the display value. */
    Tcl_Obj *objPtr;		/* The Tcl_Obj * to be freed. */
{
    FreeCursor(GetCursorFromObj(tkwin, objPtr));
}

/*
 *---------------------------------------------------------------------------
 *
 * FreeCursorFromObjProc -- 
 *
 *	This proc is called to release an object reference to a cursor.
 *	Called when the object's internal rep is released or when
 *	the cached tkColPtr needs to be changed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object reference count is decremented. When both it
 *	and the hash ref count go to zero, the color's resources
 *	are released.
 *
 *---------------------------------------------------------------------------
 */

static void
FreeCursorObjProc(objPtr)
    Tcl_Obj *objPtr;		/* The object we are releasing. */
{
    TkCursor *cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;

    if (cursorPtr != NULL) {
	cursorPtr->objRefCount--;
	if ((cursorPtr->objRefCount == 0) 
		&& (cursorPtr->resourceRefCount == 0)) {
	    ckfree((char *) cursorPtr);
	}
	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * DupCursorObjProc -- 
 *
 *	When a cached cursor object is duplicated, this is called to
 *	update the internal reps.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The color's objRefCount is incremented and the internal rep
 *	of the copy is set to point to it.
 *
 *---------------------------------------------------------------------------
 */

static void
DupCursorObjProc(srcObjPtr, dupObjPtr)
    Tcl_Obj *srcObjPtr;		/* The object we are copying from. */
    Tcl_Obj *dupObjPtr;		/* The object we are copying to. */
{
    TkCursor *cursorPtr = (TkCursor *) srcObjPtr->internalRep.twoPtrValue.ptr1;
    
    dupObjPtr->typePtr = srcObjPtr->typePtr;
    dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;

    if (cursorPtr != NULL) {
	cursorPtr->objRefCount++;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetCursorFromObj --
 *
 *	Returns the cursor referred to buy a Tcl object. The cursor must
 *	already have been allocated via a call to Tk_AllocCursorFromObj or 
 *	Tk_GetCursor.
 *
 * Results:
 *	Returns the Tk_Cursor that matches the tkwin and the string rep
 *	of the name of the cursor given in objPtr.
 *
 * Side effects:
 *	If the object is not already a cursor, the conversion will free
 *	any old internal representation. 
 *
 *----------------------------------------------------------------------
 */

Tk_Cursor
Tk_GetCursorFromObj(tkwin, objPtr)
    Tk_Window tkwin;
    Tcl_Obj *objPtr;		/* The object from which to get pixels. */
{
    TkCursor *cursorPtr = GetCursorFromObj(tkwin, objPtr);
    return cursorPtr->cursor;
}

/*
 *----------------------------------------------------------------------
 *
 * GetCursorFromObj --
 *
 *	Returns the cursor referred to by a Tcl object.  The cursor must
 *	already have been allocated via a call to Tk_AllocCursorFromObj
 *	or Tk_GetCursor.
 *
 * Results:
 *	Returns the TkCursor * that matches the tkwin and the string rep
 *	of the name of the cursor given in objPtr.
 *
 * Side effects:
 *	If the object is not already a cursor, the conversion will free
 *	any old internal representation. 
 *
 *----------------------------------------------------------------------
 */

static TkCursor *
GetCursorFromObj(tkwin, objPtr)
    Tk_Window tkwin;		/* Window in which the cursor will be used. */
    Tcl_Obj *objPtr;		/* The object that describes the desired
				 * cursor. */
{
    TkCursor *cursorPtr;
    Tcl_HashEntry *hashPtr;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    if (objPtr->typePtr != &cursorObjType) {
	InitCursorObj(objPtr);
    }

    cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;
    if (cursorPtr != NULL) {
	if (Tk_Display(tkwin) == cursorPtr->display) {
	    return cursorPtr;
	}
	hashPtr = cursorPtr->hashPtr;
    } else {
	hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable, 
                Tcl_GetString(objPtr));
	if (hashPtr == NULL) {
	    goto error;
	}
    }

    /*
     * At this point we've got a hash table entry, off of which hang
     * one or more TkCursor structures.  See if any of them will work.
     */

    for (cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr);
	    cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) {
	if (Tk_Display(tkwin) != cursorPtr->display) {
	    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
	    cursorPtr->objRefCount++;
	    return cursorPtr;
	}
    }

    error:
    panic("GetCursorFromObj called with non-existent cursor!");
    /*
     * The following code isn't reached; it's just there to please compilers.
     */
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * InitCursorObj --
 *
 *	Bookeeping procedure to change an objPtr to a cursor type.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The old internal rep of the object is freed. The internal
 *	rep is cleared. The final form of the object is set
 *	by either Tk_AllocCursorFromObj or GetCursorFromObj.
 *
 *----------------------------------------------------------------------
 */

static void
InitCursorObj(objPtr)
    Tcl_Obj *objPtr;		/* The object to convert. */
{
    Tcl_ObjType *typePtr;

    /*
     * Free the old internalRep before setting the new one. 
     */

    Tcl_GetString(objPtr);
    typePtr = objPtr->typePtr;
    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	(*typePtr->freeIntRepProc)(objPtr);
    }
    objPtr->typePtr = &cursorObjType;
    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * CursorInit --
 *
 *	Initialize the structures used for cursor management.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Read the code.
 *
 *----------------------------------------------------------------------
 */

static void
CursorInit(dispPtr)
    TkDisplay *dispPtr;   /* Display used to store thread-specific data. */
{

    Tcl_InitHashTable(&dispPtr->cursorNameTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&dispPtr->cursorDataTable, sizeof(DataKey)/sizeof(int));

    /*
     * The call below is tricky:  can't use sizeof(IdKey) because it
     * gets padded with extra unpredictable bytes on some 64-bit
     * machines.
     */

    /* 
     *  Old code....
     *     Tcl_InitHashTable(&dispPtr->cursorIdTable, sizeof(Display *) 
     *                       /sizeof(int));
     *
     * The comment above doesn't make sense.
     * However, XIDs should only be 32 bits, by the definition of X,
     * so the code above causes Tk to crash.  Here is the real code:
     */

    Tcl_InitHashTable(&dispPtr->cursorIdTable, TCL_ONE_WORD_KEYS);

    dispPtr->cursorInit = 1;
}

/*
 *----------------------------------------------------------------------
 *
 * TkDebugCursor --
 *
 *	This procedure returns debugging information about a cursor.
 *
 * Results:
 *	The return value is a list with one sublist for each TkCursor
 *	corresponding to "name".  Each sublist has two elements that
 *	contain the resourceRefCount and objRefCount fields from the
 *	TkCursor structure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TkDebugCursor(tkwin, name)
    Tk_Window tkwin;		/* The window in which the cursor will be
				 * used (not currently used). */
    char *name;			/* Name of the desired color. */
{
    TkCursor *cursorPtr;
    Tcl_HashEntry *hashPtr;
    Tcl_Obj *resultPtr, *objPtr;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    resultPtr = Tcl_NewObj();
    hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable, name);
    if (hashPtr != NULL) {
	cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr);
	if (cursorPtr == NULL) {
	    panic("TkDebugCursor found empty hash table entry");
	}
	for ( ; (cursorPtr != NULL); cursorPtr = cursorPtr->nextPtr) {
	    objPtr = Tcl_NewObj();
	    Tcl_ListObjAppendElement(NULL, objPtr,
		    Tcl_NewIntObj(cursorPtr->resourceRefCount));
	    Tcl_ListObjAppendElement(NULL, objPtr,
		    Tcl_NewIntObj(cursorPtr->objRefCount)); 
	    Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
	}
    }
    return resultPtr;
}

Added generic/tkDecls.h.























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
/*
 * tkDecls.h --
 *
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkDecls.h,v 1.2.2.3 1999/03/30 04:12:55 stanton Exp $
 */

#ifndef _TKDECLS
#define _TKDECLS

#ifdef BUILD_tk
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
 * script.  Any modifications to the function declarations below should be made
 * in the generic/tk.decls script.
 */

/* !BEGIN!: Do not edit below this line. */

/*
 * Exported function declarations:
 */

/* 0 */
EXTERN void		Tk_MainLoop _ANSI_ARGS_((void));
/* 1 */
EXTERN XColor *		Tk_3DBorderColor _ANSI_ARGS_((Tk_3DBorder border));
/* 2 */
EXTERN GC		Tk_3DBorderGC _ANSI_ARGS_((Tk_Window tkwin, 
				Tk_3DBorder border, int which));
/* 3 */
EXTERN void		Tk_3DHorizontalBevel _ANSI_ARGS_((Tk_Window tkwin, 
				Drawable drawable, Tk_3DBorder border, int x, 
				int y, int width, int height, int leftIn, 
				int rightIn, int topBevel, int relief));
/* 4 */
EXTERN void		Tk_3DVerticalBevel _ANSI_ARGS_((Tk_Window tkwin, 
				Drawable drawable, Tk_3DBorder border, int x, 
				int y, int width, int height, int leftBevel, 
				int relief));
/* 5 */
EXTERN void		Tk_AddOption _ANSI_ARGS_((Tk_Window tkwin, 
				char * name, char * value, int priority));
/* 6 */
EXTERN void		Tk_BindEvent _ANSI_ARGS_((
				Tk_BindingTable bindingTable, 
				XEvent * eventPtr, Tk_Window tkwin, 
				int numObjects, ClientData * objectPtr));
/* 7 */
EXTERN void		Tk_CanvasDrawableCoords _ANSI_ARGS_((
				Tk_Canvas canvas, double x, double y, 
				short * drawableXPtr, short * drawableYPtr));
/* 8 */
EXTERN void		Tk_CanvasEventuallyRedraw _ANSI_ARGS_((
				Tk_Canvas canvas, int x1, int y1, int x2, 
				int y2));
/* 9 */
EXTERN int		Tk_CanvasGetCoord _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Canvas canvas, char * str, 
				double * doublePtr));
/* 10 */
EXTERN Tk_CanvasTextInfo * Tk_CanvasGetTextInfo _ANSI_ARGS_((
				Tk_Canvas canvas));
/* 11 */
EXTERN int		Tk_CanvasPsBitmap _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Canvas canvas, Pixmap bitmap, int x, 
				int y, int width, int height));
/* 12 */
EXTERN int		Tk_CanvasPsColor _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Canvas canvas, XColor * colorPtr));
/* 13 */
EXTERN int		Tk_CanvasPsFont _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Canvas canvas, Tk_Font font));
/* 14 */
EXTERN void		Tk_CanvasPsPath _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Canvas canvas, double * coordPtr, 
				int numPoints));
/* 15 */
EXTERN int		Tk_CanvasPsStipple _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Canvas canvas, Pixmap bitmap));
/* 16 */
EXTERN double		Tk_CanvasPsY _ANSI_ARGS_((Tk_Canvas canvas, double y));
/* 17 */
EXTERN void		Tk_CanvasSetStippleOrigin _ANSI_ARGS_((
				Tk_Canvas canvas, GC gc));
/* 18 */
EXTERN int		Tk_CanvasTagsParseProc _ANSI_ARGS_((
				ClientData clientData, Tcl_Interp * interp, 
				Tk_Window tkwin, char * value, 
				char * widgRec, int offset));
/* 19 */
EXTERN char *		Tk_CanvasTagsPrintProc _ANSI_ARGS_((
				ClientData clientData, Tk_Window tkwin, 
				char * widgRec, int offset, 
				Tcl_FreeProc ** freeProcPtr));
/* 20 */
EXTERN Tk_Window	Tk_CanvasTkwin _ANSI_ARGS_((Tk_Canvas canvas));
/* 21 */
EXTERN void		Tk_CanvasWindowCoords _ANSI_ARGS_((Tk_Canvas canvas, 
				double x, double y, short * screenXPtr, 
				short * screenYPtr));
/* 22 */
EXTERN void		Tk_ChangeWindowAttributes _ANSI_ARGS_((
				Tk_Window tkwin, unsigned long valueMask, 
				XSetWindowAttributes * attsPtr));
/* 23 */
EXTERN int		Tk_CharBbox _ANSI_ARGS_((Tk_TextLayout layout, 
				int index, int * xPtr, int * yPtr, 
				int * widthPtr, int * heightPtr));
/* 24 */
EXTERN void		Tk_ClearSelection _ANSI_ARGS_((Tk_Window tkwin, 
				Atom selection));
/* 25 */
EXTERN int		Tk_ClipboardAppend _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, Atom target, Atom format, 
				char* buffer));
/* 26 */
EXTERN int		Tk_ClipboardClear _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin));
/* 27 */
EXTERN int		Tk_ConfigureInfo _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, Tk_ConfigSpec * specs, 
				char * widgRec, char * argvName, int flags));
/* 28 */
EXTERN int		Tk_ConfigureValue _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, Tk_ConfigSpec * specs, 
				char * widgRec, char * argvName, int flags));
/* 29 */
EXTERN int		Tk_ConfigureWidget _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, Tk_ConfigSpec * specs, 
				int argc, char ** argv, char * widgRec, 
				int flags));
/* 30 */
EXTERN void		Tk_ConfigureWindow _ANSI_ARGS_((Tk_Window tkwin, 
				unsigned int valueMask, 
				XWindowChanges * valuePtr));
/* 31 */
EXTERN Tk_TextLayout	Tk_ComputeTextLayout _ANSI_ARGS_((Tk_Font font, 
				CONST char * str, int numChars, 
				int wrapLength, Tk_Justify justify, 
				int flags, int * widthPtr, int * heightPtr));
/* 32 */
EXTERN Tk_Window	Tk_CoordsToWindow _ANSI_ARGS_((int rootX, int rootY, 
				Tk_Window tkwin));
/* 33 */
EXTERN unsigned long	Tk_CreateBinding _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_BindingTable bindingTable, 
				ClientData object, char * eventStr, 
				char * command, int append));
/* 34 */
EXTERN Tk_BindingTable	Tk_CreateBindingTable _ANSI_ARGS_((
				Tcl_Interp * interp));
/* 35 */
EXTERN Tk_ErrorHandler	Tk_CreateErrorHandler _ANSI_ARGS_((Display * display, 
				int errNum, int request, int minorCode, 
				Tk_ErrorProc * errorProc, 
				ClientData clientData));
/* 36 */
EXTERN void		Tk_CreateEventHandler _ANSI_ARGS_((Tk_Window token, 
				unsigned long mask, Tk_EventProc * proc, 
				ClientData clientData));
/* 37 */
EXTERN void		Tk_CreateGenericHandler _ANSI_ARGS_((
				Tk_GenericProc * proc, ClientData clientData));
/* 38 */
EXTERN void		Tk_CreateImageType _ANSI_ARGS_((
				Tk_ImageType * typePtr));
/* 39 */
EXTERN void		Tk_CreateItemType _ANSI_ARGS_((Tk_ItemType * typePtr));
/* 40 */
EXTERN void		Tk_CreatePhotoImageFormat _ANSI_ARGS_((
				Tk_PhotoImageFormat * formatPtr));
/* 41 */
EXTERN void		Tk_CreateSelHandler _ANSI_ARGS_((Tk_Window tkwin, 
				Atom selection, Atom target, 
				Tk_SelectionProc * proc, 
				ClientData clientData, Atom format));
/* 42 */
EXTERN Tk_Window	Tk_CreateWindow _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window parent, char * name, 
				char * screenName));
/* 43 */
EXTERN Tk_Window	Tk_CreateWindowFromPath _ANSI_ARGS_((
				Tcl_Interp * interp, Tk_Window tkwin, 
				char * pathName, char * screenName));
/* 44 */
EXTERN int		Tk_DefineBitmap _ANSI_ARGS_((Tcl_Interp * interp, 
				CONST char * name, char * source, int width, 
				int height));
/* 45 */
EXTERN void		Tk_DefineCursor _ANSI_ARGS_((Tk_Window window, 
				Tk_Cursor cursor));
/* 46 */
EXTERN void		Tk_DeleteAllBindings _ANSI_ARGS_((
				Tk_BindingTable bindingTable, 
				ClientData object));
/* 47 */
EXTERN int		Tk_DeleteBinding _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_BindingTable bindingTable, 
				ClientData object, char * eventStr));
/* 48 */
EXTERN void		Tk_DeleteBindingTable _ANSI_ARGS_((
				Tk_BindingTable bindingTable));
/* 49 */
EXTERN void		Tk_DeleteErrorHandler _ANSI_ARGS_((
				Tk_ErrorHandler handler));
/* 50 */
EXTERN void		Tk_DeleteEventHandler _ANSI_ARGS_((Tk_Window token, 
				unsigned long mask, Tk_EventProc * proc, 
				ClientData clientData));
/* 51 */
EXTERN void		Tk_DeleteGenericHandler _ANSI_ARGS_((
				Tk_GenericProc * proc, ClientData clientData));
/* 52 */
EXTERN void		Tk_DeleteImage _ANSI_ARGS_((Tcl_Interp * interp, 
				char * name));
/* 53 */
EXTERN void		Tk_DeleteSelHandler _ANSI_ARGS_((Tk_Window tkwin, 
				Atom selection, Atom target));
/* 54 */
EXTERN void		Tk_DestroyWindow _ANSI_ARGS_((Tk_Window tkwin));
/* 55 */
EXTERN char *		Tk_DisplayName _ANSI_ARGS_((Tk_Window tkwin));
/* 56 */
EXTERN int		Tk_DistanceToTextLayout _ANSI_ARGS_((
				Tk_TextLayout layout, int x, int y));
/* 57 */
EXTERN void		Tk_Draw3DPolygon _ANSI_ARGS_((Tk_Window tkwin, 
				Drawable drawable, Tk_3DBorder border, 
				XPoint * pointPtr, int numPoints, 
				int borderWidth, int leftRelief));
/* 58 */
EXTERN void		Tk_Draw3DRectangle _ANSI_ARGS_((Tk_Window tkwin, 
				Drawable drawable, Tk_3DBorder border, int x, 
				int y, int width, int height, 
				int borderWidth, int relief));
/* 59 */
EXTERN void		Tk_DrawChars _ANSI_ARGS_((Display * display, 
				Drawable drawable, GC gc, Tk_Font tkfont, 
				CONST char * source, int numBytes, int x, 
				int y));
/* 60 */
EXTERN void		Tk_DrawFocusHighlight _ANSI_ARGS_((Tk_Window tkwin, 
				GC gc, int width, Drawable drawable));
/* 61 */
EXTERN void		Tk_DrawTextLayout _ANSI_ARGS_((Display * display, 
				Drawable drawable, GC gc, 
				Tk_TextLayout layout, int x, int y, 
				int firstChar, int lastChar));
/* 62 */
EXTERN void		Tk_Fill3DPolygon _ANSI_ARGS_((Tk_Window tkwin, 
				Drawable drawable, Tk_3DBorder border, 
				XPoint * pointPtr, int numPoints, 
				int borderWidth, int leftRelief));
/* 63 */
EXTERN void		Tk_Fill3DRectangle _ANSI_ARGS_((Tk_Window tkwin, 
				Drawable drawable, Tk_3DBorder border, int x, 
				int y, int width, int height, 
				int borderWidth, int relief));
/* 64 */
EXTERN Tk_PhotoHandle	Tk_FindPhoto _ANSI_ARGS_((Tcl_Interp * interp, 
				char * imageName));
/* 65 */
EXTERN Font		Tk_FontId _ANSI_ARGS_((Tk_Font font));
/* 66 */
EXTERN void		Tk_Free3DBorder _ANSI_ARGS_((Tk_3DBorder border));
/* 67 */
EXTERN void		Tk_FreeBitmap _ANSI_ARGS_((Display * display, 
				Pixmap bitmap));
/* 68 */
EXTERN void		Tk_FreeColor _ANSI_ARGS_((XColor * colorPtr));
/* 69 */
EXTERN void		Tk_FreeColormap _ANSI_ARGS_((Display * display, 
				Colormap colormap));
/* 70 */
EXTERN void		Tk_FreeCursor _ANSI_ARGS_((Display * display, 
				Tk_Cursor cursor));
/* 71 */
EXTERN void		Tk_FreeFont _ANSI_ARGS_((Tk_Font f));
/* 72 */
EXTERN void		Tk_FreeGC _ANSI_ARGS_((Display * display, GC gc));
/* 73 */
EXTERN void		Tk_FreeImage _ANSI_ARGS_((Tk_Image image));
/* 74 */
EXTERN void		Tk_FreeOptions _ANSI_ARGS_((Tk_ConfigSpec * specs, 
				char * widgRec, Display * display, 
				int needFlags));
/* 75 */
EXTERN void		Tk_FreePixmap _ANSI_ARGS_((Display * display, 
				Pixmap pixmap));
/* 76 */
EXTERN void		Tk_FreeTextLayout _ANSI_ARGS_((
				Tk_TextLayout textLayout));
/* 77 */
EXTERN void		Tk_FreeXId _ANSI_ARGS_((Display * display, XID xid));
/* 78 */
EXTERN GC		Tk_GCForColor _ANSI_ARGS_((XColor * colorPtr, 
				Drawable drawable));
/* 79 */
EXTERN void		Tk_GeometryRequest _ANSI_ARGS_((Tk_Window tkwin, 
				int reqWidth, int reqHeight));
/* 80 */
EXTERN Tk_3DBorder	Tk_Get3DBorder _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, Tk_Uid colorName));
/* 81 */
EXTERN void		Tk_GetAllBindings _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_BindingTable bindingTable, 
				ClientData object));
/* 82 */
EXTERN int		Tk_GetAnchor _ANSI_ARGS_((Tcl_Interp * interp, 
				char * str, Tk_Anchor * anchorPtr));
/* 83 */
EXTERN char *		Tk_GetAtomName _ANSI_ARGS_((Tk_Window tkwin, 
				Atom atom));
/* 84 */
EXTERN char *		Tk_GetBinding _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_BindingTable bindingTable, 
				ClientData object, char * eventStr));
/* 85 */
EXTERN Pixmap		Tk_GetBitmap _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, CONST char * str));
/* 86 */
EXTERN Pixmap		Tk_GetBitmapFromData _ANSI_ARGS_((
				Tcl_Interp * interp, Tk_Window tkwin, 
				char * source, int width, int height));
/* 87 */
EXTERN int		Tk_GetCapStyle _ANSI_ARGS_((Tcl_Interp * interp, 
				char * str, int * capPtr));
/* 88 */
EXTERN XColor *		Tk_GetColor _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, Tk_Uid name));
/* 89 */
EXTERN XColor *		Tk_GetColorByValue _ANSI_ARGS_((Tk_Window tkwin, 
				XColor * colorPtr));
/* 90 */
EXTERN Colormap		Tk_GetColormap _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, char * str));
/* 91 */
EXTERN Tk_Cursor	Tk_GetCursor _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, Tk_Uid str));
/* 92 */
EXTERN Tk_Cursor	Tk_GetCursorFromData _ANSI_ARGS_((
				Tcl_Interp * interp, Tk_Window tkwin, 
				char * source, char * mask, int width, 
				int height, int xHot, int yHot, Tk_Uid fg, 
				Tk_Uid bg));
/* 93 */
EXTERN Tk_Font		Tk_GetFont _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, CONST char * str));
/* 94 */
EXTERN Tk_Font		Tk_GetFontFromObj _ANSI_ARGS_((Tk_Window tkwin, 
				Tcl_Obj * objPtr));
/* 95 */
EXTERN void		Tk_GetFontMetrics _ANSI_ARGS_((Tk_Font font, 
				Tk_FontMetrics * fmPtr));
/* 96 */
EXTERN GC		Tk_GetGC _ANSI_ARGS_((Tk_Window tkwin, 
				unsigned long valueMask, 
				XGCValues * valuePtr));
/* 97 */
EXTERN Tk_Image		Tk_GetImage _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, char * name, 
				Tk_ImageChangedProc * changeProc, 
				ClientData clientData));
/* 98 */
EXTERN ClientData	Tk_GetImageMasterData _ANSI_ARGS_((
				Tcl_Interp * interp, char * name, 
				Tk_ImageType ** typePtrPtr));
/* 99 */
EXTERN Tk_ItemType *	Tk_GetItemTypes _ANSI_ARGS_((void));
/* 100 */
EXTERN int		Tk_GetJoinStyle _ANSI_ARGS_((Tcl_Interp * interp, 
				char * str, int * joinPtr));
/* 101 */
EXTERN int		Tk_GetJustify _ANSI_ARGS_((Tcl_Interp * interp, 
				char * str, Tk_Justify * justifyPtr));
/* 102 */
EXTERN int		Tk_GetNumMainWindows _ANSI_ARGS_((void));
/* 103 */
EXTERN Tk_Uid		Tk_GetOption _ANSI_ARGS_((Tk_Window tkwin, 
				char * name, char * className));
/* 104 */
EXTERN int		Tk_GetPixels _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, char * str, int * intPtr));
/* 105 */
EXTERN Pixmap		Tk_GetPixmap _ANSI_ARGS_((Display * display, 
				Drawable d, int width, int height, int depth));
/* 106 */
EXTERN int		Tk_GetRelief _ANSI_ARGS_((Tcl_Interp * interp, 
				char * name, int * reliefPtr));
/* 107 */
EXTERN void		Tk_GetRootCoords _ANSI_ARGS_((Tk_Window tkwin, 
				int * xPtr, int * yPtr));
/* 108 */
EXTERN int		Tk_GetScrollInfo _ANSI_ARGS_((Tcl_Interp * interp, 
				int argc, char ** argv, double * dblPtr, 
				int * intPtr));
/* 109 */
EXTERN int		Tk_GetScreenMM _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, char * str, 
				double * doublePtr));
/* 110 */
EXTERN int		Tk_GetSelection _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, Atom selection, Atom target, 
				Tk_GetSelProc * proc, ClientData clientData));
/* 111 */
EXTERN Tk_Uid		Tk_GetUid _ANSI_ARGS_((CONST char * str));
/* 112 */
EXTERN Visual *		Tk_GetVisual _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, char * str, int * depthPtr, 
				Colormap * colormapPtr));
/* 113 */
EXTERN void		Tk_GetVRootGeometry _ANSI_ARGS_((Tk_Window tkwin, 
				int * xPtr, int * yPtr, int * widthPtr, 
				int * heightPtr));
/* 114 */
EXTERN int		Tk_Grab _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, int grabGlobal));
/* 115 */
EXTERN void		Tk_HandleEvent _ANSI_ARGS_((XEvent * eventPtr));
/* 116 */
EXTERN Tk_Window	Tk_IdToWindow _ANSI_ARGS_((Display * display, 
				Window window));
/* 117 */
EXTERN void		Tk_ImageChanged _ANSI_ARGS_((Tk_ImageMaster master, 
				int x, int y, int width, int height, 
				int imageWidth, int imageHeight));
/* 118 */
EXTERN int		Tk_Init _ANSI_ARGS_((Tcl_Interp * interp));
/* 119 */
EXTERN Atom		Tk_InternAtom _ANSI_ARGS_((Tk_Window tkwin, 
				char * name));
/* 120 */
EXTERN int		Tk_IntersectTextLayout _ANSI_ARGS_((
				Tk_TextLayout layout, int x, int y, 
				int width, int height));
/* 121 */
EXTERN void		Tk_MaintainGeometry _ANSI_ARGS_((Tk_Window slave, 
				Tk_Window master, int x, int y, int width, 
				int height));
/* 122 */
EXTERN Tk_Window	Tk_MainWindow _ANSI_ARGS_((Tcl_Interp * interp));
/* 123 */
EXTERN void		Tk_MakeWindowExist _ANSI_ARGS_((Tk_Window tkwin));
/* 124 */
EXTERN void		Tk_ManageGeometry _ANSI_ARGS_((Tk_Window tkwin, 
				Tk_GeomMgr * mgrPtr, ClientData clientData));
/* 125 */
EXTERN void		Tk_MapWindow _ANSI_ARGS_((Tk_Window tkwin));
/* 126 */
EXTERN int		Tk_MeasureChars _ANSI_ARGS_((Tk_Font tkfont, 
				CONST char * source, int numBytes, 
				int maxPixels, int flags, int * lengthPtr));
/* 127 */
EXTERN void		Tk_MoveResizeWindow _ANSI_ARGS_((Tk_Window tkwin, 
				int x, int y, int width, int height));
/* 128 */
EXTERN void		Tk_MoveWindow _ANSI_ARGS_((Tk_Window tkwin, int x, 
				int y));
/* 129 */
EXTERN void		Tk_MoveToplevelWindow _ANSI_ARGS_((Tk_Window tkwin, 
				int x, int y));
/* 130 */
EXTERN char *		Tk_NameOf3DBorder _ANSI_ARGS_((Tk_3DBorder border));
/* 131 */
EXTERN char *		Tk_NameOfAnchor _ANSI_ARGS_((Tk_Anchor anchor));
/* 132 */
EXTERN char *		Tk_NameOfBitmap _ANSI_ARGS_((Display * display, 
				Pixmap bitmap));
/* 133 */
EXTERN char *		Tk_NameOfCapStyle _ANSI_ARGS_((int cap));
/* 134 */
EXTERN char *		Tk_NameOfColor _ANSI_ARGS_((XColor * colorPtr));
/* 135 */
EXTERN char *		Tk_NameOfCursor _ANSI_ARGS_((Display * display, 
				Tk_Cursor cursor));
/* 136 */
EXTERN char *		Tk_NameOfFont _ANSI_ARGS_((Tk_Font font));
/* 137 */
EXTERN char *		Tk_NameOfImage _ANSI_ARGS_((
				Tk_ImageMaster imageMaster));
/* 138 */
EXTERN char *		Tk_NameOfJoinStyle _ANSI_ARGS_((int join));
/* 139 */
EXTERN char *		Tk_NameOfJustify _ANSI_ARGS_((Tk_Justify justify));
/* 140 */
EXTERN char *		Tk_NameOfRelief _ANSI_ARGS_((int relief));
/* 141 */
EXTERN Tk_Window	Tk_NameToWindow _ANSI_ARGS_((Tcl_Interp * interp, 
				char * pathName, Tk_Window tkwin));
/* 142 */
EXTERN void		Tk_OwnSelection _ANSI_ARGS_((Tk_Window tkwin, 
				Atom selection, Tk_LostSelProc * proc, 
				ClientData clientData));
/* 143 */
EXTERN int		Tk_ParseArgv _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, int * argcPtr, char ** argv, 
				Tk_ArgvInfo * argTable, int flags));
/* 144 */
EXTERN void		Tk_PhotoPutBlock _ANSI_ARGS_((Tk_PhotoHandle handle, 
				Tk_PhotoImageBlock * blockPtr, int x, int y, 
				int width, int height));
/* 145 */
EXTERN void		Tk_PhotoPutZoomedBlock _ANSI_ARGS_((
				Tk_PhotoHandle handle, 
				Tk_PhotoImageBlock * blockPtr, int x, int y, 
				int width, int height, int zoomX, int zoomY, 
				int subsampleX, int subsampleY));
/* 146 */
EXTERN int		Tk_PhotoGetImage _ANSI_ARGS_((Tk_PhotoHandle handle, 
				Tk_PhotoImageBlock * blockPtr));
/* 147 */
EXTERN void		Tk_PhotoBlank _ANSI_ARGS_((Tk_PhotoHandle handle));
/* 148 */
EXTERN void		Tk_PhotoExpand _ANSI_ARGS_((Tk_PhotoHandle handle, 
				int width, int height));
/* 149 */
EXTERN void		Tk_PhotoGetSize _ANSI_ARGS_((Tk_PhotoHandle handle, 
				int * widthPtr, int * heightPtr));
/* 150 */
EXTERN void		Tk_PhotoSetSize _ANSI_ARGS_((Tk_PhotoHandle handle, 
				int width, int height));
/* 151 */
EXTERN int		Tk_PointToChar _ANSI_ARGS_((Tk_TextLayout layout, 
				int x, int y));
/* 152 */
EXTERN int		Tk_PostscriptFontName _ANSI_ARGS_((Tk_Font tkfont, 
				Tcl_DString * dsPtr));
/* 153 */
EXTERN void		Tk_PreserveColormap _ANSI_ARGS_((Display * display, 
				Colormap colormap));
/* 154 */
EXTERN void		Tk_QueueWindowEvent _ANSI_ARGS_((XEvent * eventPtr, 
				Tcl_QueuePosition position));
/* 155 */
EXTERN void		Tk_RedrawImage _ANSI_ARGS_((Tk_Image image, 
				int imageX, int imageY, int width, 
				int height, Drawable drawable, int drawableX, 
				int drawableY));
/* 156 */
EXTERN void		Tk_ResizeWindow _ANSI_ARGS_((Tk_Window tkwin, 
				int width, int height));
/* 157 */
EXTERN int		Tk_RestackWindow _ANSI_ARGS_((Tk_Window tkwin, 
				int aboveBelow, Tk_Window other));
/* 158 */
EXTERN Tk_RestrictProc * Tk_RestrictEvents _ANSI_ARGS_((
				Tk_RestrictProc * proc, ClientData arg, 
				ClientData * prevArgPtr));
/* 159 */
EXTERN int		Tk_SafeInit _ANSI_ARGS_((Tcl_Interp * interp));
/* 160 */
EXTERN char *		Tk_SetAppName _ANSI_ARGS_((Tk_Window tkwin, 
				char * name));
/* 161 */
EXTERN void		Tk_SetBackgroundFromBorder _ANSI_ARGS_((
				Tk_Window tkwin, Tk_3DBorder border));
/* 162 */
EXTERN void		Tk_SetClass _ANSI_ARGS_((Tk_Window tkwin, 
				char * className));
/* 163 */
EXTERN void		Tk_SetGrid _ANSI_ARGS_((Tk_Window tkwin, 
				int reqWidth, int reqHeight, int gridWidth, 
				int gridHeight));
/* 164 */
EXTERN void		Tk_SetInternalBorder _ANSI_ARGS_((Tk_Window tkwin, 
				int width));
/* 165 */
EXTERN void		Tk_SetWindowBackground _ANSI_ARGS_((Tk_Window tkwin, 
				unsigned long pixel));
/* 166 */
EXTERN void		Tk_SetWindowBackgroundPixmap _ANSI_ARGS_((
				Tk_Window tkwin, Pixmap pixmap));
/* 167 */
EXTERN void		Tk_SetWindowBorder _ANSI_ARGS_((Tk_Window tkwin, 
				unsigned long pixel));
/* 168 */
EXTERN void		Tk_SetWindowBorderWidth _ANSI_ARGS_((Tk_Window tkwin, 
				int width));
/* 169 */
EXTERN void		Tk_SetWindowBorderPixmap _ANSI_ARGS_((
				Tk_Window tkwin, Pixmap pixmap));
/* 170 */
EXTERN void		Tk_SetWindowColormap _ANSI_ARGS_((Tk_Window tkwin, 
				Colormap colormap));
/* 171 */
EXTERN int		Tk_SetWindowVisual _ANSI_ARGS_((Tk_Window tkwin, 
				Visual * visual, int depth, 
				Colormap colormap));
/* 172 */
EXTERN void		Tk_SizeOfBitmap _ANSI_ARGS_((Display * display, 
				Pixmap bitmap, int * widthPtr, 
				int * heightPtr));
/* 173 */
EXTERN void		Tk_SizeOfImage _ANSI_ARGS_((Tk_Image image, 
				int * widthPtr, int * heightPtr));
/* 174 */
EXTERN int		Tk_StrictMotif _ANSI_ARGS_((Tk_Window tkwin));
/* 175 */
EXTERN void		Tk_TextLayoutToPostscript _ANSI_ARGS_((
				Tcl_Interp * interp, Tk_TextLayout layout));
/* 176 */
EXTERN int		Tk_TextWidth _ANSI_ARGS_((Tk_Font font, 
				CONST char * str, int numBytes));
/* 177 */
EXTERN void		Tk_UndefineCursor _ANSI_ARGS_((Tk_Window window));
/* 178 */
EXTERN void		Tk_UnderlineChars _ANSI_ARGS_((Display * display, 
				Drawable drawable, GC gc, Tk_Font tkfont, 
				CONST char * source, int x, int y, 
				int firstByte, int lastByte));
/* 179 */
EXTERN void		Tk_UnderlineTextLayout _ANSI_ARGS_((
				Display * display, Drawable drawable, GC gc, 
				Tk_TextLayout layout, int x, int y, 
				int underline));
/* 180 */
EXTERN void		Tk_Ungrab _ANSI_ARGS_((Tk_Window tkwin));
/* 181 */
EXTERN void		Tk_UnmaintainGeometry _ANSI_ARGS_((Tk_Window slave, 
				Tk_Window master));
/* 182 */
EXTERN void		Tk_UnmapWindow _ANSI_ARGS_((Tk_Window tkwin));
/* 183 */
EXTERN void		Tk_UnsetGrid _ANSI_ARGS_((Tk_Window tkwin));
/* 184 */
EXTERN void		Tk_UpdatePointer _ANSI_ARGS_((Tk_Window tkwin, int x, 
				int y, int state));
/* 185 */
EXTERN Pixmap		Tk_AllocBitmapFromObj _ANSI_ARGS_((
				Tcl_Interp * interp, Tk_Window tkwin, 
				Tcl_Obj * objPtr));
/* 186 */
EXTERN Tk_3DBorder	Tk_Alloc3DBorderFromObj _ANSI_ARGS_((
				Tcl_Interp * interp, Tk_Window tkwin, 
				Tcl_Obj * objPtr));
/* 187 */
EXTERN XColor *		Tk_AllocColorFromObj _ANSI_ARGS_((
				Tcl_Interp * interp, Tk_Window tkwin, 
				Tcl_Obj * objPtr));
/* 188 */
EXTERN Tk_Cursor	Tk_AllocCursorFromObj _ANSI_ARGS_((
				Tcl_Interp * interp, Tk_Window tkwin, 
				Tcl_Obj * objPtr));
/* 189 */
EXTERN Tk_Font		Tk_AllocFontFromObj _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, Tcl_Obj * objPtr));
/* 190 */
EXTERN Tk_OptionTable	Tk_CreateOptionTable _ANSI_ARGS_((
				Tcl_Interp * interp, 
				CONST Tk_OptionSpec * templatePtr));
/* 191 */
EXTERN void		Tk_DeleteOptionTable _ANSI_ARGS_((
				Tk_OptionTable optionTable));
/* 192 */
EXTERN void		Tk_Free3DBorderFromObj _ANSI_ARGS_((Tk_Window tkwin, 
				Tcl_Obj * objPtr));
/* 193 */
EXTERN void		Tk_FreeBitmapFromObj _ANSI_ARGS_((Tk_Window tkwin, 
				Tcl_Obj * objPtr));
/* 194 */
EXTERN void		Tk_FreeColorFromObj _ANSI_ARGS_((Tk_Window tkwin, 
				Tcl_Obj * objPtr));
/* 195 */
EXTERN void		Tk_FreeConfigOptions _ANSI_ARGS_((char * recordPtr, 
				Tk_OptionTable optionToken, Tk_Window tkwin));
/* 196 */
EXTERN void		Tk_FreeSavedOptions _ANSI_ARGS_((
				Tk_SavedOptions * savePtr));
/* 197 */
EXTERN void		Tk_FreeCursorFromObj _ANSI_ARGS_((Tk_Window tkwin, 
				Tcl_Obj * objPtr));
/* 198 */
EXTERN void		Tk_FreeFontFromObj _ANSI_ARGS_((Tk_Window tkwin, 
				Tcl_Obj * objPtr));
/* 199 */
EXTERN Tk_3DBorder	Tk_Get3DBorderFromObj _ANSI_ARGS_((Tk_Window tkwin, 
				Tcl_Obj * objPtr));
/* 200 */
EXTERN int		Tk_GetAnchorFromObj _ANSI_ARGS_((Tcl_Interp * interp, 
				Tcl_Obj * objPtr, Tk_Anchor * anchorPtr));
/* 201 */
EXTERN Pixmap		Tk_GetBitmapFromObj _ANSI_ARGS_((Tk_Window tkwin, 
				Tcl_Obj * objPtr));
/* 202 */
EXTERN XColor *		Tk_GetColorFromObj _ANSI_ARGS_((Tk_Window tkwin, 
				Tcl_Obj * objPtr));
/* 203 */
EXTERN Tk_Cursor	Tk_GetCursorFromObj _ANSI_ARGS_((Tk_Window tkwin, 
				Tcl_Obj * objPtr));
/* 204 */
EXTERN Tcl_Obj *	Tk_GetOptionInfo _ANSI_ARGS_((Tcl_Interp * interp, 
				char * recordPtr, Tk_OptionTable optionTable, 
				Tcl_Obj * namePtr, Tk_Window tkwin));
/* 205 */
EXTERN Tcl_Obj *	Tk_GetOptionValue _ANSI_ARGS_((Tcl_Interp * interp, 
				char * recordPtr, Tk_OptionTable optionTable, 
				Tcl_Obj * namePtr, Tk_Window tkwin));
/* 206 */
EXTERN int		Tk_GetJustifyFromObj _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Obj * objPtr, 
				Tk_Justify * justifyPtr));
/* 207 */
EXTERN int		Tk_GetMMFromObj _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, Tcl_Obj * objPtr, 
				double * doublePtr));
/* 208 */
EXTERN int		Tk_GetPixelsFromObj _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, Tcl_Obj * objPtr, 
				int * intPtr));
/* 209 */
EXTERN int		Tk_GetReliefFromObj _ANSI_ARGS_((Tcl_Interp * interp, 
				Tcl_Obj * objPtr, int * resultPtr));
/* 210 */
EXTERN int		Tk_GetScrollInfoObj _ANSI_ARGS_((Tcl_Interp * interp, 
				int objc, Tcl_Obj *CONST objv[], 
				double * dblPtr, int * intPtr));
/* 211 */
EXTERN int		Tk_InitOptions _ANSI_ARGS_((Tcl_Interp * interp, 
				char * recordPtr, Tk_OptionTable optionToken, 
				Tk_Window tkwin));
/* 212 */
EXTERN void		Tk_MainEx _ANSI_ARGS_((int argc, char ** argv, 
				Tcl_AppInitProc * appInitProc, 
				Tcl_Interp * interp));
/* 213 */
EXTERN void		Tk_RestoreSavedOptions _ANSI_ARGS_((
				Tk_SavedOptions * savePtr));
/* 214 */
EXTERN int		Tk_SetOptions _ANSI_ARGS_((Tcl_Interp * interp, 
				char * recordPtr, Tk_OptionTable optionTable, 
				int objc, Tcl_Obj *CONST objv[], 
				Tk_Window tkwin, Tk_SavedOptions * savePtr, 
				int * maskPtr));

typedef struct TkStubHooks {
    struct TkPlatStubs *tkPlatStubs;
    struct TkIntStubs *tkIntStubs;
    struct TkIntPlatStubs *tkIntPlatStubs;
    struct TkIntXlibStubs *tkIntXlibStubs;
} TkStubHooks;

typedef struct TkStubs {
    int magic;
    struct TkStubHooks *hooks;

    void (*tk_MainLoop) _ANSI_ARGS_((void)); /* 0 */
    XColor * (*tk_3DBorderColor) _ANSI_ARGS_((Tk_3DBorder border)); /* 1 */
    GC (*tk_3DBorderGC) _ANSI_ARGS_((Tk_Window tkwin, Tk_3DBorder border, int which)); /* 2 */
    void (*tk_3DHorizontalBevel) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int leftIn, int rightIn, int topBevel, int relief)); /* 3 */
    void (*tk_3DVerticalBevel) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int leftBevel, int relief)); /* 4 */
    void (*tk_AddOption) _ANSI_ARGS_((Tk_Window tkwin, char * name, char * value, int priority)); /* 5 */
    void (*tk_BindEvent) _ANSI_ARGS_((Tk_BindingTable bindingTable, XEvent * eventPtr, Tk_Window tkwin, int numObjects, ClientData * objectPtr)); /* 6 */
    void (*tk_CanvasDrawableCoords) _ANSI_ARGS_((Tk_Canvas canvas, double x, double y, short * drawableXPtr, short * drawableYPtr)); /* 7 */
    void (*tk_CanvasEventuallyRedraw) _ANSI_ARGS_((Tk_Canvas canvas, int x1, int y1, int x2, int y2)); /* 8 */
    int (*tk_CanvasGetCoord) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, char * str, double * doublePtr)); /* 9 */
    Tk_CanvasTextInfo * (*tk_CanvasGetTextInfo) _ANSI_ARGS_((Tk_Canvas canvas)); /* 10 */
    int (*tk_CanvasPsBitmap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, Pixmap bitmap, int x, int y, int width, int height)); /* 11 */
    int (*tk_CanvasPsColor) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, XColor * colorPtr)); /* 12 */
    int (*tk_CanvasPsFont) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, Tk_Font font)); /* 13 */
    void (*tk_CanvasPsPath) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, double * coordPtr, int numPoints)); /* 14 */
    int (*tk_CanvasPsStipple) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, Pixmap bitmap)); /* 15 */
    double (*tk_CanvasPsY) _ANSI_ARGS_((Tk_Canvas canvas, double y)); /* 16 */
    void (*tk_CanvasSetStippleOrigin) _ANSI_ARGS_((Tk_Canvas canvas, GC gc)); /* 17 */
    int (*tk_CanvasTagsParseProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, Tk_Window tkwin, char * value, char * widgRec, int offset)); /* 18 */
    char * (*tk_CanvasTagsPrintProc) _ANSI_ARGS_((ClientData clientData, Tk_Window tkwin, char * widgRec, int offset, Tcl_FreeProc ** freeProcPtr)); /* 19 */
    Tk_Window (*tk_CanvasTkwin) _ANSI_ARGS_((Tk_Canvas canvas)); /* 20 */
    void (*tk_CanvasWindowCoords) _ANSI_ARGS_((Tk_Canvas canvas, double x, double y, short * screenXPtr, short * screenYPtr)); /* 21 */
    void (*tk_ChangeWindowAttributes) _ANSI_ARGS_((Tk_Window tkwin, unsigned long valueMask, XSetWindowAttributes * attsPtr)); /* 22 */
    int (*tk_CharBbox) _ANSI_ARGS_((Tk_TextLayout layout, int index, int * xPtr, int * yPtr, int * widthPtr, int * heightPtr)); /* 23 */
    void (*tk_ClearSelection) _ANSI_ARGS_((Tk_Window tkwin, Atom selection)); /* 24 */
    int (*tk_ClipboardAppend) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Atom target, Atom format, char* buffer)); /* 25 */
    int (*tk_ClipboardClear) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin)); /* 26 */
    int (*tk_ConfigureInfo) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_ConfigSpec * specs, char * widgRec, char * argvName, int flags)); /* 27 */
    int (*tk_ConfigureValue) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_ConfigSpec * specs, char * widgRec, char * argvName, int flags)); /* 28 */
    int (*tk_ConfigureWidget) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_ConfigSpec * specs, int argc, char ** argv, char * widgRec, int flags)); /* 29 */
    void (*tk_ConfigureWindow) _ANSI_ARGS_((Tk_Window tkwin, unsigned int valueMask, XWindowChanges * valuePtr)); /* 30 */
    Tk_TextLayout (*tk_ComputeTextLayout) _ANSI_ARGS_((Tk_Font font, CONST char * str, int numChars, int wrapLength, Tk_Justify justify, int flags, int * widthPtr, int * heightPtr)); /* 31 */
    Tk_Window (*tk_CoordsToWindow) _ANSI_ARGS_((int rootX, int rootY, Tk_Window tkwin)); /* 32 */
    unsigned long (*tk_CreateBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventStr, char * command, int append)); /* 33 */
    Tk_BindingTable (*tk_CreateBindingTable) _ANSI_ARGS_((Tcl_Interp * interp)); /* 34 */
    Tk_ErrorHandler (*tk_CreateErrorHandler) _ANSI_ARGS_((Display * display, int errNum, int request, int minorCode, Tk_ErrorProc * errorProc, ClientData clientData)); /* 35 */
    void (*tk_CreateEventHandler) _ANSI_ARGS_((Tk_Window token, unsigned long mask, Tk_EventProc * proc, ClientData clientData)); /* 36 */
    void (*tk_CreateGenericHandler) _ANSI_ARGS_((Tk_GenericProc * proc, ClientData clientData)); /* 37 */
    void (*tk_CreateImageType) _ANSI_ARGS_((Tk_ImageType * typePtr)); /* 38 */
    void (*tk_CreateItemType) _ANSI_ARGS_((Tk_ItemType * typePtr)); /* 39 */
    void (*tk_CreatePhotoImageFormat) _ANSI_ARGS_((Tk_PhotoImageFormat * formatPtr)); /* 40 */
    void (*tk_CreateSelHandler) _ANSI_ARGS_((Tk_Window tkwin, Atom selection, Atom target, Tk_SelectionProc * proc, ClientData clientData, Atom format)); /* 41 */
    Tk_Window (*tk_CreateWindow) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window parent, char * name, char * screenName)); /* 42 */
    Tk_Window (*tk_CreateWindowFromPath) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * pathName, char * screenName)); /* 43 */
    int (*tk_DefineBitmap) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, char * source, int width, int height)); /* 44 */
    void (*tk_DefineCursor) _ANSI_ARGS_((Tk_Window window, Tk_Cursor cursor)); /* 45 */
    void (*tk_DeleteAllBindings) _ANSI_ARGS_((Tk_BindingTable bindingTable, ClientData object)); /* 46 */
    int (*tk_DeleteBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventStr)); /* 47 */
    void (*tk_DeleteBindingTable) _ANSI_ARGS_((Tk_BindingTable bindingTable)); /* 48 */
    void (*tk_DeleteErrorHandler) _ANSI_ARGS_((Tk_ErrorHandler handler)); /* 49 */
    void (*tk_DeleteEventHandler) _ANSI_ARGS_((Tk_Window token, unsigned long mask, Tk_EventProc * proc, ClientData clientData)); /* 50 */
    void (*tk_DeleteGenericHandler) _ANSI_ARGS_((Tk_GenericProc * proc, ClientData clientData)); /* 51 */
    void (*tk_DeleteImage) _ANSI_ARGS_((Tcl_Interp * interp, char * name)); /* 52 */
    void (*tk_DeleteSelHandler) _ANSI_ARGS_((Tk_Window tkwin, Atom selection, Atom target)); /* 53 */
    void (*tk_DestroyWindow) _ANSI_ARGS_((Tk_Window tkwin)); /* 54 */
    char * (*tk_DisplayName) _ANSI_ARGS_((Tk_Window tkwin)); /* 55 */
    int (*tk_DistanceToTextLayout) _ANSI_ARGS_((Tk_TextLayout layout, int x, int y)); /* 56 */
    void (*tk_Draw3DPolygon) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, XPoint * pointPtr, int numPoints, int borderWidth, int leftRelief)); /* 57 */
    void (*tk_Draw3DRectangle) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int borderWidth, int relief)); /* 58 */
    void (*tk_DrawChars) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_Font tkfont, CONST char * source, int numBytes, int x, int y)); /* 59 */
    void (*tk_DrawFocusHighlight) _ANSI_ARGS_((Tk_Window tkwin, GC gc, int width, Drawable drawable)); /* 60 */
    void (*tk_DrawTextLayout) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, int firstChar, int lastChar)); /* 61 */
    void (*tk_Fill3DPolygon) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, XPoint * pointPtr, int numPoints, int borderWidth, int leftRelief)); /* 62 */
    void (*tk_Fill3DRectangle) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int borderWidth, int relief)); /* 63 */
    Tk_PhotoHandle (*tk_FindPhoto) _ANSI_ARGS_((Tcl_Interp * interp, char * imageName)); /* 64 */
    Font (*tk_FontId) _ANSI_ARGS_((Tk_Font font)); /* 65 */
    void (*tk_Free3DBorder) _ANSI_ARGS_((Tk_3DBorder border)); /* 66 */
    void (*tk_FreeBitmap) _ANSI_ARGS_((Display * display, Pixmap bitmap)); /* 67 */
    void (*tk_FreeColor) _ANSI_ARGS_((XColor * colorPtr)); /* 68 */
    void (*tk_FreeColormap) _ANSI_ARGS_((Display * display, Colormap colormap)); /* 69 */
    void (*tk_FreeCursor) _ANSI_ARGS_((Display * display, Tk_Cursor cursor)); /* 70 */
    void (*tk_FreeFont) _ANSI_ARGS_((Tk_Font f)); /* 71 */
    void (*tk_FreeGC) _ANSI_ARGS_((Display * display, GC gc)); /* 72 */
    void (*tk_FreeImage) _ANSI_ARGS_((Tk_Image image)); /* 73 */
    void (*tk_FreeOptions) _ANSI_ARGS_((Tk_ConfigSpec * specs, char * widgRec, Display * display, int needFlags)); /* 74 */
    void (*tk_FreePixmap) _ANSI_ARGS_((Display * display, Pixmap pixmap)); /* 75 */
    void (*tk_FreeTextLayout) _ANSI_ARGS_((Tk_TextLayout textLayout)); /* 76 */
    void (*tk_FreeXId) _ANSI_ARGS_((Display * display, XID xid)); /* 77 */
    GC (*tk_GCForColor) _ANSI_ARGS_((XColor * colorPtr, Drawable drawable)); /* 78 */
    void (*tk_GeometryRequest) _ANSI_ARGS_((Tk_Window tkwin, int reqWidth, int reqHeight)); /* 79 */
    Tk_3DBorder (*tk_Get3DBorder) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid colorName)); /* 80 */
    void (*tk_GetAllBindings) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object)); /* 81 */
    int (*tk_GetAnchor) _ANSI_ARGS_((Tcl_Interp * interp, char * str, Tk_Anchor * anchorPtr)); /* 82 */
    char * (*tk_GetAtomName) _ANSI_ARGS_((Tk_Window tkwin, Atom atom)); /* 83 */
    char * (*tk_GetBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventStr)); /* 84 */
    Pixmap (*tk_GetBitmap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * str)); /* 85 */
    Pixmap (*tk_GetBitmapFromData) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * source, int width, int height)); /* 86 */
    int (*tk_GetCapStyle) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int * capPtr)); /* 87 */
    XColor * (*tk_GetColor) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid name)); /* 88 */
    XColor * (*tk_GetColorByValue) _ANSI_ARGS_((Tk_Window tkwin, XColor * colorPtr)); /* 89 */
    Colormap (*tk_GetColormap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * str)); /* 90 */
    Tk_Cursor (*tk_GetCursor) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid str)); /* 91 */
    Tk_Cursor (*tk_GetCursorFromData) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * source, char * mask, int width, int height, int xHot, int yHot, Tk_Uid fg, Tk_Uid bg)); /* 92 */
    Tk_Font (*tk_GetFont) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * str)); /* 93 */
    Tk_Font (*tk_GetFontFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 94 */
    void (*tk_GetFontMetrics) _ANSI_ARGS_((Tk_Font font, Tk_FontMetrics * fmPtr)); /* 95 */
    GC (*tk_GetGC) _ANSI_ARGS_((Tk_Window tkwin, unsigned long valueMask, XGCValues * valuePtr)); /* 96 */
    Tk_Image (*tk_GetImage) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * name, Tk_ImageChangedProc * changeProc, ClientData clientData)); /* 97 */
    ClientData (*tk_GetImageMasterData) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tk_ImageType ** typePtrPtr)); /* 98 */
    Tk_ItemType * (*tk_GetItemTypes) _ANSI_ARGS_((void)); /* 99 */
    int (*tk_GetJoinStyle) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int * joinPtr)); /* 100 */
    int (*tk_GetJustify) _ANSI_ARGS_((Tcl_Interp * interp, char * str, Tk_Justify * justifyPtr)); /* 101 */
    int (*tk_GetNumMainWindows) _ANSI_ARGS_((void)); /* 102 */
    Tk_Uid (*tk_GetOption) _ANSI_ARGS_((Tk_Window tkwin, char * name, char * className)); /* 103 */
    int (*tk_GetPixels) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * str, int * intPtr)); /* 104 */
    Pixmap (*tk_GetPixmap) _ANSI_ARGS_((Display * display, Drawable d, int width, int height, int depth)); /* 105 */
    int (*tk_GetRelief) _ANSI_ARGS_((Tcl_Interp * interp, char * name, int * reliefPtr)); /* 106 */
    void (*tk_GetRootCoords) _ANSI_ARGS_((Tk_Window tkwin, int * xPtr, int * yPtr)); /* 107 */
    int (*tk_GetScrollInfo) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, double * dblPtr, int * intPtr)); /* 108 */
    int (*tk_GetScreenMM) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * str, double * doublePtr)); /* 109 */
    int (*tk_GetSelection) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Atom selection, Atom target, Tk_GetSelProc * proc, ClientData clientData)); /* 110 */
    Tk_Uid (*tk_GetUid) _ANSI_ARGS_((CONST char * str)); /* 111 */
    Visual * (*tk_GetVisual) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * str, int * depthPtr, Colormap * colormapPtr)); /* 112 */
    void (*tk_GetVRootGeometry) _ANSI_ARGS_((Tk_Window tkwin, int * xPtr, int * yPtr, int * widthPtr, int * heightPtr)); /* 113 */
    int (*tk_Grab) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, int grabGlobal)); /* 114 */
    void (*tk_HandleEvent) _ANSI_ARGS_((XEvent * eventPtr)); /* 115 */
    Tk_Window (*tk_IdToWindow) _ANSI_ARGS_((Display * display, Window window)); /* 116 */
    void (*tk_ImageChanged) _ANSI_ARGS_((Tk_ImageMaster master, int x, int y, int width, int height, int imageWidth, int imageHeight)); /* 117 */
    int (*tk_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 118 */
    Atom (*tk_InternAtom) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 119 */
    int (*tk_IntersectTextLayout) _ANSI_ARGS_((Tk_TextLayout layout, int x, int y, int width, int height)); /* 120 */
    void (*tk_MaintainGeometry) _ANSI_ARGS_((Tk_Window slave, Tk_Window master, int x, int y, int width, int height)); /* 121 */
    Tk_Window (*tk_MainWindow) _ANSI_ARGS_((Tcl_Interp * interp)); /* 122 */
    void (*tk_MakeWindowExist) _ANSI_ARGS_((Tk_Window tkwin)); /* 123 */
    void (*tk_ManageGeometry) _ANSI_ARGS_((Tk_Window tkwin, Tk_GeomMgr * mgrPtr, ClientData clientData)); /* 124 */
    void (*tk_MapWindow) _ANSI_ARGS_((Tk_Window tkwin)); /* 125 */
    int (*tk_MeasureChars) _ANSI_ARGS_((Tk_Font tkfont, CONST char * source, int numBytes, int maxPixels, int flags, int * lengthPtr)); /* 126 */
    void (*tk_MoveResizeWindow) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int width, int height)); /* 127 */
    void (*tk_MoveWindow) _ANSI_ARGS_((Tk_Window tkwin, int x, int y)); /* 128 */
    void (*tk_MoveToplevelWindow) _ANSI_ARGS_((Tk_Window tkwin, int x, int y)); /* 129 */
    char * (*tk_NameOf3DBorder) _ANSI_ARGS_((Tk_3DBorder border)); /* 130 */
    char * (*tk_NameOfAnchor) _ANSI_ARGS_((Tk_Anchor anchor)); /* 131 */
    char * (*tk_NameOfBitmap) _ANSI_ARGS_((Display * display, Pixmap bitmap)); /* 132 */
    char * (*tk_NameOfCapStyle) _ANSI_ARGS_((int cap)); /* 133 */
    char * (*tk_NameOfColor) _ANSI_ARGS_((XColor * colorPtr)); /* 134 */
    char * (*tk_NameOfCursor) _ANSI_ARGS_((Display * display, Tk_Cursor cursor)); /* 135 */
    char * (*tk_NameOfFont) _ANSI_ARGS_((Tk_Font font)); /* 136 */
    char * (*tk_NameOfImage) _ANSI_ARGS_((Tk_ImageMaster imageMaster)); /* 137 */
    char * (*tk_NameOfJoinStyle) _ANSI_ARGS_((int join)); /* 138 */
    char * (*tk_NameOfJustify) _ANSI_ARGS_((Tk_Justify justify)); /* 139 */
    char * (*tk_NameOfRelief) _ANSI_ARGS_((int relief)); /* 140 */
    Tk_Window (*tk_NameToWindow) _ANSI_ARGS_((Tcl_Interp * interp, char * pathName, Tk_Window tkwin)); /* 141 */
    void (*tk_OwnSelection) _ANSI_ARGS_((Tk_Window tkwin, Atom selection, Tk_LostSelProc * proc, ClientData clientData)); /* 142 */
    int (*tk_ParseArgv) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, int * argcPtr, char ** argv, Tk_ArgvInfo * argTable, int flags)); /* 143 */
    void (*tk_PhotoPutBlock) _ANSI_ARGS_((Tk_PhotoHandle handle, Tk_PhotoImageBlock * blockPtr, int x, int y, int width, int height)); /* 144 */
    void (*tk_PhotoPutZoomedBlock) _ANSI_ARGS_((Tk_PhotoHandle handle, Tk_PhotoImageBlock * blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY)); /* 145 */
    int (*tk_PhotoGetImage) _ANSI_ARGS_((Tk_PhotoHandle handle, Tk_PhotoImageBlock * blockPtr)); /* 146 */
    void (*tk_PhotoBlank) _ANSI_ARGS_((Tk_PhotoHandle handle)); /* 147 */
    void (*tk_PhotoExpand) _ANSI_ARGS_((Tk_PhotoHandle handle, int width, int height)); /* 148 */
    void (*tk_PhotoGetSize) _ANSI_ARGS_((Tk_PhotoHandle handle, int * widthPtr, int * heightPtr)); /* 149 */
    void (*tk_PhotoSetSize) _ANSI_ARGS_((Tk_PhotoHandle handle, int width, int height)); /* 150 */
    int (*tk_PointToChar) _ANSI_ARGS_((Tk_TextLayout layout, int x, int y)); /* 151 */
    int (*tk_PostscriptFontName) _ANSI_ARGS_((Tk_Font tkfont, Tcl_DString * dsPtr)); /* 152 */
    void (*tk_PreserveColormap) _ANSI_ARGS_((Display * display, Colormap colormap)); /* 153 */
    void (*tk_QueueWindowEvent) _ANSI_ARGS_((XEvent * eventPtr, Tcl_QueuePosition position)); /* 154 */
    void (*tk_RedrawImage) _ANSI_ARGS_((Tk_Image image, int imageX, int imageY, int width, int height, Drawable drawable, int drawableX, int drawableY)); /* 155 */
    void (*tk_ResizeWindow) _ANSI_ARGS_((Tk_Window tkwin, int width, int height)); /* 156 */
    int (*tk_RestackWindow) _ANSI_ARGS_((Tk_Window tkwin, int aboveBelow, Tk_Window other)); /* 157 */
    Tk_RestrictProc * (*tk_RestrictEvents) _ANSI_ARGS_((Tk_RestrictProc * proc, ClientData arg, ClientData * prevArgPtr)); /* 158 */
    int (*tk_SafeInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 159 */
    char * (*tk_SetAppName) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 160 */
    void (*tk_SetBackgroundFromBorder) _ANSI_ARGS_((Tk_Window tkwin, Tk_3DBorder border)); /* 161 */
    void (*tk_SetClass) _ANSI_ARGS_((Tk_Window tkwin, char * className)); /* 162 */
    void (*tk_SetGrid) _ANSI_ARGS_((Tk_Window tkwin, int reqWidth, int reqHeight, int gridWidth, int gridHeight)); /* 163 */
    void (*tk_SetInternalBorder) _ANSI_ARGS_((Tk_Window tkwin, int width)); /* 164 */
    void (*tk_SetWindowBackground) _ANSI_ARGS_((Tk_Window tkwin, unsigned long pixel)); /* 165 */
    void (*tk_SetWindowBackgroundPixmap) _ANSI_ARGS_((Tk_Window tkwin, Pixmap pixmap)); /* 166 */
    void (*tk_SetWindowBorder) _ANSI_ARGS_((Tk_Window tkwin, unsigned long pixel)); /* 167 */
    void (*tk_SetWindowBorderWidth) _ANSI_ARGS_((Tk_Window tkwin, int width)); /* 168 */
    void (*tk_SetWindowBorderPixmap) _ANSI_ARGS_((Tk_Window tkwin, Pixmap pixmap)); /* 169 */
    void (*tk_SetWindowColormap) _ANSI_ARGS_((Tk_Window tkwin, Colormap colormap)); /* 170 */
    int (*tk_SetWindowVisual) _ANSI_ARGS_((Tk_Window tkwin, Visual * visual, int depth, Colormap colormap)); /* 171 */
    void (*tk_SizeOfBitmap) _ANSI_ARGS_((Display * display, Pixmap bitmap, int * widthPtr, int * heightPtr)); /* 172 */
    void (*tk_SizeOfImage) _ANSI_ARGS_((Tk_Image image, int * widthPtr, int * heightPtr)); /* 173 */
    int (*tk_StrictMotif) _ANSI_ARGS_((Tk_Window tkwin)); /* 174 */
    void (*tk_TextLayoutToPostscript) _ANSI_ARGS_((Tcl_Interp * interp, Tk_TextLayout layout)); /* 175 */
    int (*tk_TextWidth) _ANSI_ARGS_((Tk_Font font, CONST char * str, int numBytes)); /* 176 */
    void (*tk_UndefineCursor) _ANSI_ARGS_((Tk_Window window)); /* 177 */
    void (*tk_UnderlineChars) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_Font tkfont, CONST char * source, int x, int y, int firstByte, int lastByte)); /* 178 */
    void (*tk_UnderlineTextLayout) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, int underline)); /* 179 */
    void (*tk_Ungrab) _ANSI_ARGS_((Tk_Window tkwin)); /* 180 */
    void (*tk_UnmaintainGeometry) _ANSI_ARGS_((Tk_Window slave, Tk_Window master)); /* 181 */
    void (*tk_UnmapWindow) _ANSI_ARGS_((Tk_Window tkwin)); /* 182 */
    void (*tk_UnsetGrid) _ANSI_ARGS_((Tk_Window tkwin)); /* 183 */
    void (*tk_UpdatePointer) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int state)); /* 184 */
    Pixmap (*tk_AllocBitmapFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 185 */
    Tk_3DBorder (*tk_Alloc3DBorderFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 186 */
    XColor * (*tk_AllocColorFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 187 */
    Tk_Cursor (*tk_AllocCursorFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 188 */
    Tk_Font (*tk_AllocFontFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 189 */
    Tk_OptionTable (*tk_CreateOptionTable) _ANSI_ARGS_((Tcl_Interp * interp, CONST Tk_OptionSpec * templatePtr)); /* 190 */
    void (*tk_DeleteOptionTable) _ANSI_ARGS_((Tk_OptionTable optionTable)); /* 191 */
    void (*tk_Free3DBorderFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 192 */
    void (*tk_FreeBitmapFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 193 */
    void (*tk_FreeColorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 194 */
    void (*tk_FreeConfigOptions) _ANSI_ARGS_((char * recordPtr, Tk_OptionTable optionToken, Tk_Window tkwin)); /* 195 */
    void (*tk_FreeSavedOptions) _ANSI_ARGS_((Tk_SavedOptions * savePtr)); /* 196 */
    void (*tk_FreeCursorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 197 */
    void (*tk_FreeFontFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 198 */
    Tk_3DBorder (*tk_Get3DBorderFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 199 */
    int (*tk_GetAnchorFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tk_Anchor * anchorPtr)); /* 200 */
    Pixmap (*tk_GetBitmapFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 201 */
    XColor * (*tk_GetColorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 202 */
    Tk_Cursor (*tk_GetCursorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 203 */
    Tcl_Obj * (*tk_GetOptionInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionTable, Tcl_Obj * namePtr, Tk_Window tkwin)); /* 204 */
    Tcl_Obj * (*tk_GetOptionValue) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionTable, Tcl_Obj * namePtr, Tk_Window tkwin)); /* 205 */
    int (*tk_GetJustifyFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tk_Justify * justifyPtr)); /* 206 */
    int (*tk_GetMMFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr, double * doublePtr)); /* 207 */
    int (*tk_GetPixelsFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr, int * intPtr)); /* 208 */
    int (*tk_GetReliefFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * resultPtr)); /* 209 */
    int (*tk_GetScrollInfoObj) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], double * dblPtr, int * intPtr)); /* 210 */
    int (*tk_InitOptions) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionToken, Tk_Window tkwin)); /* 211 */
    void (*tk_MainEx) _ANSI_ARGS_((int argc, char ** argv, Tcl_AppInitProc * appInitProc, Tcl_Interp * interp)); /* 212 */
    void (*tk_RestoreSavedOptions) _ANSI_ARGS_((Tk_SavedOptions * savePtr)); /* 213 */
    int (*tk_SetOptions) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionTable, int objc, Tcl_Obj *CONST objv[], Tk_Window tkwin, Tk_SavedOptions * savePtr, int * maskPtr)); /* 214 */
} TkStubs;

extern TkStubs *tkStubsPtr;

#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS)

/*
 * Inline function declarations:
 */

#ifndef Tk_MainLoop
#define Tk_MainLoop \
	(tkStubsPtr->tk_MainLoop) /* 0 */
#endif
#ifndef Tk_3DBorderColor
#define Tk_3DBorderColor \
	(tkStubsPtr->tk_3DBorderColor) /* 1 */
#endif
#ifndef Tk_3DBorderGC
#define Tk_3DBorderGC \
	(tkStubsPtr->tk_3DBorderGC) /* 2 */
#endif
#ifndef Tk_3DHorizontalBevel
#define Tk_3DHorizontalBevel \
	(tkStubsPtr->tk_3DHorizontalBevel) /* 3 */
#endif
#ifndef Tk_3DVerticalBevel
#define Tk_3DVerticalBevel \
	(tkStubsPtr->tk_3DVerticalBevel) /* 4 */
#endif
#ifndef Tk_AddOption
#define Tk_AddOption \
	(tkStubsPtr->tk_AddOption) /* 5 */
#endif
#ifndef Tk_BindEvent
#define Tk_BindEvent \
	(tkStubsPtr->tk_BindEvent) /* 6 */
#endif
#ifndef Tk_CanvasDrawableCoords
#define Tk_CanvasDrawableCoords \
	(tkStubsPtr->tk_CanvasDrawableCoords) /* 7 */
#endif
#ifndef Tk_CanvasEventuallyRedraw
#define Tk_CanvasEventuallyRedraw \
	(tkStubsPtr->tk_CanvasEventuallyRedraw) /* 8 */
#endif
#ifndef Tk_CanvasGetCoord
#define Tk_CanvasGetCoord \
	(tkStubsPtr->tk_CanvasGetCoord) /* 9 */
#endif
#ifndef Tk_CanvasGetTextInfo
#define Tk_CanvasGetTextInfo \
	(tkStubsPtr->tk_CanvasGetTextInfo) /* 10 */
#endif
#ifndef Tk_CanvasPsBitmap
#define Tk_CanvasPsBitmap \
	(tkStubsPtr->tk_CanvasPsBitmap) /* 11 */
#endif
#ifndef Tk_CanvasPsColor
#define Tk_CanvasPsColor \
	(tkStubsPtr->tk_CanvasPsColor) /* 12 */
#endif
#ifndef Tk_CanvasPsFont
#define Tk_CanvasPsFont \
	(tkStubsPtr->tk_CanvasPsFont) /* 13 */
#endif
#ifndef Tk_CanvasPsPath
#define Tk_CanvasPsPath \
	(tkStubsPtr->tk_CanvasPsPath) /* 14 */
#endif
#ifndef Tk_CanvasPsStipple
#define Tk_CanvasPsStipple \
	(tkStubsPtr->tk_CanvasPsStipple) /* 15 */
#endif
#ifndef Tk_CanvasPsY
#define Tk_CanvasPsY \
	(tkStubsPtr->tk_CanvasPsY) /* 16 */
#endif
#ifndef Tk_CanvasSetStippleOrigin
#define Tk_CanvasSetStippleOrigin \
	(tkStubsPtr->tk_CanvasSetStippleOrigin) /* 17 */
#endif
#ifndef Tk_CanvasTagsParseProc
#define Tk_CanvasTagsParseProc \
	(tkStubsPtr->tk_CanvasTagsParseProc) /* 18 */
#endif
#ifndef Tk_CanvasTagsPrintProc
#define Tk_CanvasTagsPrintProc \
	(tkStubsPtr->tk_CanvasTagsPrintProc) /* 19 */
#endif
#ifndef Tk_CanvasTkwin
#define Tk_CanvasTkwin \
	(tkStubsPtr->tk_CanvasTkwin) /* 20 */
#endif
#ifndef Tk_CanvasWindowCoords
#define Tk_CanvasWindowCoords \
	(tkStubsPtr->tk_CanvasWindowCoords) /* 21 */
#endif
#ifndef Tk_ChangeWindowAttributes
#define Tk_ChangeWindowAttributes \
	(tkStubsPtr->tk_ChangeWindowAttributes) /* 22 */
#endif
#ifndef Tk_CharBbox
#define Tk_CharBbox \
	(tkStubsPtr->tk_CharBbox) /* 23 */
#endif
#ifndef Tk_ClearSelection
#define Tk_ClearSelection \
	(tkStubsPtr->tk_ClearSelection) /* 24 */
#endif
#ifndef Tk_ClipboardAppend
#define Tk_ClipboardAppend \
	(tkStubsPtr->tk_ClipboardAppend) /* 25 */
#endif
#ifndef Tk_ClipboardClear
#define Tk_ClipboardClear \
	(tkStubsPtr->tk_ClipboardClear) /* 26 */
#endif
#ifndef Tk_ConfigureInfo
#define Tk_ConfigureInfo \
	(tkStubsPtr->tk_ConfigureInfo) /* 27 */
#endif
#ifndef Tk_ConfigureValue
#define Tk_ConfigureValue \
	(tkStubsPtr->tk_ConfigureValue) /* 28 */
#endif
#ifndef Tk_ConfigureWidget
#define Tk_ConfigureWidget \
	(tkStubsPtr->tk_ConfigureWidget) /* 29 */
#endif
#ifndef Tk_ConfigureWindow
#define Tk_ConfigureWindow \
	(tkStubsPtr->tk_ConfigureWindow) /* 30 */
#endif
#ifndef Tk_ComputeTextLayout
#define Tk_ComputeTextLayout \
	(tkStubsPtr->tk_ComputeTextLayout) /* 31 */
#endif
#ifndef Tk_CoordsToWindow
#define Tk_CoordsToWindow \
	(tkStubsPtr->tk_CoordsToWindow) /* 32 */
#endif
#ifndef Tk_CreateBinding
#define Tk_CreateBinding \
	(tkStubsPtr->tk_CreateBinding) /* 33 */
#endif
#ifndef Tk_CreateBindingTable
#define Tk_CreateBindingTable \
	(tkStubsPtr->tk_CreateBindingTable) /* 34 */
#endif
#ifndef Tk_CreateErrorHandler
#define Tk_CreateErrorHandler \
	(tkStubsPtr->tk_CreateErrorHandler) /* 35 */
#endif
#ifndef Tk_CreateEventHandler
#define Tk_CreateEventHandler \
	(tkStubsPtr->tk_CreateEventHandler) /* 36 */
#endif
#ifndef Tk_CreateGenericHandler
#define Tk_CreateGenericHandler \
	(tkStubsPtr->tk_CreateGenericHandler) /* 37 */
#endif
#ifndef Tk_CreateImageType
#define Tk_CreateImageType \
	(tkStubsPtr->tk_CreateImageType) /* 38 */
#endif
#ifndef Tk_CreateItemType
#define Tk_CreateItemType \
	(tkStubsPtr->tk_CreateItemType) /* 39 */
#endif
#ifndef Tk_CreatePhotoImageFormat
#define Tk_CreatePhotoImageFormat \
	(tkStubsPtr->tk_CreatePhotoImageFormat) /* 40 */
#endif
#ifndef Tk_CreateSelHandler
#define Tk_CreateSelHandler \
	(tkStubsPtr->tk_CreateSelHandler) /* 41 */
#endif
#ifndef Tk_CreateWindow
#define Tk_CreateWindow \
	(tkStubsPtr->tk_CreateWindow) /* 42 */
#endif
#ifndef Tk_CreateWindowFromPath
#define Tk_CreateWindowFromPath \
	(tkStubsPtr->tk_CreateWindowFromPath) /* 43 */
#endif
#ifndef Tk_DefineBitmap
#define Tk_DefineBitmap \
	(tkStubsPtr->tk_DefineBitmap) /* 44 */
#endif
#ifndef Tk_DefineCursor
#define Tk_DefineCursor \
	(tkStubsPtr->tk_DefineCursor) /* 45 */
#endif
#ifndef Tk_DeleteAllBindings
#define Tk_DeleteAllBindings \
	(tkStubsPtr->tk_DeleteAllBindings) /* 46 */
#endif
#ifndef Tk_DeleteBinding
#define Tk_DeleteBinding \
	(tkStubsPtr->tk_DeleteBinding) /* 47 */
#endif
#ifndef Tk_DeleteBindingTable
#define Tk_DeleteBindingTable \
	(tkStubsPtr->tk_DeleteBindingTable) /* 48 */
#endif
#ifndef Tk_DeleteErrorHandler
#define Tk_DeleteErrorHandler \
	(tkStubsPtr->tk_DeleteErrorHandler) /* 49 */
#endif
#ifndef Tk_DeleteEventHandler
#define Tk_DeleteEventHandler \
	(tkStubsPtr->tk_DeleteEventHandler) /* 50 */
#endif
#ifndef Tk_DeleteGenericHandler
#define Tk_DeleteGenericHandler \
	(tkStubsPtr->tk_DeleteGenericHandler) /* 51 */
#endif
#ifndef Tk_DeleteImage
#define Tk_DeleteImage \
	(tkStubsPtr->tk_DeleteImage) /* 52 */
#endif
#ifndef Tk_DeleteSelHandler
#define Tk_DeleteSelHandler \
	(tkStubsPtr->tk_DeleteSelHandler) /* 53 */
#endif
#ifndef Tk_DestroyWindow
#define Tk_DestroyWindow \
	(tkStubsPtr->tk_DestroyWindow) /* 54 */
#endif
#ifndef Tk_DisplayName
#define Tk_DisplayName \
	(tkStubsPtr->tk_DisplayName) /* 55 */
#endif
#ifndef Tk_DistanceToTextLayout
#define Tk_DistanceToTextLayout \
	(tkStubsPtr->tk_DistanceToTextLayout) /* 56 */
#endif
#ifndef Tk_Draw3DPolygon
#define Tk_Draw3DPolygon \
	(tkStubsPtr->tk_Draw3DPolygon) /* 57 */
#endif
#ifndef Tk_Draw3DRectangle
#define Tk_Draw3DRectangle \
	(tkStubsPtr->tk_Draw3DRectangle) /* 58 */
#endif
#ifndef Tk_DrawChars
#define Tk_DrawChars \
	(tkStubsPtr->tk_DrawChars) /* 59 */
#endif
#ifndef Tk_DrawFocusHighlight
#define Tk_DrawFocusHighlight \
	(tkStubsPtr->tk_DrawFocusHighlight) /* 60 */
#endif
#ifndef Tk_DrawTextLayout
#define Tk_DrawTextLayout \
	(tkStubsPtr->tk_DrawTextLayout) /* 61 */
#endif
#ifndef Tk_Fill3DPolygon
#define Tk_Fill3DPolygon \
	(tkStubsPtr->tk_Fill3DPolygon) /* 62 */
#endif
#ifndef Tk_Fill3DRectangle
#define Tk_Fill3DRectangle \
	(tkStubsPtr->tk_Fill3DRectangle) /* 63 */
#endif
#ifndef Tk_FindPhoto
#define Tk_FindPhoto \
	(tkStubsPtr->tk_FindPhoto) /* 64 */
#endif
#ifndef Tk_FontId
#define Tk_FontId \
	(tkStubsPtr->tk_FontId) /* 65 */
#endif
#ifndef Tk_Free3DBorder
#define Tk_Free3DBorder \
	(tkStubsPtr->tk_Free3DBorder) /* 66 */
#endif
#ifndef Tk_FreeBitmap
#define Tk_FreeBitmap \
	(tkStubsPtr->tk_FreeBitmap) /* 67 */
#endif
#ifndef Tk_FreeColor
#define Tk_FreeColor \
	(tkStubsPtr->tk_FreeColor) /* 68 */
#endif
#ifndef Tk_FreeColormap
#define Tk_FreeColormap \
	(tkStubsPtr->tk_FreeColormap) /* 69 */
#endif
#ifndef Tk_FreeCursor
#define Tk_FreeCursor \
	(tkStubsPtr->tk_FreeCursor) /* 70 */
#endif
#ifndef Tk_FreeFont
#define Tk_FreeFont \
	(tkStubsPtr->tk_FreeFont) /* 71 */
#endif
#ifndef Tk_FreeGC
#define Tk_FreeGC \
	(tkStubsPtr->tk_FreeGC) /* 72 */
#endif
#ifndef Tk_FreeImage
#define Tk_FreeImage \
	(tkStubsPtr->tk_FreeImage) /* 73 */
#endif
#ifndef Tk_FreeOptions
#define Tk_FreeOptions \
	(tkStubsPtr->tk_FreeOptions) /* 74 */
#endif
#ifndef Tk_FreePixmap
#define Tk_FreePixmap \
	(tkStubsPtr->tk_FreePixmap) /* 75 */
#endif
#ifndef Tk_FreeTextLayout
#define Tk_FreeTextLayout \
	(tkStubsPtr->tk_FreeTextLayout) /* 76 */
#endif
#ifndef Tk_FreeXId
#define Tk_FreeXId \
	(tkStubsPtr->tk_FreeXId) /* 77 */
#endif
#ifndef Tk_GCForColor
#define Tk_GCForColor \
	(tkStubsPtr->tk_GCForColor) /* 78 */
#endif
#ifndef Tk_GeometryRequest
#define Tk_GeometryRequest \
	(tkStubsPtr->tk_GeometryRequest) /* 79 */
#endif
#ifndef Tk_Get3DBorder
#define Tk_Get3DBorder \
	(tkStubsPtr->tk_Get3DBorder) /* 80 */
#endif
#ifndef Tk_GetAllBindings
#define Tk_GetAllBindings \
	(tkStubsPtr->tk_GetAllBindings) /* 81 */
#endif
#ifndef Tk_GetAnchor
#define Tk_GetAnchor \
	(tkStubsPtr->tk_GetAnchor) /* 82 */
#endif
#ifndef Tk_GetAtomName
#define Tk_GetAtomName \
	(tkStubsPtr->tk_GetAtomName) /* 83 */
#endif
#ifndef Tk_GetBinding
#define Tk_GetBinding \
	(tkStubsPtr->tk_GetBinding) /* 84 */
#endif
#ifndef Tk_GetBitmap
#define Tk_GetBitmap \
	(tkStubsPtr->tk_GetBitmap) /* 85 */
#endif
#ifndef Tk_GetBitmapFromData
#define Tk_GetBitmapFromData \
	(tkStubsPtr->tk_GetBitmapFromData) /* 86 */
#endif
#ifndef Tk_GetCapStyle
#define Tk_GetCapStyle \
	(tkStubsPtr->tk_GetCapStyle) /* 87 */
#endif
#ifndef Tk_GetColor
#define Tk_GetColor \
	(tkStubsPtr->tk_GetColor) /* 88 */
#endif
#ifndef Tk_GetColorByValue
#define Tk_GetColorByValue \
	(tkStubsPtr->tk_GetColorByValue) /* 89 */
#endif
#ifndef Tk_GetColormap
#define Tk_GetColormap \
	(tkStubsPtr->tk_GetColormap) /* 90 */
#endif
#ifndef Tk_GetCursor
#define Tk_GetCursor \
	(tkStubsPtr->tk_GetCursor) /* 91 */
#endif
#ifndef Tk_GetCursorFromData
#define Tk_GetCursorFromData \
	(tkStubsPtr->tk_GetCursorFromData) /* 92 */
#endif
#ifndef Tk_GetFont
#define Tk_GetFont \
	(tkStubsPtr->tk_GetFont) /* 93 */
#endif
#ifndef Tk_GetFontFromObj
#define Tk_GetFontFromObj \
	(tkStubsPtr->tk_GetFontFromObj) /* 94 */
#endif
#ifndef Tk_GetFontMetrics
#define Tk_GetFontMetrics \
	(tkStubsPtr->tk_GetFontMetrics) /* 95 */
#endif
#ifndef Tk_GetGC
#define Tk_GetGC \
	(tkStubsPtr->tk_GetGC) /* 96 */
#endif
#ifndef Tk_GetImage
#define Tk_GetImage \
	(tkStubsPtr->tk_GetImage) /* 97 */
#endif
#ifndef Tk_GetImageMasterData
#define Tk_GetImageMasterData \
	(tkStubsPtr->tk_GetImageMasterData) /* 98 */
#endif
#ifndef Tk_GetItemTypes
#define Tk_GetItemTypes \
	(tkStubsPtr->tk_GetItemTypes) /* 99 */
#endif
#ifndef Tk_GetJoinStyle
#define Tk_GetJoinStyle \
	(tkStubsPtr->tk_GetJoinStyle) /* 100 */
#endif
#ifndef Tk_GetJustify
#define Tk_GetJustify \
	(tkStubsPtr->tk_GetJustify) /* 101 */
#endif
#ifndef Tk_GetNumMainWindows
#define Tk_GetNumMainWindows \
	(tkStubsPtr->tk_GetNumMainWindows) /* 102 */
#endif
#ifndef Tk_GetOption
#define Tk_GetOption \
	(tkStubsPtr->tk_GetOption) /* 103 */
#endif
#ifndef Tk_GetPixels
#define Tk_GetPixels \
	(tkStubsPtr->tk_GetPixels) /* 104 */
#endif
#ifndef Tk_GetPixmap
#define Tk_GetPixmap \
	(tkStubsPtr->tk_GetPixmap) /* 105 */
#endif
#ifndef Tk_GetRelief
#define Tk_GetRelief \
	(tkStubsPtr->tk_GetRelief) /* 106 */
#endif
#ifndef Tk_GetRootCoords
#define Tk_GetRootCoords \
	(tkStubsPtr->tk_GetRootCoords) /* 107 */
#endif
#ifndef Tk_GetScrollInfo
#define Tk_GetScrollInfo \
	(tkStubsPtr->tk_GetScrollInfo) /* 108 */
#endif
#ifndef Tk_GetScreenMM
#define Tk_GetScreenMM \
	(tkStubsPtr->tk_GetScreenMM) /* 109 */
#endif
#ifndef Tk_GetSelection
#define Tk_GetSelection \
	(tkStubsPtr->tk_GetSelection) /* 110 */
#endif
#ifndef Tk_GetUid
#define Tk_GetUid \
	(tkStubsPtr->tk_GetUid) /* 111 */
#endif
#ifndef Tk_GetVisual
#define Tk_GetVisual \
	(tkStubsPtr->tk_GetVisual) /* 112 */
#endif
#ifndef Tk_GetVRootGeometry
#define Tk_GetVRootGeometry \
	(tkStubsPtr->tk_GetVRootGeometry) /* 113 */
#endif
#ifndef Tk_Grab
#define Tk_Grab \
	(tkStubsPtr->tk_Grab) /* 114 */
#endif
#ifndef Tk_HandleEvent
#define Tk_HandleEvent \
	(tkStubsPtr->tk_HandleEvent) /* 115 */
#endif
#ifndef Tk_IdToWindow
#define Tk_IdToWindow \
	(tkStubsPtr->tk_IdToWindow) /* 116 */
#endif
#ifndef Tk_ImageChanged
#define Tk_ImageChanged \
	(tkStubsPtr->tk_ImageChanged) /* 117 */
#endif
#ifndef Tk_Init
#define Tk_Init \
	(tkStubsPtr->tk_Init) /* 118 */
#endif
#ifndef Tk_InternAtom
#define Tk_InternAtom \
	(tkStubsPtr->tk_InternAtom) /* 119 */
#endif
#ifndef Tk_IntersectTextLayout
#define Tk_IntersectTextLayout \
	(tkStubsPtr->tk_IntersectTextLayout) /* 120 */
#endif
#ifndef Tk_MaintainGeometry
#define Tk_MaintainGeometry \
	(tkStubsPtr->tk_MaintainGeometry) /* 121 */
#endif
#ifndef Tk_MainWindow
#define Tk_MainWindow \
	(tkStubsPtr->tk_MainWindow) /* 122 */
#endif
#ifndef Tk_MakeWindowExist
#define Tk_MakeWindowExist \
	(tkStubsPtr->tk_MakeWindowExist) /* 123 */
#endif
#ifndef Tk_ManageGeometry
#define Tk_ManageGeometry \
	(tkStubsPtr->tk_ManageGeometry) /* 124 */
#endif
#ifndef Tk_MapWindow
#define Tk_MapWindow \
	(tkStubsPtr->tk_MapWindow) /* 125 */
#endif
#ifndef Tk_MeasureChars
#define Tk_MeasureChars \
	(tkStubsPtr->tk_MeasureChars) /* 126 */
#endif
#ifndef Tk_MoveResizeWindow
#define Tk_MoveResizeWindow \
	(tkStubsPtr->tk_MoveResizeWindow) /* 127 */
#endif
#ifndef Tk_MoveWindow
#define Tk_MoveWindow \
	(tkStubsPtr->tk_MoveWindow) /* 128 */
#endif
#ifndef Tk_MoveToplevelWindow
#define Tk_MoveToplevelWindow \
	(tkStubsPtr->tk_MoveToplevelWindow) /* 129 */
#endif
#ifndef Tk_NameOf3DBorder
#define Tk_NameOf3DBorder \
	(tkStubsPtr->tk_NameOf3DBorder) /* 130 */
#endif
#ifndef Tk_NameOfAnchor
#define Tk_NameOfAnchor \
	(tkStubsPtr->tk_NameOfAnchor) /* 131 */
#endif
#ifndef Tk_NameOfBitmap
#define Tk_NameOfBitmap \
	(tkStubsPtr->tk_NameOfBitmap) /* 132 */
#endif
#ifndef Tk_NameOfCapStyle
#define Tk_NameOfCapStyle \
	(tkStubsPtr->tk_NameOfCapStyle) /* 133 */
#endif
#ifndef Tk_NameOfColor
#define Tk_NameOfColor \
	(tkStubsPtr->tk_NameOfColor) /* 134 */
#endif
#ifndef Tk_NameOfCursor
#define Tk_NameOfCursor \
	(tkStubsPtr->tk_NameOfCursor) /* 135 */
#endif
#ifndef Tk_NameOfFont
#define Tk_NameOfFont \
	(tkStubsPtr->tk_NameOfFont) /* 136 */
#endif
#ifndef Tk_NameOfImage
#define Tk_NameOfImage \
	(tkStubsPtr->tk_NameOfImage) /* 137 */
#endif
#ifndef Tk_NameOfJoinStyle
#define Tk_NameOfJoinStyle \
	(tkStubsPtr->tk_NameOfJoinStyle) /* 138 */
#endif
#ifndef Tk_NameOfJustify
#define Tk_NameOfJustify \
	(tkStubsPtr->tk_NameOfJustify) /* 139 */
#endif
#ifndef Tk_NameOfRelief
#define Tk_NameOfRelief \
	(tkStubsPtr->tk_NameOfRelief) /* 140 */
#endif
#ifndef Tk_NameToWindow
#define Tk_NameToWindow \
	(tkStubsPtr->tk_NameToWindow) /* 141 */
#endif
#ifndef Tk_OwnSelection
#define Tk_OwnSelection \
	(tkStubsPtr->tk_OwnSelection) /* 142 */
#endif
#ifndef Tk_ParseArgv
#define Tk_ParseArgv \
	(tkStubsPtr->tk_ParseArgv) /* 143 */
#endif
#ifndef Tk_PhotoPutBlock
#define Tk_PhotoPutBlock \
	(tkStubsPtr->tk_PhotoPutBlock) /* 144 */
#endif
#ifndef Tk_PhotoPutZoomedBlock
#define Tk_PhotoPutZoomedBlock \
	(tkStubsPtr->tk_PhotoPutZoomedBlock) /* 145 */
#endif
#ifndef Tk_PhotoGetImage
#define Tk_PhotoGetImage \
	(tkStubsPtr->tk_PhotoGetImage) /* 146 */
#endif
#ifndef Tk_PhotoBlank
#define Tk_PhotoBlank \
	(tkStubsPtr->tk_PhotoBlank) /* 147 */
#endif
#ifndef Tk_PhotoExpand
#define Tk_PhotoExpand \
	(tkStubsPtr->tk_PhotoExpand) /* 148 */
#endif
#ifndef Tk_PhotoGetSize
#define Tk_PhotoGetSize \
	(tkStubsPtr->tk_PhotoGetSize) /* 149 */
#endif
#ifndef Tk_PhotoSetSize
#define Tk_PhotoSetSize \
	(tkStubsPtr->tk_PhotoSetSize) /* 150 */
#endif
#ifndef Tk_PointToChar
#define Tk_PointToChar \
	(tkStubsPtr->tk_PointToChar) /* 151 */
#endif
#ifndef Tk_PostscriptFontName
#define Tk_PostscriptFontName \
	(tkStubsPtr->tk_PostscriptFontName) /* 152 */
#endif
#ifndef Tk_PreserveColormap
#define Tk_PreserveColormap \
	(tkStubsPtr->tk_PreserveColormap) /* 153 */
#endif
#ifndef Tk_QueueWindowEvent
#define Tk_QueueWindowEvent \
	(tkStubsPtr->tk_QueueWindowEvent) /* 154 */
#endif
#ifndef Tk_RedrawImage
#define Tk_RedrawImage \
	(tkStubsPtr->tk_RedrawImage) /* 155 */
#endif
#ifndef Tk_ResizeWindow
#define Tk_ResizeWindow \
	(tkStubsPtr->tk_ResizeWindow) /* 156 */
#endif
#ifndef Tk_RestackWindow
#define Tk_RestackWindow \
	(tkStubsPtr->tk_RestackWindow) /* 157 */
#endif
#ifndef Tk_RestrictEvents
#define Tk_RestrictEvents \
	(tkStubsPtr->tk_RestrictEvents) /* 158 */
#endif
#ifndef Tk_SafeInit
#define Tk_SafeInit \
	(tkStubsPtr->tk_SafeInit) /* 159 */
#endif
#ifndef Tk_SetAppName
#define Tk_SetAppName \
	(tkStubsPtr->tk_SetAppName) /* 160 */
#endif
#ifndef Tk_SetBackgroundFromBorder
#define Tk_SetBackgroundFromBorder \
	(tkStubsPtr->tk_SetBackgroundFromBorder) /* 161 */
#endif
#ifndef Tk_SetClass
#define Tk_SetClass \
	(tkStubsPtr->tk_SetClass) /* 162 */
#endif
#ifndef Tk_SetGrid
#define Tk_SetGrid \
	(tkStubsPtr->tk_SetGrid) /* 163 */
#endif
#ifndef Tk_SetInternalBorder
#define Tk_SetInternalBorder \
	(tkStubsPtr->tk_SetInternalBorder) /* 164 */
#endif
#ifndef Tk_SetWindowBackground
#define Tk_SetWindowBackground \
	(tkStubsPtr->tk_SetWindowBackground) /* 165 */
#endif
#ifndef Tk_SetWindowBackgroundPixmap
#define Tk_SetWindowBackgroundPixmap \
	(tkStubsPtr->tk_SetWindowBackgroundPixmap) /* 166 */
#endif
#ifndef Tk_SetWindowBorder
#define Tk_SetWindowBorder \
	(tkStubsPtr->tk_SetWindowBorder) /* 167 */
#endif
#ifndef Tk_SetWindowBorderWidth
#define Tk_SetWindowBorderWidth \
	(tkStubsPtr->tk_SetWindowBorderWidth) /* 168 */
#endif
#ifndef Tk_SetWindowBorderPixmap
#define Tk_SetWindowBorderPixmap \
	(tkStubsPtr->tk_SetWindowBorderPixmap) /* 169 */
#endif
#ifndef Tk_SetWindowColormap
#define Tk_SetWindowColormap \
	(tkStubsPtr->tk_SetWindowColormap) /* 170 */
#endif
#ifndef Tk_SetWindowVisual
#define Tk_SetWindowVisual \
	(tkStubsPtr->tk_SetWindowVisual) /* 171 */
#endif
#ifndef Tk_SizeOfBitmap
#define Tk_SizeOfBitmap \
	(tkStubsPtr->tk_SizeOfBitmap) /* 172 */
#endif
#ifndef Tk_SizeOfImage
#define Tk_SizeOfImage \
	(tkStubsPtr->tk_SizeOfImage) /* 173 */
#endif
#ifndef Tk_StrictMotif
#define Tk_StrictMotif \
	(tkStubsPtr->tk_StrictMotif) /* 174 */
#endif
#ifndef Tk_TextLayoutToPostscript
#define Tk_TextLayoutToPostscript \
	(tkStubsPtr->tk_TextLayoutToPostscript) /* 175 */
#endif
#ifndef Tk_TextWidth
#define Tk_TextWidth \
	(tkStubsPtr->tk_TextWidth) /* 176 */
#endif
#ifndef Tk_UndefineCursor
#define Tk_UndefineCursor \
	(tkStubsPtr->tk_UndefineCursor) /* 177 */
#endif
#ifndef Tk_UnderlineChars
#define Tk_UnderlineChars \
	(tkStubsPtr->tk_UnderlineChars) /* 178 */
#endif
#ifndef Tk_UnderlineTextLayout
#define Tk_UnderlineTextLayout \
	(tkStubsPtr->tk_UnderlineTextLayout) /* 179 */
#endif
#ifndef Tk_Ungrab
#define Tk_Ungrab \
	(tkStubsPtr->tk_Ungrab) /* 180 */
#endif
#ifndef Tk_UnmaintainGeometry
#define Tk_UnmaintainGeometry \
	(tkStubsPtr->tk_UnmaintainGeometry) /* 181 */
#endif
#ifndef Tk_UnmapWindow
#define Tk_UnmapWindow \
	(tkStubsPtr->tk_UnmapWindow) /* 182 */
#endif
#ifndef Tk_UnsetGrid
#define Tk_UnsetGrid \
	(tkStubsPtr->tk_UnsetGrid) /* 183 */
#endif
#ifndef Tk_UpdatePointer
#define Tk_UpdatePointer \
	(tkStubsPtr->tk_UpdatePointer) /* 184 */
#endif
#ifndef Tk_AllocBitmapFromObj
#define Tk_AllocBitmapFromObj \
	(tkStubsPtr->tk_AllocBitmapFromObj) /* 185 */
#endif
#ifndef Tk_Alloc3DBorderFromObj
#define Tk_Alloc3DBorderFromObj \
	(tkStubsPtr->tk_Alloc3DBorderFromObj) /* 186 */
#endif
#ifndef Tk_AllocColorFromObj
#define Tk_AllocColorFromObj \
	(tkStubsPtr->tk_AllocColorFromObj) /* 187 */
#endif
#ifndef Tk_AllocCursorFromObj
#define Tk_AllocCursorFromObj \
	(tkStubsPtr->tk_AllocCursorFromObj) /* 188 */
#endif
#ifndef Tk_AllocFontFromObj
#define Tk_AllocFontFromObj \
	(tkStubsPtr->tk_AllocFontFromObj) /* 189 */
#endif
#ifndef Tk_CreateOptionTable
#define Tk_CreateOptionTable \
	(tkStubsPtr->tk_CreateOptionTable) /* 190 */
#endif
#ifndef Tk_DeleteOptionTable
#define Tk_DeleteOptionTable \
	(tkStubsPtr->tk_DeleteOptionTable) /* 191 */
#endif
#ifndef Tk_Free3DBorderFromObj
#define Tk_Free3DBorderFromObj \
	(tkStubsPtr->tk_Free3DBorderFromObj) /* 192 */
#endif
#ifndef Tk_FreeBitmapFromObj
#define Tk_FreeBitmapFromObj \
	(tkStubsPtr->tk_FreeBitmapFromObj) /* 193 */
#endif
#ifndef Tk_FreeColorFromObj
#define Tk_FreeColorFromObj \
	(tkStubsPtr->tk_FreeColorFromObj) /* 194 */
#endif
#ifndef Tk_FreeConfigOptions
#define Tk_FreeConfigOptions \
	(tkStubsPtr->tk_FreeConfigOptions) /* 195 */
#endif
#ifndef Tk_FreeSavedOptions
#define Tk_FreeSavedOptions \
	(tkStubsPtr->tk_FreeSavedOptions) /* 196 */
#endif
#ifndef Tk_FreeCursorFromObj
#define Tk_FreeCursorFromObj \
	(tkStubsPtr->tk_FreeCursorFromObj) /* 197 */
#endif
#ifndef Tk_FreeFontFromObj
#define Tk_FreeFontFromObj \
	(tkStubsPtr->tk_FreeFontFromObj) /* 198 */
#endif
#ifndef Tk_Get3DBorderFromObj
#define Tk_Get3DBorderFromObj \
	(tkStubsPtr->tk_Get3DBorderFromObj) /* 199 */
#endif
#ifndef Tk_GetAnchorFromObj
#define Tk_GetAnchorFromObj \
	(tkStubsPtr->tk_GetAnchorFromObj) /* 200 */
#endif
#ifndef Tk_GetBitmapFromObj
#define Tk_GetBitmapFromObj \
	(tkStubsPtr->tk_GetBitmapFromObj) /* 201 */
#endif
#ifndef Tk_GetColorFromObj
#define Tk_GetColorFromObj \
	(tkStubsPtr->tk_GetColorFromObj) /* 202 */
#endif
#ifndef Tk_GetCursorFromObj
#define Tk_GetCursorFromObj \
	(tkStubsPtr->tk_GetCursorFromObj) /* 203 */
#endif
#ifndef Tk_GetOptionInfo
#define Tk_GetOptionInfo \
	(tkStubsPtr->tk_GetOptionInfo) /* 204 */
#endif
#ifndef Tk_GetOptionValue
#define Tk_GetOptionValue \
	(tkStubsPtr->tk_GetOptionValue) /* 205 */
#endif
#ifndef Tk_GetJustifyFromObj
#define Tk_GetJustifyFromObj \
	(tkStubsPtr->tk_GetJustifyFromObj) /* 206 */
#endif
#ifndef Tk_GetMMFromObj
#define Tk_GetMMFromObj \
	(tkStubsPtr->tk_GetMMFromObj) /* 207 */
#endif
#ifndef Tk_GetPixelsFromObj
#define Tk_GetPixelsFromObj \
	(tkStubsPtr->tk_GetPixelsFromObj) /* 208 */
#endif
#ifndef Tk_GetReliefFromObj
#define Tk_GetReliefFromObj \
	(tkStubsPtr->tk_GetReliefFromObj) /* 209 */
#endif
#ifndef Tk_GetScrollInfoObj
#define Tk_GetScrollInfoObj \
	(tkStubsPtr->tk_GetScrollInfoObj) /* 210 */
#endif
#ifndef Tk_InitOptions
#define Tk_InitOptions \
	(tkStubsPtr->tk_InitOptions) /* 211 */
#endif
#ifndef Tk_MainEx
#define Tk_MainEx \
	(tkStubsPtr->tk_MainEx) /* 212 */
#endif
#ifndef Tk_RestoreSavedOptions
#define Tk_RestoreSavedOptions \
	(tkStubsPtr->tk_RestoreSavedOptions) /* 213 */
#endif
#ifndef Tk_SetOptions
#define Tk_SetOptions \
	(tkStubsPtr->tk_SetOptions) /* 214 */
#endif

#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TKDECLS */

Changes to generic/tkEntry.c.

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
/* 
 * tkEntry.c --
 *
 *	This module implements entry widgets for the Tk
 *	toolkit.  An entry displays a string and allows
 *	the string to be edited.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkEntry.c 1.112 97/11/06 16:56:16
 */

#include "tkInt.h"
#include "default.h"

/*
 * A data structure of the following type is kept for each entry
 * widget managed by this file:
 */

typedef struct {
    Tk_Window tkwin;		/* Window that embodies the entry. NULL
				 * means that the window has been destroyed
				 * but the data structures haven't yet been
				 * cleaned up.*/
    Display *display;		/* Display containing widget.  Used, among
				 * other things, so that resources can be
				 * freed even after tkwin has gone away. */
    Tcl_Interp *interp;		/* Interpreter associated with entry. */
    Tcl_Command widgetCmd;	/* Token for entry's widget command. */




    /*
     * Fields that are set by widget commands other than "configure".
     */
     
    char *string;		/* Pointer to storage for string;
				 * NULL-terminated;  malloc-ed. */
    int insertPos;		/* Index of character before which next
				 * typed character will be inserted. */

    /*
     * Information about what's selected, if any.
     */

    int selectFirst;		/* Index of first selected character (-1 means
				 * nothing selected. */
    int selectLast;		/* Index of last selected character (-1 means
				 * nothing selected. */
    int selectAnchor;		/* Fixed end of selection (i.e. "select to"
				 * operation will use this as one end of the
				 * selection). */

    /*
     * Information for scanning:
     */

    int scanMarkX;		/* X-position at which scan started (e.g.
				 * button was pressed here). */
    int scanMarkIndex;		/* Index of character that was at left of
				 * window when scan started. */

    /*
     * Configuration settings that are updated by Tk_ConfigureWidget.
     */

    Tk_3DBorder normalBorder;	/* Used for drawing border around whole
				 * window, plus used for background. */








|




|




















>
>
>







|
|





|
|
|
|










|
|







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
/* 
 * tkEntry.c --
 *
 *	This module implements entry widgets for the Tk
 *	toolkit.  An entry displays a string and allows
 *	the string to be edited.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkEntry.c,v 1.1.4.6 1999/03/30 23:56:56 stanton Exp $
 */

#include "tkInt.h"
#include "default.h"

/*
 * A data structure of the following type is kept for each entry
 * widget managed by this file:
 */

typedef struct {
    Tk_Window tkwin;		/* Window that embodies the entry. NULL
				 * means that the window has been destroyed
				 * but the data structures haven't yet been
				 * cleaned up.*/
    Display *display;		/* Display containing widget.  Used, among
				 * other things, so that resources can be
				 * freed even after tkwin has gone away. */
    Tcl_Interp *interp;		/* Interpreter associated with entry. */
    Tcl_Command widgetCmd;	/* Token for entry's widget command. */
    Tk_OptionTable optionTable;	/* Table that defines configuration options
				 * available for this widget. */


    /*
     * Fields that are set by widget commands other than "configure".
     */
     
    char *string;		/* Pointer to storage for string;
				 * NULL-terminated;  malloc-ed. */
    int insertPos;		/* Character index before which next typed
				 * character will be inserted. */

    /*
     * Information about what's selected, if any.
     */

    int selectFirst;		/* Character index of first selected
				 * character (-1 means nothing selected. */
    int selectLast;		/* Character index just after last selected
				 * character (-1 means nothing selected. */
    int selectAnchor;		/* Fixed end of selection (i.e. "select to"
				 * operation will use this as one end of the
				 * selection). */

    /*
     * Information for scanning:
     */

    int scanMarkX;		/* X-position at which scan started (e.g.
				 * button was pressed here). */
    int scanMarkIndex;		/* Character index of character that was at
				 * left of window when scan started. */

    /*
     * Configuration settings that are updated by Tk_ConfigureWidget.
     */

    Tk_3DBorder normalBorder;	/* Used for drawing border around whole
				 * window, plus used for background. */
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
    Tk_3DBorder selBorder;	/* Border and background for selected
				 * characters. */
    int selBorderWidth;		/* Width of border around selection. */
    XColor *selFgColorPtr;	/* Foreground color for selected text. */
    char *showChar;		/* Value of -show option.  If non-NULL, first
				 * character is used for displaying all
				 * characters in entry.  Malloc'ed. */
    Tk_Uid state;		/* Normal or disabled.  Entry is read-only
				 * when disabled. */
    char *textVarName;		/* Name of variable (malloc'ed) or NULL.
				 * If non-NULL, entry's string tracks the
				 * contents of this variable and vice versa. */
    char *takeFocus;		/* Value of -takefocus option;  not used in
				 * the C code, but used by keyboard traversal
				 * scripts.  Malloc'ed, but may be NULL. */
    int prefWidth;		/* Desired width of window, measured in
				 * average characters. */
    char *scrollCmd;		/* Command prefix for communicating with
				 * scrollbar(s).  Malloc'ed.  NULL means
				 * no command to issue. */

    /*
     * Fields whose values are derived from the current values of the
     * configuration settings above.
     */


    int numChars;		/* Number of non-NULL characters in
				 * string (may be 0). */



    char *displayString;	/* If non-NULL, points to string with same


				 * length as string but whose characters
				 * are all equal to showChar.  Malloc'ed. */

    int inset;			/* Number of pixels on the left and right
				 * sides that are taken up by XPAD, borderWidth
				 * (if any), and highlightWidth (if any). */
    Tk_TextLayout textLayout;	/* Cached text layout information. */
    int layoutX, layoutY;	/* Origin for layout. */
    int leftIndex;		/* Index of left-most character visible in
				 * window. */
    int leftX;			/* X position at which character at leftIndex
				 * is drawn (varies depending on justify). */


    Tcl_TimerToken insertBlinkHandler;
				/* Timer handler used to blink cursor on and
				 * off. */
    GC textGC;			/* For drawing normal text. */
    GC selTextGC;		/* For drawing selected text. */
    GC highlightGC;		/* For drawing traversal highlight. */
    int avgWidth;		/* Width of average character. */







|


















>
|
|
>
>
>
|
>
>

|
>





<
<


>
>







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
    Tk_3DBorder selBorder;	/* Border and background for selected
				 * characters. */
    int selBorderWidth;		/* Width of border around selection. */
    XColor *selFgColorPtr;	/* Foreground color for selected text. */
    char *showChar;		/* Value of -show option.  If non-NULL, first
				 * character is used for displaying all
				 * characters in entry.  Malloc'ed. */
    int state;		        /* Normal or disabled.  Entry is read-only
				 * when disabled. */
    char *textVarName;		/* Name of variable (malloc'ed) or NULL.
				 * If non-NULL, entry's string tracks the
				 * contents of this variable and vice versa. */
    char *takeFocus;		/* Value of -takefocus option;  not used in
				 * the C code, but used by keyboard traversal
				 * scripts.  Malloc'ed, but may be NULL. */
    int prefWidth;		/* Desired width of window, measured in
				 * average characters. */
    char *scrollCmd;		/* Command prefix for communicating with
				 * scrollbar(s).  Malloc'ed.  NULL means
				 * no command to issue. */

    /*
     * Fields whose values are derived from the current values of the
     * configuration settings above.
     */

    int numBytes;		/* Length of string in bytes. */
    int numChars;		/* Length of string in characters.  Both
				 * string and displayString have the same
				 * character length, but may have different
				 * byte lengths due to being made from
				 * different UTF-8 characters. */
    char *displayString;	/* String to use when displaying.  This may
				 * be a pointer to string, or a pointer to
				 * malloced memory with the same character
				 * length as string but whose characters
				 * are all equal to showChar. */
    int numDisplayBytes;	/* Length of displayString in bytes. */
    int inset;			/* Number of pixels on the left and right
				 * sides that are taken up by XPAD, borderWidth
				 * (if any), and highlightWidth (if any). */
    Tk_TextLayout textLayout;	/* Cached text layout information. */
    int layoutX, layoutY;	/* Origin for layout. */


    int leftX;			/* X position at which character at leftIndex
				 * is drawn (varies depending on justify). */
    int leftIndex;		/* Character index of left-most character
				 * visible in window. */
    Tcl_TimerToken insertBlinkHandler;
				/* Timer handler used to blink cursor on and
				 * off. */
    GC textGC;			/* For drawing normal text. */
    GC selTextGC;		/* For drawing selected text. */
    GC highlightGC;		/* For drawing traversal highlight. */
    int avgWidth;		/* Width of average character. */
163
164
165
166
167
168
169

170
171
172
173
174
175
176
177
178














179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195

196
197

198
199
200
201
202
203
204
205
206

207
208
209

210
211

212
213
214
215
216
217
218
219
220

221
222
223
224

225
226

227
228

229
230
231
232

233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252

253
254

255
256

257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275


























276
277
278
279
280
281
282
283
284
285
286
287
288
289

#define REDRAW_PENDING		1
#define BORDER_NEEDED		2
#define CURSOR_ON		4
#define GOT_FOCUS		8
#define UPDATE_SCROLLBAR	0x10
#define GOT_SELECTION		0x20


/*
 * The following macro defines how many extra pixels to leave on each
 * side of the text in the entry.
 */

#define XPAD 1
#define YPAD 1















/*
 * Information used for argv parsing.
 */

static Tk_ConfigSpec configSpecs[] = {
    {TK_CONFIG_BORDER, "-background", "background", "Background",
	DEF_ENTRY_BG_COLOR, Tk_Offset(Entry, normalBorder),
	TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_BORDER, "-background", "background", "Background",
	DEF_ENTRY_BG_MONO, Tk_Offset(Entry, normalBorder),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	DEF_ENTRY_BORDER_WIDTH, Tk_Offset(Entry, borderWidth), 0},

    {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
	DEF_ENTRY_CURSOR, Tk_Offset(Entry, cursor), TK_CONFIG_NULL_OK},

    {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
	"ExportSelection", DEF_ENTRY_EXPORT_SELECTION,
	Tk_Offset(Entry, exportSelection), 0},
    {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_FONT, "-font", "font", "Font",
	DEF_ENTRY_FONT, Tk_Offset(Entry, tkfont), 0},
    {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
	DEF_ENTRY_FG, Tk_Offset(Entry, fgColorPtr), 0},

    {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
	"HighlightBackground", DEF_ENTRY_HIGHLIGHT_BG,
	Tk_Offset(Entry, highlightBgColorPtr), 0},

    {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
	DEF_ENTRY_HIGHLIGHT, Tk_Offset(Entry, highlightColorPtr), 0},

    {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
	"HighlightThickness",
	DEF_ENTRY_HIGHLIGHT_WIDTH, Tk_Offset(Entry, highlightWidth), 0},
    {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
	DEF_ENTRY_INSERT_BG, Tk_Offset(Entry, insertBorder), 0},
    {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
	DEF_ENTRY_INSERT_BD_COLOR, Tk_Offset(Entry, insertBorderWidth),
	TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",

	DEF_ENTRY_INSERT_BD_MONO, Tk_Offset(Entry, insertBorderWidth),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
	DEF_ENTRY_INSERT_OFF_TIME, Tk_Offset(Entry, insertOffTime), 0},

    {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
	DEF_ENTRY_INSERT_ON_TIME, Tk_Offset(Entry, insertOnTime), 0},

    {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
	DEF_ENTRY_INSERT_WIDTH, Tk_Offset(Entry, insertWidth), 0},

    {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify",
	DEF_ENTRY_JUSTIFY, Tk_Offset(Entry, justify), 0},
    {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
	DEF_ENTRY_RELIEF, Tk_Offset(Entry, relief), 0},

    {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
	DEF_ENTRY_SELECT_COLOR, Tk_Offset(Entry, selBorder),
	TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
	DEF_ENTRY_SELECT_MONO, Tk_Offset(Entry, selBorder),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
	DEF_ENTRY_SELECT_BD_COLOR, Tk_Offset(Entry, selBorderWidth),
	TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
	DEF_ENTRY_SELECT_BD_MONO, Tk_Offset(Entry, selBorderWidth),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
	DEF_ENTRY_SELECT_FG_COLOR, Tk_Offset(Entry, selFgColorPtr),
	TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
	DEF_ENTRY_SELECT_FG_MONO, Tk_Offset(Entry, selFgColorPtr),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_STRING, "-show", "show", "Show",
	DEF_ENTRY_SHOW, Tk_Offset(Entry, showChar), TK_CONFIG_NULL_OK},

    {TK_CONFIG_UID, "-state", "state", "State",
	DEF_ENTRY_STATE, Tk_Offset(Entry, state), 0},

    {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
	DEF_ENTRY_TAKE_FOCUS, Tk_Offset(Entry, takeFocus), TK_CONFIG_NULL_OK},

    {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable",
	DEF_ENTRY_TEXT_VARIABLE, Tk_Offset(Entry, textVarName),
	TK_CONFIG_NULL_OK},
    {TK_CONFIG_INT, "-width", "width", "Width",
	DEF_ENTRY_WIDTH, Tk_Offset(Entry, prefWidth), 0},
    {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
	DEF_ENTRY_SCROLL_COMMAND, Tk_Offset(Entry, scrollCmd),
	TK_CONFIG_NULL_OK},
    {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, 0}
};

/*
 * Flags for GetEntryIndex procedure:
 */

#define ZERO_OK			1
#define LAST_PLUS_ONE_OK	2



























/*
 * Forward declarations for procedures defined later in this file:
 */

static int		ConfigureEntry _ANSI_ARGS_((Tcl_Interp *interp,
			    Entry *entryPtr, int argc, char **argv,
			    int flags));
static void		DeleteChars _ANSI_ARGS_((Entry *entryPtr, int index,
			    int count));
static void		DestroyEntry _ANSI_ARGS_((char *memPtr));
static void		DisplayEntry _ANSI_ARGS_((ClientData clientData));
static void		EntryBlinkProc _ANSI_ARGS_((ClientData clientData));
static void		EntryCmdDeletedProc _ANSI_ARGS_((
			    ClientData clientData));







>









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




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

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

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









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





|
|







173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210


211

212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243

244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265


266

267
268


269
270
271
272


273

274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341

#define REDRAW_PENDING		1
#define BORDER_NEEDED		2
#define CURSOR_ON		4
#define GOT_FOCUS		8
#define UPDATE_SCROLLBAR	0x10
#define GOT_SELECTION		0x20
#define ENTRY_DELETED           0x40

/*
 * The following macro defines how many extra pixels to leave on each
 * side of the text in the entry.
 */

#define XPAD 1
#define YPAD 1

/*
 * The following enum is used to define a type for the -state option
 * of the Entry widget.  These values are used as indices into the 
 * string table below.
 */

enum state {
    STATE_DISABLED, STATE_NORMAL
};

static char *stateStrings[] = {
    "disabled", "normal", (char *) NULL
};

/*
 * Information used for argv parsing.
 */

static Tk_OptionSpec optionSpecs[] = {
    {TK_OPTION_BORDER, "-background", "background", "Background",
	DEF_ENTRY_BG_COLOR, -1, Tk_Offset(Entry, normalBorder),


	0, (ClientData) DEF_ENTRY_BG_MONO, 0},

    {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
    {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	DEF_ENTRY_BORDER_WIDTH, -1, Tk_Offset(Entry, borderWidth), 
        0, 0, 0},
    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
	DEF_ENTRY_CURSOR, -1, Tk_Offset(Entry, cursor),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
        "ExportSelection", DEF_ENTRY_EXPORT_SELECTION, -1, 
        Tk_Offset(Entry, exportSelection), 0, 0, 0},
    {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
    {TK_OPTION_FONT, "-font", "font", "Font",
	DEF_ENTRY_FONT, -1, Tk_Offset(Entry, tkfont), 0, 0, 0},
    {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
	DEF_ENTRY_FG, -1, Tk_Offset(Entry, fgColorPtr), 0, 
        0, 0},
    {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
	"HighlightBackground", DEF_ENTRY_HIGHLIGHT_BG,
	-1, Tk_Offset(Entry, highlightBgColorPtr), 
        0, 0, 0},
    {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
	DEF_ENTRY_HIGHLIGHT, -1, Tk_Offset(Entry, highlightColorPtr),
	0, 0, 0},
    {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
	"HighlightThickness", DEF_ENTRY_HIGHLIGHT_WIDTH, -1, 
	Tk_Offset(Entry, highlightWidth), 0, 0, 0},
    {TK_OPTION_BORDER, "-insertbackground", "insertBackground", "Foreground",
	DEF_ENTRY_INSERT_BG,

	-1, Tk_Offset(Entry, insertBorder), 
        0, 0, 0},
    {TK_OPTION_PIXELS, "-insertborderwidth", "insertBorderWidth", 
        "BorderWidth", DEF_ENTRY_INSERT_BD_COLOR, -1, 
        Tk_Offset(Entry, insertBorderWidth), 0, 
        (ClientData) DEF_ENTRY_INSERT_BD_MONO, 0},
    {TK_OPTION_INT, "-insertofftime", "insertOffTime", "OffTime",
        DEF_ENTRY_INSERT_OFF_TIME, -1, Tk_Offset(Entry, insertOffTime), 
        0, 0, 0},
    {TK_OPTION_INT, "-insertontime", "insertOnTime", "OnTime",
        DEF_ENTRY_INSERT_ON_TIME, -1, Tk_Offset(Entry, insertOnTime), 
        0, 0, 0},
    {TK_OPTION_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
	DEF_ENTRY_INSERT_WIDTH, -1, Tk_Offset(Entry, insertWidth), 
        0, 0, 0},
    {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
	DEF_ENTRY_JUSTIFY, -1, Tk_Offset(Entry, justify), 0, 0, 0},
    {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
	DEF_ENTRY_RELIEF, -1, Tk_Offset(Entry, relief), 
        0, 0, 0},
    {TK_OPTION_BORDER, "-selectbackground", "selectBackground", "Foreground",
        DEF_ENTRY_SELECT_COLOR, -1, Tk_Offset(Entry, selBorder),


        0, (ClientData) DEF_ENTRY_SELECT_MONO, 0},

    {TK_OPTION_PIXELS, "-selectborderwidth", "selectBorderWidth", 
        "BorderWidth", DEF_ENTRY_SELECT_BD_COLOR, -1, 


        Tk_Offset(Entry, selBorderWidth), 
        0, (ClientData) DEF_ENTRY_SELECT_BD_MONO, 0},
    {TK_OPTION_COLOR, "-selectforeground", "selectForeground", "Background",
	DEF_ENTRY_SELECT_FG_COLOR, -1, Tk_Offset(Entry, selFgColorPtr),


	0, (ClientData) DEF_ENTRY_SELECT_FG_MONO, 0},

    {TK_CONFIG_STRING, "-show", "show", "Show",
        DEF_ENTRY_SHOW, -1, Tk_Offset(Entry, showChar), 
        TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_STRING_TABLE, "-state", "state", "State",
	DEF_ENTRY_STATE, -1, Tk_Offset(Entry, state), 
        0, (ClientData) stateStrings, 0},
    {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
	DEF_ENTRY_TAKE_FOCUS, -1, Tk_Offset(Entry, takeFocus), 
        TK_CONFIG_NULL_OK, 0, 0},
    {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
	DEF_ENTRY_TEXT_VARIABLE, -1, Tk_Offset(Entry, textVarName),
	TK_CONFIG_NULL_OK, 0, 0},
    {TK_OPTION_INT, "-width", "width", "Width",
	DEF_ENTRY_WIDTH, -1, Tk_Offset(Entry, prefWidth), 0, 0, 0},
    {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
	DEF_ENTRY_SCROLL_COMMAND, -1, Tk_Offset(Entry, scrollCmd),
	TK_CONFIG_NULL_OK, 0, 0},
    {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, 0, 0}
};

/*
 * Flags for GetEntryIndex procedure:
 */

#define ZERO_OK			1
#define LAST_PLUS_ONE_OK	2

/*
 * The following tables define the entry widget commands (and sub-
 * commands) and map the indexes into the string tables into 
 * enumerated types used to dispatch the entry widget command.
 */

static char *commandNames[] = {
    "bbox", "cget", "configure", "delete", "get", "icursor", "index", 
    "insert", "scan", "selection", "xview", (char *) NULL
};

enum command {
    COMMAND_BBOX, COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DELETE, 
    COMMAND_GET, COMMAND_ICURSOR, COMMAND_INDEX, COMMAND_INSERT, 
    COMMAND_SCAN, COMMAND_SELECTION, COMMAND_XVIEW
};

static char *selCommandNames[] = {
    "adjust", "clear", "from", "present", "range", "to", (char *) NULL
};

enum selcommand {
    SELECTION_ADJUST, SELECTION_CLEAR, SELECTION_FROM, 
    SELECTION_PRESENT, SELECTION_RANGE, SELECTION_TO
};

/*
 * Forward declarations for procedures defined later in this file:
 */

static int		ConfigureEntry _ANSI_ARGS_((Tcl_Interp *interp,
			    Entry *entryPtr, int objc, 
                            Tcl_Obj *CONST objv[], int flags));
static void		DeleteChars _ANSI_ARGS_((Entry *entryPtr, int index,
			    int count));
static void		DestroyEntry _ANSI_ARGS_((char *memPtr));
static void		DisplayEntry _ANSI_ARGS_((ClientData clientData));
static void		EntryBlinkProc _ANSI_ARGS_((ClientData clientData));
static void		EntryCmdDeletedProc _ANSI_ARGS_((
			    ClientData clientData));
305
306
307
308
309
310
311
312
313

314
315
316
317
318
319
320
static char *		EntryTextVarProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, char *name1, char *name2,
			    int flags));
static void		EntryUpdateScrollbar _ANSI_ARGS_((Entry *entryPtr));
static void		EntryValueChanged _ANSI_ARGS_((Entry *entryPtr));
static void		EntryVisibleRange _ANSI_ARGS_((Entry *entryPtr,
			    double *firstPtr, double *lastPtr));
static int		EntryWidgetCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));

static void		EntryWorldChanged _ANSI_ARGS_((
			    ClientData instanceData));
static int		GetEntryIndex _ANSI_ARGS_((Tcl_Interp *interp,
			    Entry *entryPtr, char *string, int *indexPtr));
static void		InsertChars _ANSI_ARGS_((Entry *entryPtr, int index,
			    char *string));








|
|
>







357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
static char *		EntryTextVarProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, char *name1, char *name2,
			    int flags));
static void		EntryUpdateScrollbar _ANSI_ARGS_((Entry *entryPtr));
static void		EntryValueChanged _ANSI_ARGS_((Entry *entryPtr));
static void		EntryVisibleRange _ANSI_ARGS_((Entry *entryPtr,
			    double *firstPtr, double *lastPtr));
static int		EntryWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
static void		EntryWorldChanged _ANSI_ARGS_((
			    ClientData instanceData));
static int		GetEntryIndex _ANSI_ARGS_((Tcl_Interp *interp,
			    Entry *entryPtr, char *string, int *indexPtr));
static void		InsertChars _ANSI_ARGS_((Entry *entryPtr, int index,
			    char *string));

329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360

361
362




363






364






365


366
367
368
369

370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386

387
388
389
390
391
392
393
    NULL			/* modalProc. */
};


/*
 *--------------------------------------------------------------
 *
 * Tk_EntryCmd --
 *
 *	This procedure is invoked to process the "entry" Tcl
 *	command.  See the user documentation for details on what
 *	it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_EntryCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    Tk_Window tkwin = (Tk_Window) clientData;
    register Entry *entryPtr;

    Tk_Window new;





    if (argc < 2) {






	Tcl_AppendResult(interp, "wrong # args: should be \"",






		argv[0], " pathName ?options?\"", (char *) NULL);


	return TCL_ERROR;
    }

    new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);

    if (new == NULL) {
	return TCL_ERROR;
    }

    /*
     * Initialize the fields of the structure that won't be initialized
     * by ConfigureEntry, or that ConfigureEntry requires to be
     * initialized already (e.g. resource pointers).
     */

    entryPtr = (Entry *) ckalloc(sizeof(Entry));
    entryPtr->tkwin = new;
    entryPtr->display = Tk_Display(new);
    entryPtr->interp = interp;
    entryPtr->widgetCmd = Tcl_CreateCommand(interp,
	    Tk_PathName(entryPtr->tkwin), EntryWidgetCmd,
	    (ClientData) entryPtr, EntryCmdDeletedProc);

    entryPtr->string = (char *) ckalloc(1);
    entryPtr->string[0] = '\0';
    entryPtr->insertPos = 0;
    entryPtr->selectFirst = -1;
    entryPtr->selectLast = -1;
    entryPtr->selectAnchor = 0;
    entryPtr->scanMarkX = 0;







|















|
|
<

|
|

<

>
|

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



|
>
|










|
|

|
|

>







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
    NULL			/* modalProc. */
};


/*
 *--------------------------------------------------------------
 *
 * Tk_EntryObjCmd --
 *
 *	This procedure is invoked to process the "entry" Tcl
 *	command.  See the user documentation for details on what
 *	it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_EntryObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Either NULL or pointer to option table. */

    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];      /* Argument objects. */
{

    register Entry *entryPtr;
    Tk_OptionTable optionTable;
    Tk_Window tkwin;

    optionTable = (Tk_OptionTable) clientData;
    if (optionTable == NULL) {
	Tcl_CmdInfo info;
	char *name;

	/*
	 * We haven't created the option table for this widget class
	 * yet.  Do it now and save the table as the clientData for
	 * the command, so we'll have access to it in future
	 * invocations of the command.
	 */

	optionTable = Tk_CreateOptionTable(interp, optionSpecs);
	name = Tcl_GetString(objv[0]);
	Tcl_GetCommandInfo(interp, name, &info);
	info.objClientData = (ClientData) optionTable;
	Tcl_SetCommandInfo(interp, name, &info);
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
	return TCL_ERROR;
    }

    tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
            Tcl_GetString(objv[1]), (char *) NULL);
    if (tkwin == NULL) {
	return TCL_ERROR;
    }

    /*
     * Initialize the fields of the structure that won't be initialized
     * by ConfigureEntry, or that ConfigureEntry requires to be
     * initialized already (e.g. resource pointers).
     */

    entryPtr = (Entry *) ckalloc(sizeof(Entry));
    entryPtr->tkwin = tkwin;
    entryPtr->display = Tk_Display(tkwin);
    entryPtr->interp = interp;
    entryPtr->widgetCmd = Tcl_CreateObjCommand(interp,
	    Tk_PathName(entryPtr->tkwin), EntryWidgetObjCmd,
	    (ClientData) entryPtr, EntryCmdDeletedProc);
    entryPtr->optionTable = optionTable;
    entryPtr->string = (char *) ckalloc(1);
    entryPtr->string[0] = '\0';
    entryPtr->insertPos = 0;
    entryPtr->selectFirst = -1;
    entryPtr->selectLast = -1;
    entryPtr->selectAnchor = 0;
    entryPtr->scanMarkX = 0;
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423

424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443






444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492




493





494
495

496


497
498
499
500
501
502
503
504

505
506
507
508
509

510

511
512



513
514

515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536

537
538


539
540

541


542


543

544



545


546









547
548
549
550

551
552
553
554
555
556
557
558
559
560
561
562
563
564
565

566
567
568
569
570
571
572
573
574
575
576
577
578
579
580

581
582
583
584
585
586

587
588

589

590
591
592



593
594
595
596
597
598
599
600

601
602
603
604


605
606
607

608
609
610
611
612
613
614

615
616
617
618
619
620
621

622

623
624
625


626

627
628
629
630
631
632



633

634







635

636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651

652
653
654
655
656
657
658
659
660
661
662
663




664

665
666
667
668
669
670

671
672
673
674




675
676
677
678
679
680

681

682
683
684
685
686
687
688
689
690
691
692
693


694














695
696
697
698













699
700
701






702

703
704
705
706
707
708
709

710
711




712
713

714
715
716
717
718
719
720
721
722
723
724


725

726
727
728
729
730
731




732
733
734
735
736


737
738
739

740
741
742
743



744
745

746
747
748

749
750
751


752
753
754

755
756

757
758
759

760


761

762
763
764
765
766
767

768
769
770
771
772

773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789


790
791
792
793
794
795
796
    entryPtr->insertWidth = 0;
    entryPtr->justify = TK_JUSTIFY_LEFT;
    entryPtr->relief = TK_RELIEF_FLAT;
    entryPtr->selBorder = NULL;
    entryPtr->selBorderWidth = 0;
    entryPtr->selFgColorPtr = NULL;
    entryPtr->showChar = NULL;
    entryPtr->state = tkNormalUid;
    entryPtr->textVarName = NULL;
    entryPtr->takeFocus = NULL;
    entryPtr->prefWidth = 0;
    entryPtr->scrollCmd = NULL;

    entryPtr->numChars = 0;
    entryPtr->displayString = NULL;

    entryPtr->inset = XPAD;
    entryPtr->textLayout = NULL;
    entryPtr->layoutX = 0;
    entryPtr->layoutY = 0;
    entryPtr->leftIndex = 0;
    entryPtr->leftX = 0;
    entryPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
    entryPtr->textGC = None;
    entryPtr->selTextGC = None;
    entryPtr->highlightGC = None;
    entryPtr->avgWidth = 1;
    entryPtr->flags = 0;

    Tk_SetClass(entryPtr->tkwin, "Entry");
    TkSetClassProcs(entryPtr->tkwin, &entryClass, (ClientData) entryPtr);
    Tk_CreateEventHandler(entryPtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    EntryEventProc, (ClientData) entryPtr);
    Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING,
	    EntryFetchSelection, (ClientData) entryPtr, XA_STRING);






    if (ConfigureEntry(interp, entryPtr, argc-2, argv+2, 0) != TCL_OK) {
	goto error;
    }

    interp->result = Tk_PathName(entryPtr->tkwin);
    return TCL_OK;

    error:
    Tk_DestroyWindow(entryPtr->tkwin);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * EntryWidgetCmd --
 *
 *	This procedure is invoked to process the Tcl command
 *	that corresponds to a widget managed by this module.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
EntryWidgetCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Information about entry widget. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    register Entry *entryPtr = (Entry *) clientData;
    int result = TCL_OK;
    size_t length;
    int c;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option ?arg arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    Tcl_Preserve((ClientData) entryPtr);
    c = argv[1][0];




    length = strlen(argv[1]);





    if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
	int index;

	int x, y, width, height;



	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " bbox index\"",
		    (char *) NULL);
	    goto error;
	}
	if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) {

	    goto error;
	}
	if ((index == entryPtr->numChars) && (index > 0)) {
	    index--;
	}

	Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height);

	sprintf(interp->result, "%d %d %d %d",
		x + entryPtr->layoutX, y + entryPtr->layoutY, width, height);



    } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
	    && (length >= 2)) {

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " cget option\"",
		    (char *) NULL);
	    goto error;
	}
	result = Tk_ConfigureValue(interp, entryPtr->tkwin, configSpecs,
		(char *) entryPtr, argv[2], 0);
    } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
	    && (length >= 2)) {
	if (argc == 2) {
	    result = Tk_ConfigureInfo(interp, entryPtr->tkwin, configSpecs,
		    (char *) entryPtr, (char *) NULL, 0);
	} else if (argc == 3) {
	    result = Tk_ConfigureInfo(interp, entryPtr->tkwin, configSpecs,
		    (char *) entryPtr, argv[2], 0);
	} else {
	    result = ConfigureEntry(interp, entryPtr, argc-2, argv+2,
		    TK_CONFIG_ARGV_ONLY);
	}
    } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
	int first, last;


	if ((argc < 3) || (argc > 4)) {


	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " delete firstIndex ?lastIndex?\"",

		    (char *) NULL);


	    goto error;


	}

	if (GetEntryIndex(interp, entryPtr, argv[2], &first) != TCL_OK) {



	    goto error;


	}









	if (argc == 3) {
	    last = first+1;
	} else {
	    if (GetEntryIndex(interp, entryPtr, argv[3], &last) != TCL_OK) {

		goto error;
	    }
	}
	if ((last >= first) && (entryPtr->state == tkNormalUid)) {
	    DeleteChars(entryPtr, first, last-first);
	}
    } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
	if (argc != 2) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " get\"", (char *) NULL);
	    goto error;
	}
	interp->result = entryPtr->string;
    } else if ((c == 'i') && (strncmp(argv[1], "icursor", length) == 0)
	    && (length >= 2)) {

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " icursor pos\"",
		    (char *) NULL);
	    goto error;
	}
	if (GetEntryIndex(interp, entryPtr, argv[2], &entryPtr->insertPos)
		!= TCL_OK) {
	    goto error;
	}
	EventuallyRedraw(entryPtr);
    } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
	    && (length >= 3)) {
	int index;


	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " index string\"", (char *) NULL);
	    goto error;
	}
	if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) {

	    goto error;
	}

	sprintf(interp->result, "%d", index);

    } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
	    && (length >= 3)) {
	int index;




	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " insert index text\"",
		    (char *) NULL);
	    goto error;
	}
	if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) {

	    goto error;
	}
	if (entryPtr->state == tkNormalUid) {
	    InsertChars(entryPtr, index, argv[3]);


	}
    } else if ((c == 's') && (length >= 2)
	    && (strncmp(argv[1], "scan", length) == 0)) {

	int x;

	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " scan mark|dragto x\"", (char *) NULL);
	    goto error;
	}

	if (Tcl_GetInt(interp, argv[3], &x) != TCL_OK) {
	    goto error;
	}
	if ((argv[2][0] == 'm')
		&& (strncmp(argv[2], "mark", strlen(argv[2])) == 0)) {
	    entryPtr->scanMarkX = x;
	    entryPtr->scanMarkIndex = entryPtr->leftIndex;

	} else if ((argv[2][0] == 'd')

		&& (strncmp(argv[2], "dragto", strlen(argv[2])) == 0)) {
	    EntryScanTo(entryPtr, x);
	} else {


	    Tcl_AppendResult(interp, "bad scan option \"", argv[2],

		    "\": must be mark or dragto", (char *) NULL);
	    goto error;
	}
    } else if ((c == 's') && (length >= 2)
	    && (strncmp(argv[1], "selection", length) == 0)) {
	int index, index2;





	if (argc < 3) {







	    Tcl_AppendResult(interp, "wrong # args: should be \"",

		    argv[0], " select option ?index?\"", (char *) NULL);
	    goto error;
	}
	length = strlen(argv[2]);
	c = argv[2][0];
	if ((c == 'c') && (strncmp(argv[2], "clear", length) == 0)) {
	    if (argc != 3) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
			argv[0], " selection clear\"", (char *) NULL);
		goto error;
	    }
	    if (entryPtr->selectFirst != -1) {
		entryPtr->selectFirst = entryPtr->selectLast = -1;
		EventuallyRedraw(entryPtr);
	    }
	    goto done;

	} else if ((c == 'p') && (strncmp(argv[2], "present", length) == 0)) {
	    if (argc != 3) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
			argv[0], " selection present\"", (char *) NULL);
		goto error;
	    }
	    if (entryPtr->selectFirst == -1) {
		interp->result = "0";
	    } else {
		interp->result = "1";
	    }
	    goto done;




	}

	if (argc >= 4) {
	    if (GetEntryIndex(interp, entryPtr, argv[3], &index) != TCL_OK) {
		goto error;
	    }
	}
	if ((c == 'a') && (strncmp(argv[2], "adjust", length) == 0)) {

	    if (argc != 4) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
			argv[0], " selection adjust index\"",
			(char *) NULL);




		goto error;
	    }
	    if (entryPtr->selectFirst >= 0) {
		int half1, half2;

		half1 = (entryPtr->selectFirst + entryPtr->selectLast)/2;

		half2 = (entryPtr->selectFirst + entryPtr->selectLast + 1)/2;

		if (index < half1) {
		    entryPtr->selectAnchor = entryPtr->selectLast;
		} else if (index > half2) {
		    entryPtr->selectAnchor = entryPtr->selectFirst;
		} else {
		    /*
		     * We're at about the halfway point in the selection;
		     * just keep the existing anchor.
		     */
		}
	    }
	    EntrySelectTo(entryPtr, index);


	} else if ((c == 'f') && (strncmp(argv[2], "from", length) == 0)) {














	    if (argc != 4) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
			argv[0], " selection from index\"",
			(char *) NULL);













		goto error;
	    }
	    entryPtr->selectAnchor = index;






	} else if ((c == 'r') && (strncmp(argv[2], "range", length) == 0)) {

	    if (argc != 5) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
			argv[0], " selection range start end\"",
			(char *) NULL);
		goto error;
	    }
	    if (GetEntryIndex(interp, entryPtr, argv[4], &index2) != TCL_OK) {

		goto error;
	    }




	    if (index >= index2) {
		entryPtr->selectFirst = entryPtr->selectLast = -1;

	    } else {
		entryPtr->selectFirst = index;
		entryPtr->selectLast = index2;
	    }
	    if (!(entryPtr->flags & GOT_SELECTION)
		    && (entryPtr->exportSelection)) {
		Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, 
			EntryLostSelection, (ClientData) entryPtr);
		entryPtr->flags |= GOT_SELECTION;
	    }
	    EventuallyRedraw(entryPtr);


	} else if ((c == 't') && (strncmp(argv[2], "to", length) == 0)) {

	    if (argc != 4) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
			argv[0], " selection to index\"",
			(char *) NULL);
		goto error;
	    }




	    EntrySelectTo(entryPtr, index);
	} else {
	    Tcl_AppendResult(interp, "bad selection option \"", argv[2],
		    "\": must be adjust, clear, from, present, range, or to",
		    (char *) NULL);


	    goto error;
	}
    } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {

	int index, type, count, charsPerPage;
	double fraction, first, last;

	if (argc == 2) {



	    EntryVisibleRange(entryPtr, &first, &last);
	    sprintf(interp->result, "%g %g", first, last);

	    goto done;
	} else if (argc == 3) {
	    if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) {

		goto error;
	    }
	} else {


	    type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
	    index = entryPtr->leftIndex;
	    switch (type) {

		case TK_SCROLL_ERROR:
		    goto error;

		case TK_SCROLL_MOVETO:
		    index = (int) ((fraction * entryPtr->numChars) + 0.5);
		    break;

		case TK_SCROLL_PAGES:


		    charsPerPage = ((Tk_Width(entryPtr->tkwin)

			    - 2*entryPtr->inset) / entryPtr->avgWidth) - 2;
		    if (charsPerPage < 1) {
			charsPerPage = 1;
		    }
		    index += charsPerPage*count;
		    break;

		case TK_SCROLL_UNITS:
		    index += count;
		    break;
	    }
	}

	if (index >= entryPtr->numChars) {
	    index = entryPtr->numChars-1;
	}
	if (index < 0) {
	    index = 0;
	}
	entryPtr->leftIndex = index;
	entryPtr->flags |= UPDATE_SCROLLBAR;
	EntryComputeGeometry(entryPtr);
	EventuallyRedraw(entryPtr);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be bbox, cget, configure, delete, get, ",
		"icursor, index, insert, scan, selection, or xview",
		(char *) NULL);
	goto error;
    }


    done:
    Tcl_Release((ClientData) entryPtr);
    return result;

    error:
    Tcl_Release((ClientData) entryPtr);
    return TCL_ERROR;







|




|

|
>




|
|














>
>
>
>
>
>
|


|
|










|















|
|
|
|
|

|
|
|
<

|
<
|



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

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

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

<
<
<
<

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

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

|
<
>
|

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

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


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

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

|
>
|
<

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







481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562

563
564

565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587

588

589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606

607
608
609


610
611
612
613



614

615

616
617
618

619


620
621
622
623
624
625

626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662




663
664
665


666
667
668


669
670
671

672
673




674
675
676
677

678
679
680
681
682
683
684
685
686
687


688
689
690
691
692
693


694
695
696
697
698
699

700
701
702
703
704

705
706
707
708
709

710
711
712
713
714
715


716
717
718
719
720
721

722
723
724
725
726
727
728
729



730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747






748
749



750
751
752
753
754
755

756
757




758

759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774

775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819

820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846

847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877

878
879
880
881
882
883
884
885



886
887
888
889
890
891
892

893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949





950
951
952
953
954
955
956
957
958
959
    entryPtr->insertWidth = 0;
    entryPtr->justify = TK_JUSTIFY_LEFT;
    entryPtr->relief = TK_RELIEF_FLAT;
    entryPtr->selBorder = NULL;
    entryPtr->selBorderWidth = 0;
    entryPtr->selFgColorPtr = NULL;
    entryPtr->showChar = NULL;
    entryPtr->state = STATE_NORMAL;
    entryPtr->textVarName = NULL;
    entryPtr->takeFocus = NULL;
    entryPtr->prefWidth = 0;
    entryPtr->scrollCmd = NULL;
    entryPtr->numBytes = 0;
    entryPtr->numChars = 0;
    entryPtr->displayString = entryPtr->string;
    entryPtr->numDisplayBytes = 0;
    entryPtr->inset = XPAD;
    entryPtr->textLayout = NULL;
    entryPtr->layoutX = 0;
    entryPtr->layoutY = 0;
    entryPtr->leftX = 0;
    entryPtr->leftIndex = 0;
    entryPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
    entryPtr->textGC = None;
    entryPtr->selTextGC = None;
    entryPtr->highlightGC = None;
    entryPtr->avgWidth = 1;
    entryPtr->flags = 0;

    Tk_SetClass(entryPtr->tkwin, "Entry");
    TkSetClassProcs(entryPtr->tkwin, &entryClass, (ClientData) entryPtr);
    Tk_CreateEventHandler(entryPtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    EntryEventProc, (ClientData) entryPtr);
    Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING,
	    EntryFetchSelection, (ClientData) entryPtr, XA_STRING);

    if (Tk_InitOptions(interp, (char *) entryPtr, optionTable, tkwin)
	    != TCL_OK) {
	Tk_DestroyWindow(entryPtr->tkwin);
	return TCL_ERROR;
    }
    if (ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0) != TCL_OK) {
	goto error;
    }
    
    Tcl_SetResult(interp, Tk_PathName(entryPtr->tkwin), TCL_STATIC);
    return TCL_OK;

    error:
    Tk_DestroyWindow(entryPtr->tkwin);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * EntryWidgetObjCmd --
 *
 *	This procedure is invoked to process the Tcl command
 *	that corresponds to a widget managed by this module.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
EntryWidgetObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Information about entry widget. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    Entry *entryPtr = (Entry *) clientData;
    int cmdIndex, selIndex, result;
    Tcl_Obj *objPtr;


    if (objc < 2) {

	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
	return TCL_ERROR;
    }
    Tcl_Preserve((ClientData) entryPtr);

    /* 
     * Parse the widget command by looking up the second token in
     * the list of valid command names. 
     */

    result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
	    "option", 0, &cmdIndex);
    if (result != TCL_OK) {
	return result;
    }

    switch (cmdIndex) {
        case COMMAND_BBOX: {
	    int index, x, y, width, height;
	    char *string;
	    char buf[TCL_INTEGER_SPACE * 4];

	    if (objc != 3) {

	        Tcl_WrongNumArgs(interp, 1, objv, "bbox index");

		goto error;
	    }
	    if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), 
                    &index) != TCL_OK) {
	        goto error;
	    }
	    if ((index == entryPtr->numChars) && (index > 0)) {
	        index--;
	    }
	    string = entryPtr->displayString;
	    Tk_CharBbox(entryPtr->textLayout, index, &x, &y, 
                    &width, &height);
	    sprintf(buf, "%d %d %d %d", x + entryPtr->layoutX,
		    y + entryPtr->layoutY, width, height);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    break;
	} 
	

        case COMMAND_CGET: {
	    if (objc != 3) {
	        Tcl_WrongNumArgs(interp, 1, objv, "cget option");


		goto error;
	    }
	    
	    objPtr = Tk_GetOptionValue(interp, (char *) entryPtr,



		    entryPtr->optionTable, objv[2], entryPtr->tkwin);

	    if (objPtr == NULL) {

		 goto error;
	    } else {
		Tcl_SetObjResult(interp, objPtr);

	    }


	    break;
	}

        case COMMAND_CONFIGURE: {
	    if (objc <= 3) {
		objPtr = Tk_GetOptionInfo(interp, (char *) entryPtr,

			entryPtr->optionTable,
			(objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
			entryPtr->tkwin);
		if (objPtr == NULL) {
		    goto error;
		} else {
		    Tcl_SetObjResult(interp, objPtr);
		}
	    } else {
		result = ConfigureEntry(interp, entryPtr, objc-2, objv+2, 0);
	    }
	    break;
	}

        case COMMAND_DELETE: {
	    int first, last;

	    if ((objc < 3) || (objc > 4)) {
	        Tcl_WrongNumArgs(interp, 1, objv, 
                        "delete firstIndex ?lastIndex?");
		goto error;
	    }
	    if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), 
                    &first) != TCL_OK) {
	        goto error;
	    }
	    if (objc == 3) {
	        last = first + 1;
	    } else {
	        if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[3]), 
                        &last) != TCL_OK) {
		    goto error;
		}
	    }
	    if ((last >= first) && (entryPtr->state == STATE_NORMAL)) {
	        DeleteChars(entryPtr, first, last - first);
	    }




	    break;
	}



        case COMMAND_GET: {
	    if (objc != 2) {
	        Tcl_WrongNumArgs(interp, 1, objv, "get");


		goto error;
	    }
	    Tcl_SetResult(interp, entryPtr->string, TCL_STATIC);

	    break;
	}





        case COMMAND_ICURSOR: {
	    if (objc != 3) {
	        Tcl_WrongNumArgs(interp, 1, objv, "icursor pos");

		goto error;
	    }
	    if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
                    &entryPtr->insertPos) != TCL_OK) {
	        goto error;
	    }
	    EventuallyRedraw(entryPtr);
	    break;
	}
	


        case COMMAND_INDEX: {
	    int index;
	    char buf[TCL_INTEGER_SPACE];

	    if (objc != 3) {
	        Tcl_WrongNumArgs(interp, 1, objv, "index string");


		goto error;
	    }
	    if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), 
                    &index) != TCL_OK) {
	        goto error;
	    }

	    sprintf(buf, "%d", index);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    break;
	}


        case COMMAND_INSERT: {
	    int index;

	    if (objc != 4) {
	        Tcl_WrongNumArgs(interp, 1, objv, "insert index text");

		goto error;
	    }
	    if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), 
                    &index) != TCL_OK) {
	        goto error;
	    }


	    if (entryPtr->state == STATE_NORMAL) {
	        InsertChars(entryPtr, index, Tcl_GetString(objv[3]));
	    }
	    break;
	}


        case COMMAND_SCAN: {
	    int x;
	    char *minorCmd;

	    if (objc != 4) {
	        Tcl_WrongNumArgs(interp, 1, objv, "scan mark|dragto x");
		goto error;
	    }



	    if (Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) {
	        goto error;
	    }

	    minorCmd = Tcl_GetString(objv[2]);
	    if (minorCmd[0] == 'm' 
                    && (strncmp(minorCmd, "mark", strlen(minorCmd)) == 0)) {
	        entryPtr->scanMarkX = x;
		entryPtr->scanMarkIndex = entryPtr->leftIndex;
	    } else if ((minorCmd[0] == 'd')
		&& (strncmp(minorCmd, "dragto", strlen(minorCmd)) == 0)) {
	        EntryScanTo(entryPtr, x);
	    } else {
	        Tcl_AppendResult(interp, "bad scan option \"", 
                        Tcl_GetString(objv[2]), "\": must be mark or dragto", 
                        (char *) NULL);
		goto error;
	    }






	    break;
	}



	    
	case COMMAND_SELECTION: {
	    int index, index2;

	    if (objc < 3) {
	        Tcl_WrongNumArgs(interp, 1, objv, "select option ?index?");

		goto error;
	    }






	    /* 
	     * Parse the selection sub-command, using the command
	     * table "selCommandNames" defined above.
	     */
	    
	    result = Tcl_GetIndexFromObj(interp, objv[2], selCommandNames,
                    "selection option", 0, &selIndex);
	    if (result != TCL_OK) {
	        goto error;
	    }

	    switch(selIndex) {
	        case SELECTION_ADJUST: {
		    if (objc != 4) {
		        Tcl_WrongNumArgs(interp, 1, objv, 
                                "selection adjust index");

			goto error;
		    }
		    if (GetEntryIndex(interp, entryPtr, 
                            Tcl_GetString(objv[3]), &index) != TCL_OK) {
		        goto error;
		    }
		    if (entryPtr->selectFirst >= 0) {
		        int half1, half2;
		
			half1 = (entryPtr->selectFirst 
			        + entryPtr->selectLast)/2;
			half2 = (entryPtr->selectFirst 
				+ entryPtr->selectLast + 1)/2;
			if (index < half1) {
			    entryPtr->selectAnchor = entryPtr->selectLast;
			} else if (index > half2) {
			    entryPtr->selectAnchor = entryPtr->selectFirst;
			} else {
			  /*
			   * We're at about the halfway point in the 
			   * selection; just keep the existing anchor.
			   */
			}
		    }
		    EntrySelectTo(entryPtr, index);
		    break;
		}

	        case SELECTION_CLEAR: {
		    if (objc != 3) {
		        Tcl_WrongNumArgs(interp, 1, objv, "selection clear");
			goto error;
		    }
		    if (entryPtr->selectFirst >= 0) {
		        entryPtr->selectFirst = -1;
			entryPtr->selectLast = -1;
			EventuallyRedraw(entryPtr);
		    }
		    goto done;
		}

	        case SELECTION_FROM: {
		    if (objc != 4) {
		        Tcl_WrongNumArgs(interp, 1, objv, 
			        "selection from index");

			goto error;
		    }
		    if (GetEntryIndex(interp, entryPtr, 
                            Tcl_GetString(objv[3]), &index) != TCL_OK) {
		        goto error;
		    }
		    entryPtr->selectAnchor = index;
		    break;
		}

	        case SELECTION_PRESENT: {
		    if (objc != 3) {
		        Tcl_WrongNumArgs(interp, 1, objv, "selection present");
			goto error;
		    }
		    if (entryPtr->selectFirst < 0) {
		        Tcl_SetResult(interp, "0", TCL_STATIC);
		    } else {
		        Tcl_SetResult(interp, "1", TCL_STATIC);
		    }
		    goto done;
		}

	        case SELECTION_RANGE: {
		    if (objc != 5) {
		        Tcl_WrongNumArgs(interp, 1, objv, 
                                "selection range start end");

			goto error;
		    }
		    if (GetEntryIndex(interp, entryPtr, 
                            Tcl_GetString(objv[3]), &index) != TCL_OK) {
		        goto error;
		    }
		    if (GetEntryIndex(interp, entryPtr, 
                            Tcl_GetString(objv[4]),& index2) != TCL_OK) {
		        goto error;
		    }
		    if (index >= index2) {
		        entryPtr->selectFirst = -1;
			entryPtr->selectLast = -1;
		    } else {
		        entryPtr->selectFirst = index;
			entryPtr->selectLast = index2;
		    }
		    if (!(entryPtr->flags & GOT_SELECTION)
			    && (entryPtr->exportSelection)) {
		        Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, 
			        EntryLostSelection, (ClientData) entryPtr);
			entryPtr->flags |= GOT_SELECTION;
		    }
		    EventuallyRedraw(entryPtr);
		    break;
		}
		
	        case SELECTION_TO: {
		    if (objc != 4) {
		        Tcl_WrongNumArgs(interp, 1, objv, 
                                "selection to index");

			goto error;
		    }
		    if (GetEntryIndex(interp, entryPtr, 
                            Tcl_GetString(objv[3]), &index) != TCL_OK) {
		        goto error;
		    }
		    EntrySelectTo(entryPtr, index);
		    break;



		}
	    }
	    break;
	}

        case COMMAND_XVIEW: {
	    int index;


	    if (objc == 2) {
	        double first, last;
		char buf[TCL_DOUBLE_SPACE * 2];
	    
		EntryVisibleRange(entryPtr, &first, &last);
		sprintf(buf, "%g %g", first, last);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
		goto done;
	    } else if (objc == 3) {
	        if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]), 
                        &index) != TCL_OK) {
		    goto error;
		}
	    } else {
	        double fraction;
		int count;

		index = entryPtr->leftIndex;
		switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, 
                        &count)) {
		    case TK_SCROLL_ERROR: {
		        goto error;
		    }
		    case TK_SCROLL_MOVETO: {
		        index = (int) ((fraction * entryPtr->numChars) + 0.5);
			break;
		    }
		    case TK_SCROLL_PAGES: {
		        int charsPerPage;
		    
			charsPerPage = ((Tk_Width(entryPtr->tkwin)
    			        - 2 * entryPtr->inset) 
                                / entryPtr->avgWidth) - 2;
			if (charsPerPage < 1) {
			    charsPerPage = 1;
			}
			index += count * charsPerPage;
			break;
		    }
		    case TK_SCROLL_UNITS: {
		        index += count;
			break;
		    }
		}
	    }
	    if (index >= entryPtr->numChars) {
	        index = entryPtr->numChars - 1;
	    }
	    if (index < 0) {
	        index = 0;
	    }
	    entryPtr->leftIndex = index;
	    entryPtr->flags |= UPDATE_SCROLLBAR;
	    EntryComputeGeometry(entryPtr);
	    EventuallyRedraw(entryPtr);
	    break;





	}
    }

    done:
    Tcl_Release((ClientData) entryPtr);
    return result;

    error:
    Tcl_Release((ClientData) entryPtr);
    return TCL_ERROR;
814
815
816
817
818
819
820
821






822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846


847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879



880
881
882
883
884
885
886
887
888
889
890
891
892
893






894








895
























































896
897
898
899
900
901
902
 *----------------------------------------------------------------------
 */

static void
DestroyEntry(memPtr)
    char *memPtr;		/* Info about entry widget. */
{
    register Entry *entryPtr = (Entry *) memPtr;







    /*
     * Free up all the stuff that requires special handling, then
     * let Tk_FreeOptions handle all the standard option-related
     * stuff.
     */

    ckfree(entryPtr->string);
    if (entryPtr->textVarName != NULL) {
	Tcl_UntraceVar(entryPtr->interp, entryPtr->textVarName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		EntryTextVarProc, (ClientData) entryPtr);
    }
    if (entryPtr->textGC != None) {
	Tk_FreeGC(entryPtr->display, entryPtr->textGC);
    }
    if (entryPtr->selTextGC != None) {
	Tk_FreeGC(entryPtr->display, entryPtr->selTextGC);
    }
    Tcl_DeleteTimerHandler(entryPtr->insertBlinkHandler);
    if (entryPtr->displayString != NULL) {
	ckfree(entryPtr->displayString);
    }
    Tk_FreeTextLayout(entryPtr->textLayout);
    Tk_FreeOptions(configSpecs, (char *) entryPtr, entryPtr->display, 0);


    ckfree((char *) entryPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureEntry --
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or reconfigure)
 *	an entry widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, border width,
 *	etc. get set for entryPtr;  old resources get freed,
 *	if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureEntry(interp, entryPtr, argc, argv, flags)
    Tcl_Interp *interp;		/* Used for error reporting. */
    register Entry *entryPtr;	/* Information about widget;  may or may
				 * not already have values for some fields. */
    int argc;			/* Number of valid entries in argv. */
    char **argv;		/* Arguments. */
    int flags;			/* Flags to pass to Tk_ConfigureWidget. */
{



    int oldExport;

    /*
     * Eliminate any existing trace on a variable monitored by the entry.
     */

    if (entryPtr->textVarName != NULL) {
	Tcl_UntraceVar(interp, entryPtr->textVarName, 
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		EntryTextVarProc, (ClientData) entryPtr);
    }

    oldExport = entryPtr->exportSelection;
    if (Tk_ConfigureWidget(interp, entryPtr->tkwin, configSpecs,






	    argc, argv, (char *) entryPtr, flags) != TCL_OK) {








	return TCL_ERROR;
























































    }

    /*
     * If the entry is tied to the value of a variable, then set up
     * a trace on the variable's value, create the variable if it doesn't
     * exist, and set the entry's value from the variable's value.
     */







|
>
>
>
>
>
>




















|



|
>
>














|










|

|
|
|
|


>
>
>













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







977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
 *----------------------------------------------------------------------
 */

static void
DestroyEntry(memPtr)
    char *memPtr;		/* Info about entry widget. */
{
    Entry *entryPtr = (Entry *) memPtr;
    entryPtr->flags |= ENTRY_DELETED;

    Tcl_DeleteCommandFromToken(entryPtr->interp, entryPtr->widgetCmd);
    if (entryPtr->flags & REDRAW_PENDING) {
        Tcl_CancelIdleCall(DisplayEntry, (ClientData) entryPtr);
    }

    /*
     * Free up all the stuff that requires special handling, then
     * let Tk_FreeOptions handle all the standard option-related
     * stuff.
     */

    ckfree(entryPtr->string);
    if (entryPtr->textVarName != NULL) {
	Tcl_UntraceVar(entryPtr->interp, entryPtr->textVarName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		EntryTextVarProc, (ClientData) entryPtr);
    }
    if (entryPtr->textGC != None) {
	Tk_FreeGC(entryPtr->display, entryPtr->textGC);
    }
    if (entryPtr->selTextGC != None) {
	Tk_FreeGC(entryPtr->display, entryPtr->selTextGC);
    }
    Tcl_DeleteTimerHandler(entryPtr->insertBlinkHandler);
    if (entryPtr->displayString != entryPtr->string) {
	ckfree(entryPtr->displayString);
    }
    Tk_FreeTextLayout(entryPtr->textLayout);
    Tk_FreeConfigOptions((char *) entryPtr, entryPtr->optionTable,
	    entryPtr->tkwin);
    entryPtr->tkwin = NULL;
    ckfree((char *) entryPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureEntry --
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or reconfigure)
 *	an entry widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, border width,
 *	etc. get set for entryPtr;  old resources get freed,
 *	if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureEntry(interp, entryPtr, objc, objv, flags)
    Tcl_Interp *interp;		/* Used for error reporting. */
    Entry *entryPtr;		/* Information about widget; may or may not
				 * already have values for some fields. */
    int objc;			/* Number of valid entries in argv. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
    int flags;			/* Flags to pass to Tk_ConfigureWidget. */
{
    Tk_SavedOptions savedOptions;
    Tcl_Obj *errorResult = NULL;
    int error;
    int oldExport;

    /*
     * Eliminate any existing trace on a variable monitored by the entry.
     */

    if (entryPtr->textVarName != NULL) {
	Tcl_UntraceVar(interp, entryPtr->textVarName, 
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		EntryTextVarProc, (ClientData) entryPtr);
    }

    oldExport = entryPtr->exportSelection;

    for (error = 0; error <= 1; error++) {
	if (!error) {
	    /*
	     * First pass: set options to new values.
	     */

	    if (Tk_SetOptions(interp, (char *) entryPtr,
		    entryPtr->optionTable, objc, objv,
		    entryPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
		continue;
	    }
	} else {
	    /*
	     * Second pass: restore options to old values.
	     */

	    errorResult = Tcl_GetObjResult(interp);
	    Tcl_IncrRefCount(errorResult);
	    Tk_RestoreSavedOptions(&savedOptions);
	}

	/*
	 * A few other options also need special processing, such as parsing
	 * the geometry and setting the background from a 3-D border.
	 */

	Tk_SetBackgroundFromBorder(entryPtr->tkwin, entryPtr->normalBorder);

	if (entryPtr->insertWidth <= 0) {
	    entryPtr->insertWidth = 2;
	}
	if (entryPtr->insertBorderWidth > entryPtr->insertWidth/2) {
	    entryPtr->insertBorderWidth = entryPtr->insertWidth/2;
	}

	/*
	 * Restart the cursor timing sequence in case the on-time or 
	 * off-time just changed.
	 */

	if (entryPtr->flags & GOT_FOCUS) {
	  EntryFocusProc(entryPtr, 1);
	}

	/*
	 * Claim the selection if we've suddenly started exporting it.
	 */

	if (entryPtr->exportSelection && (!oldExport)
	        && (entryPtr->selectFirst != -1)
	        && !(entryPtr->flags & GOT_SELECTION)) {
	    Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection,
		    (ClientData) entryPtr);
	    entryPtr->flags |= GOT_SELECTION;
	}

	/*
	 * Recompute the window's geometry and arrange for it to be
	 * redisplayed.
	 */

	Tk_SetInternalBorder(entryPtr->tkwin,
	        entryPtr->borderWidth + entryPtr->highlightWidth);
	if (entryPtr->highlightWidth <= 0) {
	    entryPtr->highlightWidth = 0;
	}
	entryPtr->inset = entryPtr->highlightWidth 
	        + entryPtr->borderWidth + XPAD;
	break;
    }
    if (!error) {
	Tk_FreeSavedOptions(&savedOptions);
    }

    /*
     * If the entry is tied to the value of a variable, then set up
     * a trace on the variable's value, create the variable if it doesn't
     * exist, and set the entry's value from the variable's value.
     */
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927

928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
	    EntrySetValue(entryPtr, value);
	}
	Tcl_TraceVar(interp, entryPtr->textVarName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		EntryTextVarProc, (ClientData) entryPtr);
    }

    /*
     * A few other options also need special processing, such as parsing
     * the geometry and setting the background from a 3-D border.
     */

    if ((entryPtr->state != tkNormalUid)
	    && (entryPtr->state != tkDisabledUid)) {
	Tcl_AppendResult(interp, "bad state value \"", entryPtr->state,
		"\": must be normal or disabled", (char *) NULL);
	entryPtr->state = tkNormalUid;

	return TCL_ERROR;
    }

    Tk_SetBackgroundFromBorder(entryPtr->tkwin, entryPtr->normalBorder);

    if (entryPtr->insertWidth <= 0) {
	entryPtr->insertWidth = 2;
    }
    if (entryPtr->insertBorderWidth > entryPtr->insertWidth/2) {
	entryPtr->insertBorderWidth = entryPtr->insertWidth/2;
    }

    /*
     * Restart the cursor timing sequence in case the on-time or off-time
     * just changed.
     */

    if (entryPtr->flags & GOT_FOCUS) {
	EntryFocusProc(entryPtr, 1);
    }

    /*
     * Claim the selection if we've suddenly started exporting it.
     */

    if (entryPtr->exportSelection && (!oldExport)
	    && (entryPtr->selectFirst != -1)
	    && !(entryPtr->flags & GOT_SELECTION)) {
	Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection,
		(ClientData) entryPtr);
	entryPtr->flags |= GOT_SELECTION;
    }

    /*
     * Recompute the window's geometry and arrange for it to be
     * redisplayed.
     */

    Tk_SetInternalBorder(entryPtr->tkwin,
	    entryPtr->borderWidth + entryPtr->highlightWidth);
    if (entryPtr->highlightWidth <= 0) {
	entryPtr->highlightWidth = 0;
    }
    entryPtr->inset = entryPtr->highlightWidth + entryPtr->borderWidth + XPAD;

    EntryWorldChanged((ClientData) entryPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * EntryWorldChanged --
 *







<
<
<
<
|
|
<
|
<
<
>

<
|
<
|
<
<

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







1155
1156
1157
1158
1159
1160
1161




1162
1163

1164


1165
1166

1167

1168


1169







































1170
1171
1172
1173
1174
1175
1176
	    EntrySetValue(entryPtr, value);
	}
	Tcl_TraceVar(interp, entryPtr->textVarName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		EntryTextVarProc, (ClientData) entryPtr);
    }





    EntryWorldChanged((ClientData) entryPtr);
    if (error) {

        Tcl_SetObjResult(interp, errorResult);


	Tcl_DecrRefCount(errorResult);
	return TCL_ERROR;

    } else {

        return TCL_OK;


    }







































}

/*
 *---------------------------------------------------------------------------
 *
 * EntryWorldChanged --
 *
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066

1067
1068
1069
1070
1071
1072
1073
 *--------------------------------------------------------------
 */

static void
DisplayEntry(clientData)
    ClientData clientData;	/* Information about window. */
{
    register Entry *entryPtr = (Entry *) clientData;
    register Tk_Window tkwin = entryPtr->tkwin;
    int baseY, selStartX, selEndX, cursorX, x, w;
    int xBound;
    Tk_FontMetrics fm;
    Pixmap pixmap;
    int showSelection;


    entryPtr->flags &= ~REDRAW_PENDING;
    if ((entryPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
	return;
    }

    Tk_GetFontMetrics(entryPtr->tkfont, &fm);







|
|
|




>







1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
 *--------------------------------------------------------------
 */

static void
DisplayEntry(clientData)
    ClientData clientData;	/* Information about window. */
{
    Entry *entryPtr = (Entry *) clientData;
    Tk_Window tkwin = entryPtr->tkwin;
    int baseY, selStartX, selEndX, cursorX;
    int xBound;
    Tk_FontMetrics fm;
    Pixmap pixmap;
    int showSelection;
    char *string;

    entryPtr->flags &= ~REDRAW_PENDING;
    if ((entryPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
	return;
    }

    Tk_GetFontMetrics(entryPtr->tkfont, &fm);
1114
1115
1116
1117
1118
1119
1120



1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190

1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
     * Draw the background in three layers.  From bottom to top the
     * layers are:  normal background, selection background, and
     * insertion cursor background.
     */

    Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->normalBorder,
	    0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);



    if (showSelection && (entryPtr->selectLast > entryPtr->leftIndex)) {
	if (entryPtr->selectFirst <= entryPtr->leftIndex) {
	    selStartX = entryPtr->leftX;
	} else {
	    Tk_CharBbox(entryPtr->textLayout, entryPtr->selectFirst,
		    &x, NULL, NULL, NULL);
	    selStartX = x + entryPtr->layoutX;
	}
	if ((selStartX - entryPtr->selBorderWidth) < xBound) {
	    Tk_CharBbox(entryPtr->textLayout, entryPtr->selectLast - 1,
		    &x, NULL, &w, NULL);
	    selEndX = x + w + entryPtr->layoutX;
	    Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->selBorder,
		    selStartX - entryPtr->selBorderWidth,
		    baseY - fm.ascent - entryPtr->selBorderWidth,
		    (selEndX - selStartX) + 2*entryPtr->selBorderWidth,
		    (fm.ascent + fm.descent) + 2*entryPtr->selBorderWidth,
		    entryPtr->selBorderWidth, TK_RELIEF_RAISED);
	} 
    }

    /*
     * Draw a special background for the insertion cursor, overriding
     * even the selection background.  As a special hack to keep the
     * cursor visible when the insertion cursor color is the same as
     * the color for selected text (e.g., on mono displays), write
     * background in the cursor area (instead of nothing) when the
     * cursor isn't on.  Otherwise the selection would hide the cursor.
     */

    if ((entryPtr->insertPos >= entryPtr->leftIndex)
	    && (entryPtr->state == tkNormalUid)
	    && (entryPtr->flags & GOT_FOCUS)) {
	if (entryPtr->insertPos == 0) {
	    cursorX = 0;
	} else if (entryPtr->insertPos >= entryPtr->numChars) {
	    Tk_CharBbox(entryPtr->textLayout, entryPtr->numChars - 1,
		    &x, NULL, &w, NULL);
	    cursorX = x + w;
	} else {
	    Tk_CharBbox(entryPtr->textLayout, entryPtr->insertPos,
		    &x, NULL, NULL, NULL);
	    cursorX = x;
	}
	cursorX += entryPtr->layoutX;
	cursorX -= (entryPtr->insertWidth)/2;
	if (cursorX < xBound) {
	    if (entryPtr->flags & CURSOR_ON) {
		Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->insertBorder,
			cursorX, baseY - fm.ascent,
			entryPtr->insertWidth, fm.ascent + fm.descent, 
			entryPtr->insertBorderWidth, TK_RELIEF_RAISED);
	    } else if (entryPtr->insertBorder == entryPtr->selBorder) {
		Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->normalBorder,
			cursorX, baseY - fm.ascent,
			entryPtr->insertWidth, fm.ascent + fm.descent,
			0, TK_RELIEF_FLAT);
	    }
	}
    }

    /*
     * Draw the text in two pieces:  first the unselected portion, then the
     * selected portion on top of it.
     */

    Tk_DrawTextLayout(entryPtr->display, pixmap, entryPtr->textGC,
	    entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY,
	    entryPtr->leftIndex, entryPtr->numChars);


    if (showSelection && (entryPtr->selTextGC != entryPtr->textGC) &&
	    (entryPtr->selectFirst < entryPtr->selectLast)) {
	int first;

	if (entryPtr->selectFirst - entryPtr->leftIndex < 0) {
	    first = entryPtr->leftIndex;
	} else {
	    first = entryPtr->selectFirst;
	}
	Tk_DrawTextLayout(entryPtr->display, pixmap, entryPtr->selTextGC,
		entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY,
		first, entryPtr->selectLast);
    }

    /*
     * Draw the border and focus highlight last, so they will overwrite
     * any text that extends past the viewable part of the window.
     */

    if (entryPtr->relief != TK_RELIEF_FLAT) {
	Tk_Draw3DRectangle(tkwin, pixmap, entryPtr->normalBorder,
		entryPtr->highlightWidth, entryPtr->highlightWidth,
		Tk_Width(tkwin) - 2*entryPtr->highlightWidth,
		Tk_Height(tkwin) - 2*entryPtr->highlightWidth,
		entryPtr->borderWidth, entryPtr->relief);
    }
    if (entryPtr->highlightWidth != 0) {
	GC gc;

	if (entryPtr->flags & GOT_FOCUS) {
	    gc = Tk_GCForColor(entryPtr->highlightColorPtr, pixmap);







>
>
>
|




|
|


|
|
|



















|

<
<
<
|
<
<
<
<
|
<
<





|
|
|


|
<
|













>
|
|
|

|
|

|



|










|
|







1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352



1353




1354


1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365

1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
     * Draw the background in three layers.  From bottom to top the
     * layers are:  normal background, selection background, and
     * insertion cursor background.
     */

    Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->normalBorder,
	    0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);

    string = entryPtr->displayString;
    if (showSelection
	    && (entryPtr->selectLast > entryPtr->leftIndex)) {
	if (entryPtr->selectFirst <= entryPtr->leftIndex) {
	    selStartX = entryPtr->leftX;
	} else {
	    Tk_CharBbox(entryPtr->textLayout, entryPtr->selectFirst,
		    &selStartX, NULL, NULL, NULL);
	    selStartX += entryPtr->layoutX;
	}
	if ((selStartX - entryPtr->selBorderWidth) < xBound) {
	    Tk_CharBbox(entryPtr->textLayout, entryPtr->selectLast,
		    &selEndX, NULL, NULL, NULL);
	    selEndX += entryPtr->layoutX;
	    Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->selBorder,
		    selStartX - entryPtr->selBorderWidth,
		    baseY - fm.ascent - entryPtr->selBorderWidth,
		    (selEndX - selStartX) + 2*entryPtr->selBorderWidth,
		    (fm.ascent + fm.descent) + 2*entryPtr->selBorderWidth,
		    entryPtr->selBorderWidth, TK_RELIEF_RAISED);
	} 
    }

    /*
     * Draw a special background for the insertion cursor, overriding
     * even the selection background.  As a special hack to keep the
     * cursor visible when the insertion cursor color is the same as
     * the color for selected text (e.g., on mono displays), write
     * background in the cursor area (instead of nothing) when the
     * cursor isn't on.  Otherwise the selection would hide the cursor.
     */

    if ((entryPtr->insertPos >= entryPtr->leftIndex)
	    && (entryPtr->state == STATE_NORMAL)
	    && (entryPtr->flags & GOT_FOCUS)) {



	Tk_CharBbox(entryPtr->textLayout, entryPtr->insertPos, &cursorX, NULL,




		NULL, NULL);


	cursorX += entryPtr->layoutX;
	cursorX -= (entryPtr->insertWidth)/2;
	if (cursorX < xBound) {
	    if (entryPtr->flags & CURSOR_ON) {
		Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->insertBorder,
			cursorX, baseY - fm.ascent, entryPtr->insertWidth,
			fm.ascent + fm.descent, entryPtr->insertBorderWidth,
			TK_RELIEF_RAISED);
	    } else if (entryPtr->insertBorder == entryPtr->selBorder) {
		Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->normalBorder,
			cursorX, baseY - fm.ascent, entryPtr->insertWidth,

			fm.ascent + fm.descent, 0, TK_RELIEF_FLAT);
	    }
	}
    }

    /*
     * Draw the text in two pieces:  first the unselected portion, then the
     * selected portion on top of it.
     */

    Tk_DrawTextLayout(entryPtr->display, pixmap, entryPtr->textGC,
	    entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY,
	    entryPtr->leftIndex, entryPtr->numChars);

    if (showSelection
	    && (entryPtr->selTextGC != entryPtr->textGC)
	    && (entryPtr->selectFirst < entryPtr->selectLast)) {
	int selFirst;

	if (entryPtr->selectFirst < entryPtr->leftIndex) {
	    selFirst = entryPtr->leftIndex;
	} else {
	    selFirst = entryPtr->selectFirst;
	}
	Tk_DrawTextLayout(entryPtr->display, pixmap, entryPtr->selTextGC,
		entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY,
		selFirst, entryPtr->selectLast);
    }

    /*
     * Draw the border and focus highlight last, so they will overwrite
     * any text that extends past the viewable part of the window.
     */

    if (entryPtr->relief != TK_RELIEF_FLAT) {
	Tk_Draw3DRectangle(tkwin, pixmap, entryPtr->normalBorder,
		entryPtr->highlightWidth, entryPtr->highlightWidth,
		Tk_Width(tkwin) - 2 * entryPtr->highlightWidth,
		Tk_Height(tkwin) - 2 * entryPtr->highlightWidth,
		entryPtr->borderWidth, entryPtr->relief);
    }
    if (entryPtr->highlightWidth != 0) {
	GC gc;

	if (entryPtr->flags & GOT_FOCUS) {
	    gc = Tk_GCForColor(entryPtr->highlightColorPtr, pixmap);
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267






1268
1269
1270
1271
1272
1273
1274



1275




1276

1277
1278



1279

1280
1281
1282
1283

1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
 *	to register the desired dimensions for the window.
 *
 *----------------------------------------------------------------------
 */

static void
EntryComputeGeometry(entryPtr)
    Entry *entryPtr;			/* Widget record for entry. */
{
    int totalLength, overflow, maxOffScreen, rightX;
    int height, width, i;
    Tk_FontMetrics fm;
    char *p, *displayString;







    /*
     * If we're displaying a special character instead of the value of
     * the entry, recompute the displayString.
     */

    if (entryPtr->displayString != NULL) {



	ckfree(entryPtr->displayString);




	entryPtr->displayString = NULL;

    }
    if (entryPtr->showChar != NULL) {



	entryPtr->displayString = (char *) ckalloc((unsigned)

		(entryPtr->numChars + 1));
	for (p = entryPtr->displayString, i = entryPtr->numChars; i > 0;
		i--, p++) {
	    *p = entryPtr->showChar[0];

	}
	*p = 0;
	displayString = entryPtr->displayString;
    } else {
	displayString = entryPtr->string;
    }
    Tk_FreeTextLayout(entryPtr->textLayout);
    entryPtr->textLayout = Tk_ComputeTextLayout(entryPtr->tkfont,
	    displayString, entryPtr->numChars, 0, entryPtr->justify,
	    TK_IGNORE_NEWLINES, &totalLength, &height);

    entryPtr->layoutY = (Tk_Height(entryPtr->tkwin) - height) / 2;

    /*
     * Recompute where the leftmost character on the display will
     * be drawn (entryPtr->leftX) and adjust leftIndex if necessary
     * so that we don't let characters hang off the edge of the







|




|
>
>
>
>
>
>






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

|
<
<
<



|
|







1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489

1490
1491
1492
1493



1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
 *	to register the desired dimensions for the window.
 *
 *----------------------------------------------------------------------
 */

static void
EntryComputeGeometry(entryPtr)
    Entry *entryPtr;		/* Widget record for entry. */
{
    int totalLength, overflow, maxOffScreen, rightX;
    int height, width, i;
    Tk_FontMetrics fm;
    char *p;

    if (entryPtr->displayString != entryPtr->string) {
	ckfree(entryPtr->displayString);
	entryPtr->displayString = entryPtr->string;
	entryPtr->numDisplayBytes = entryPtr->numBytes;
    }

    /*
     * If we're displaying a special character instead of the value of
     * the entry, recompute the displayString.
     */

    if (entryPtr->showChar != NULL) {
	Tcl_UniChar ch;
	char buf[TCL_UTF_MAX];
	int size;

	/*
	 * Normalize the special character so we can safely duplicate it
	 * in the display string.  If we didn't do this, then two malformed
	 * characters might end up looking like one valid UTF character in
	 * the resulting string.
	 */

	Tcl_UtfToUniChar(entryPtr->showChar, &ch);
	size = Tcl_UniCharToUtf(ch, buf);

	entryPtr->numDisplayBytes = entryPtr->numChars * size;
	entryPtr->displayString =
		(char *) ckalloc((unsigned) (entryPtr->numDisplayBytes + 1));

	p = entryPtr->displayString;

	for (i = entryPtr->numChars; --i >= 0; ) {
	    p += Tcl_UniCharToUtf(ch, p);
	}
	*p = '\0';



    }
    Tk_FreeTextLayout(entryPtr->textLayout);
    entryPtr->textLayout = Tk_ComputeTextLayout(entryPtr->tkfont,
	    entryPtr->displayString, entryPtr->numChars, 0,
	    entryPtr->justify, TK_IGNORE_NEWLINES, &totalLength, &height);

    entryPtr->layoutY = (Tk_Height(entryPtr->tkwin) - height) / 2;

    /*
     * Recompute where the leftmost character on the display will
     * be drawn (entryPtr->leftX) and adjust leftIndex if necessary
     * so that we don't let characters hang off the edge of the
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
	 * window, then don't let leftIndex be any greater than that.
	 */

	maxOffScreen = Tk_PointToChar(entryPtr->textLayout, overflow, 0);
	Tk_CharBbox(entryPtr->textLayout, maxOffScreen,
		&rightX, NULL, NULL, NULL);
	if (rightX < overflow) {
	    maxOffScreen += 1;
	}
	if (entryPtr->leftIndex > maxOffScreen) {
	    entryPtr->leftIndex = maxOffScreen;
	}
	Tk_CharBbox(entryPtr->textLayout, entryPtr->leftIndex,
		&rightX, NULL, NULL, NULL);
	entryPtr->leftX = entryPtr->inset;
	entryPtr->layoutX = entryPtr->leftX - rightX;
    }

    Tk_GetFontMetrics(entryPtr->tkfont, &fm);
    height = fm.linespace + 2*entryPtr->inset + 2*(YPAD-XPAD);
    if (entryPtr->prefWidth > 0) {







|




|
|







1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
	 * window, then don't let leftIndex be any greater than that.
	 */

	maxOffScreen = Tk_PointToChar(entryPtr->textLayout, overflow, 0);
	Tk_CharBbox(entryPtr->textLayout, maxOffScreen,
		&rightX, NULL, NULL, NULL);
	if (rightX < overflow) {
	    maxOffScreen++;
	}
	if (entryPtr->leftIndex > maxOffScreen) {
	    entryPtr->leftIndex = maxOffScreen;
	}
	Tk_CharBbox(entryPtr->textLayout, entryPtr->leftIndex, &rightX,
		NULL, NULL, NULL);
	entryPtr->leftX = entryPtr->inset;
	entryPtr->layoutX = entryPtr->leftX - rightX;
    }

    Tk_GetFontMetrics(entryPtr->tkfont, &fm);
    height = fm.linespace + 2*entryPtr->inset + 2*(YPAD-XPAD);
    if (entryPtr->prefWidth > 0) {
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381


1382
1383
1384
1385


1386
1387
1388

1389
1390
1391












1392







1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408

1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
 *	New information gets added to entryPtr;  it will be redisplayed
 *	soon, but not necessarily immediately.
 *
 *----------------------------------------------------------------------
 */

static void
InsertChars(entryPtr, index, string)
    register Entry *entryPtr;	/* Entry that is to get the new
				 * elements. */
    int index;			/* Add the new elements before this
				 * element. */
    char *string;		/* New characters to add (NULL-terminated
				 * string). */
{
    int length;
    char *new;



    length = strlen(string);
    if (length == 0) {
	return;
    }


    new = (char *) ckalloc((unsigned) (entryPtr->numChars + length + 1));
    strncpy(new, entryPtr->string, (size_t) index);
    strcpy(new+index, string);

    strcpy(new+index+length, entryPtr->string+index);
    ckfree(entryPtr->string);
    entryPtr->string = new;












    entryPtr->numChars += length;








    /*
     * Inserting characters invalidates all indexes into the string.
     * Touch up the indexes so that they still refer to the same
     * characters (at new positions).  When updating the selection
     * end-points, don't include the new text in the selection unless
     * it was completely surrounded by the selection.
     */

    if (entryPtr->selectFirst >= index) {
	entryPtr->selectFirst += length;
    }
    if (entryPtr->selectLast > index) {
	entryPtr->selectLast += length;
    }
    if ((entryPtr->selectAnchor > index) || (entryPtr->selectFirst >= index)) {

	entryPtr->selectAnchor += length;
    }
    if (entryPtr->leftIndex > index) {
	entryPtr->leftIndex += length;
    }
    if (entryPtr->insertPos >= index) {
	entryPtr->insertPos += length;
    }
    EntryValueChanged(entryPtr);
}

/*
 *----------------------------------------------------------------------
 *







|
|
<

|
|


|
|

>
>
|
|


>
>
|
|
|
>
|
|

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










|


|

|
>
|


|


|







1569
1570
1571
1572
1573
1574
1575
1576
1577

1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
 *	New information gets added to entryPtr;  it will be redisplayed
 *	soon, but not necessarily immediately.
 *
 *----------------------------------------------------------------------
 */

static void
InsertChars(entryPtr, index, value)
    Entry *entryPtr;		/* Entry that is to get the new elements. */

    int index;			/* Add the new elements before this
				 * character index. */
    char *value;		/* New characters to add (NULL-terminated
				 * string). */
{
    int byteIndex, byteCount, oldChars, charsAdded, newByteCount;
    char *new, *string;

    string = entryPtr->string;
    byteIndex = Tcl_UtfAtIndex(string, index) - string;
    byteCount = strlen(value);
    if (byteCount == 0) {
	return;
    }

    newByteCount = entryPtr->numBytes + byteCount + 1;
    new = (char *) ckalloc((unsigned) newByteCount);
    memcpy(new, string, (size_t) byteIndex);
    strcpy(new + byteIndex, value);
    strcpy(new + byteIndex + byteCount, string + byteIndex);

    ckfree(string);
    entryPtr->string = new;

    /*
     * The following construction is used because inserting improperly
     * formed UTF-8 sequences between other improperly formed UTF-8
     * sequences could result in actually forming valid UTF-8 sequences;
     * the number of characters added may not be Tcl_NumUtfChars(string, -1),
     * because of context.  The actual number of characters added is how
     * many characters are in the string now minus the number that
     * used to be there.
     */

    oldChars = entryPtr->numChars;
    entryPtr->numChars = Tcl_NumUtfChars(new, -1);
    charsAdded = entryPtr->numChars - oldChars;
    entryPtr->numBytes += byteCount;

    if (entryPtr->displayString == string) {
	entryPtr->displayString = new;
	entryPtr->numDisplayBytes = entryPtr->numBytes;
    }

    /*
     * Inserting characters invalidates all indexes into the string.
     * Touch up the indexes so that they still refer to the same
     * characters (at new positions).  When updating the selection
     * end-points, don't include the new text in the selection unless
     * it was completely surrounded by the selection.
     */

    if (entryPtr->selectFirst >= index) {
	entryPtr->selectFirst += charsAdded;
    }
    if (entryPtr->selectLast > index) {
	entryPtr->selectLast += charsAdded;
    }
    if ((entryPtr->selectAnchor > index)
	    || (entryPtr->selectFirst >= index)) {
	entryPtr->selectAnchor += charsAdded;
    }
    if (entryPtr->leftIndex > index) {
	entryPtr->leftIndex += charsAdded;
    }
    if (entryPtr->insertPos >= index) {
	entryPtr->insertPos += charsAdded;
    }
    EntryValueChanged(entryPtr);
}

/*
 *----------------------------------------------------------------------
 *
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442

1443
1444
1445
1446
1447
1448
1449
1450
1451





1452
1453

1454
1455
1456
1457






1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480

1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
 *	redisplayed.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteChars(entryPtr, index, count)
    register Entry *entryPtr;	/* Entry widget to modify. */
    int index;			/* Index of first character to delete. */
    int count;			/* How many characters to delete. */
{

    char *new;

    if ((index + count) > entryPtr->numChars) {
	count = entryPtr->numChars - index;
    }
    if (count <= 0) {
	return;
    }






    new = (char *) ckalloc((unsigned) (entryPtr->numChars + 1 - count));
    strncpy(new, entryPtr->string, (size_t) index);

    strcpy(new+index, entryPtr->string+index+count);
    ckfree(entryPtr->string);
    entryPtr->string = new;
    entryPtr->numChars -= count;







    /*
     * Deleting characters results in the remaining characters being
     * renumbered.  Update the various indexes into the string to reflect
     * this change.
     */

    if (entryPtr->selectFirst >= index) {
	if (entryPtr->selectFirst >= (index+count)) {
	    entryPtr->selectFirst -= count;
	} else {
	    entryPtr->selectFirst = index;
	}
    }
    if (entryPtr->selectLast >= index) {
	if (entryPtr->selectLast >= (index+count)) {
	    entryPtr->selectLast -= count;
	} else {
	    entryPtr->selectLast = index;
	}
    }
    if (entryPtr->selectLast <= entryPtr->selectFirst) {
	entryPtr->selectFirst = entryPtr->selectLast = -1;

    }
    if (entryPtr->selectAnchor >= index) {
	if (entryPtr->selectAnchor >= (index+count)) {
	    entryPtr->selectAnchor -= count;
	} else {
	    entryPtr->selectAnchor = index;
	}
    }
    if (entryPtr->leftIndex > index) {
	if (entryPtr->leftIndex >= (index+count)) {
	    entryPtr->leftIndex -= count;
	} else {
	    entryPtr->leftIndex = index;
	}
    }
    if (entryPtr->insertPos >= index) {
	if (entryPtr->insertPos >= (index+count)) {
	    entryPtr->insertPos -= count;
	} else {
	    entryPtr->insertPos = index;
	}
    }
    EntryValueChanged(entryPtr);
}







|



>
|








>
>
>
>
>
|
|
>
|



>
>
>
>
>
>








|






|






|
>









|






|







1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
 *	redisplayed.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteChars(entryPtr, index, count)
    Entry *entryPtr;		/* Entry widget to modify. */
    int index;			/* Index of first character to delete. */
    int count;			/* How many characters to delete. */
{
    int byteIndex, byteCount, newByteCount;
    char *new, *string;

    if ((index + count) > entryPtr->numChars) {
	count = entryPtr->numChars - index;
    }
    if (count <= 0) {
	return;
    }

    string = entryPtr->string;
    byteIndex = Tcl_UtfAtIndex(string, index) - string;
    byteCount = Tcl_UtfAtIndex(string + byteIndex, count) - (string + byteIndex);

    newByteCount = entryPtr->numBytes + 1 - byteCount;
    new = (char *) ckalloc((unsigned) newByteCount);
    memcpy(new, string, (size_t) byteIndex);
    strcpy(new + byteIndex, string + byteIndex + byteCount);

    ckfree(entryPtr->string);
    entryPtr->string = new;
    entryPtr->numChars -= count;
    entryPtr->numBytes -= byteCount;

    if (entryPtr->displayString == string) {
	entryPtr->displayString = new;
	entryPtr->numDisplayBytes = entryPtr->numBytes;
    }

    /*
     * Deleting characters results in the remaining characters being
     * renumbered.  Update the various indexes into the string to reflect
     * this change.
     */

    if (entryPtr->selectFirst >= index) {
	if (entryPtr->selectFirst >= (index + count)) {
	    entryPtr->selectFirst -= count;
	} else {
	    entryPtr->selectFirst = index;
	}
    }
    if (entryPtr->selectLast >= index) {
	if (entryPtr->selectLast >= (index + count)) {
	    entryPtr->selectLast -= count;
	} else {
	    entryPtr->selectLast = index;
	}
    }
    if (entryPtr->selectLast <= entryPtr->selectFirst) {
	entryPtr->selectFirst = -1;
	entryPtr->selectLast = -1;
    }
    if (entryPtr->selectAnchor >= index) {
	if (entryPtr->selectAnchor >= (index+count)) {
	    entryPtr->selectAnchor -= count;
	} else {
	    entryPtr->selectAnchor = index;
	}
    }
    if (entryPtr->leftIndex > index) {
	if (entryPtr->leftIndex >= (index + count)) {
	    entryPtr->leftIndex -= count;
	} else {
	    entryPtr->leftIndex = index;
	}
    }
    if (entryPtr->insertPos >= index) {
	if (entryPtr->insertPos >= (index + count)) {
	    entryPtr->insertPos -= count;
	} else {
	    entryPtr->insertPos = index;
	}
    }
    EntryValueChanged(entryPtr);
}
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
 *	result in an infinite loop.
 *
 *----------------------------------------------------------------------
 */

static void
EntrySetValue(entryPtr, value)
    register Entry *entryPtr;		/* Entry whose value is to be
					 * changed. */
    char *value;			/* New text to display in entry. */
{




    ckfree(entryPtr->string);

    entryPtr->numChars = strlen(value);

    entryPtr->string = (char *) ckalloc((unsigned) (entryPtr->numChars + 1));
    strcpy(entryPtr->string, value);






    if (entryPtr->selectFirst != -1) {
	if (entryPtr->selectFirst >= entryPtr->numChars) {
	    entryPtr->selectFirst = entryPtr->selectLast = -1;

	} else if (entryPtr->selectLast > entryPtr->numChars) {
	    entryPtr->selectLast = entryPtr->numChars;
	}
    }
    if (entryPtr->leftIndex >= entryPtr->numChars) {
	entryPtr->leftIndex = entryPtr->numChars-1;
	if (entryPtr->leftIndex < 0) {

	    entryPtr->leftIndex = 0;
	}
    }
    if (entryPtr->insertPos > entryPtr->numChars) {
	entryPtr->insertPos = entryPtr->numChars;
    }








|
<
|

>
>
>
>

>
|
>
|

>
>
>
>
>
>
|

|
>





|
|
>







1819
1820
1821
1822
1823
1824
1825
1826

1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
 *	result in an infinite loop.
 *
 *----------------------------------------------------------------------
 */

static void
EntrySetValue(entryPtr, value)
    Entry *entryPtr;		/* Entry whose value is to be changed. */

    char *value;		/* New text to display in entry. */
{
    char *oldSource;

    oldSource = entryPtr->string;

    ckfree(entryPtr->string);
    entryPtr->numBytes = strlen(value);
    entryPtr->numChars = Tcl_NumUtfChars(value, entryPtr->numBytes);
    entryPtr->string =
	    (char *) ckalloc((unsigned) (entryPtr->numBytes + 1));
    strcpy(entryPtr->string, value);

    if (entryPtr->displayString == oldSource) {
	entryPtr->displayString = entryPtr->string;
	entryPtr->numDisplayBytes = entryPtr->numBytes;
    }

    if (entryPtr->selectFirst >= 0) {
	if (entryPtr->selectFirst >= entryPtr->numChars) {
	    entryPtr->selectFirst = -1;
	    entryPtr->selectLast = -1;
	} else if (entryPtr->selectLast > entryPtr->numChars) {
	    entryPtr->selectLast = entryPtr->numChars;
	}
    }
    if (entryPtr->leftIndex >= entryPtr->numChars) {
	if (entryPtr->numChars > 0) {
	    entryPtr->leftIndex = entryPtr->numChars - 1;
	} else {
	    entryPtr->leftIndex = 0;
	}
    }
    if (entryPtr->insertPos > entryPtr->numChars) {
	entryPtr->insertPos = entryPtr->numChars;
    }

1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
    XEvent *eventPtr;		/* Information about event. */
{
    Entry *entryPtr = (Entry *) clientData;
    if (eventPtr->type == Expose) {
	EventuallyRedraw(entryPtr);
	entryPtr->flags |= BORDER_NEEDED;
    } else if (eventPtr->type == DestroyNotify) {
	if (entryPtr->tkwin != NULL) {
	    entryPtr->tkwin = NULL;
            Tcl_DeleteCommandFromToken(entryPtr->interp, entryPtr->widgetCmd);
	}
	if (entryPtr->flags & REDRAW_PENDING) {
	    Tcl_CancelIdleCall(DisplayEntry, (ClientData) entryPtr);
	}
	Tcl_EventuallyFree((ClientData) entryPtr, DestroyEntry);
    } else if (eventPtr->type == ConfigureNotify) {
	Tcl_Preserve((ClientData) entryPtr);
	entryPtr->flags |= UPDATE_SCROLLBAR;
	EntryComputeGeometry(entryPtr);
	EventuallyRedraw(entryPtr);
	Tcl_Release((ClientData) entryPtr);
    } else if (eventPtr->type == FocusIn) {







<
<
<
<
<
<
<
|







1890
1891
1892
1893
1894
1895
1896







1897
1898
1899
1900
1901
1902
1903
1904
    XEvent *eventPtr;		/* Information about event. */
{
    Entry *entryPtr = (Entry *) clientData;
    if (eventPtr->type == Expose) {
	EventuallyRedraw(entryPtr);
	entryPtr->flags |= BORDER_NEEDED;
    } else if (eventPtr->type == DestroyNotify) {







        DestroyEntry((char *) clientData);
    } else if (eventPtr->type == ConfigureNotify) {
	Tcl_Preserve((ClientData) entryPtr);
	entryPtr->flags |= UPDATE_SCROLLBAR;
	EntryComputeGeometry(entryPtr);
	EventuallyRedraw(entryPtr);
	Tcl_Release((ClientData) entryPtr);
    } else if (eventPtr->type == FocusIn) {
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731

1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
 */

static void
EntryCmdDeletedProc(clientData)
    ClientData clientData;	/* Pointer to widget record for widget. */
{
    Entry *entryPtr = (Entry *) clientData;
    Tk_Window tkwin = entryPtr->tkwin;

    /*
     * This procedure could be invoked either because the window was
     * destroyed and the command was then deleted (in which case tkwin
     * is NULL) or because the command was deleted, and then this procedure
     * destroys the widget.
     */

    if (tkwin != NULL) {
	entryPtr->tkwin = NULL;
	Tk_DestroyWindow(tkwin);
    }
}

/*
 *--------------------------------------------------------------
 *
 * GetEntryIndex --
 *
 *	Parse an index into an entry and return either its value
 *	or an error.
 *
 * Results:
 *	A standard Tcl result.  If all went well, then *indexPtr is
 *	filled in with the index (into entryPtr) corresponding to
 *	string.  The index value is guaranteed to lie between 0 and
 *	the number of characters in the string, inclusive.  If an
 *	error occurs then an error message is left in interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
GetEntryIndex(interp, entryPtr, string, indexPtr)
    Tcl_Interp *interp;		/* For error messages. */
    Entry *entryPtr;		/* Entry for which the index is being
				 * specified. */
    char *string;		/* Specifies character in entryPtr. */
    int *indexPtr;		/* Where to store converted index. */

{
    size_t length;

    length = strlen(string);

    if (string[0] == 'a') {
	if (strncmp(string, "anchor", length) == 0) {
	    *indexPtr = entryPtr->selectAnchor;
	} else {
	    badIndex:

	    /*
	     * Some of the paths here leave messages in interp->result,
	     * so we have to clear it out before storing our own message.
	     */

	    Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
	    Tcl_AppendResult(interp, "bad entry index \"", string,
		    "\"", (char *) NULL);
	    return TCL_ERROR;







<








<
|
|




|








|


|




|








|
>












|







1931
1932
1933
1934
1935
1936
1937

1938
1939
1940
1941
1942
1943
1944
1945

1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
 */

static void
EntryCmdDeletedProc(clientData)
    ClientData clientData;	/* Pointer to widget record for widget. */
{
    Entry *entryPtr = (Entry *) clientData;


    /*
     * This procedure could be invoked either because the window was
     * destroyed and the command was then deleted (in which case tkwin
     * is NULL) or because the command was deleted, and then this procedure
     * destroys the widget.
     */


    if (! entryPtr->flags & ENTRY_DELETED) {
        Tk_DestroyWindow(entryPtr->tkwin);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * GetEntryIndex --
 *
 *	Parse an index into an entry and return either its value
 *	or an error.
 *
 * Results:
 *	A standard Tcl result.  If all went well, then *indexPtr is
 *	filled in with the character index (into entryPtr) corresponding to
 *	string.  The index value is guaranteed to lie between 0 and
 *	the number of characters in the string, inclusive.  If an
 *	error occurs then an error message is left in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
GetEntryIndex(interp, entryPtr, string, indexPtr)
    Tcl_Interp *interp;		/* For error messages. */
    Entry *entryPtr;		/* Entry for which the index is being
				 * specified. */
    char *string;		/* Specifies character in entryPtr. */
    int *indexPtr;		/* Where to store converted character
				 * index. */
{
    size_t length;

    length = strlen(string);

    if (string[0] == 'a') {
	if (strncmp(string, "anchor", length) == 0) {
	    *indexPtr = entryPtr->selectAnchor;
	} else {
	    badIndex:

	    /*
	     * Some of the paths here leave messages in the interp's result,
	     * so we have to clear it out before storing our own message.
	     */

	    Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
	    Tcl_AppendResult(interp, "bad entry index \"", string,
		    "\"", (char *) NULL);
	    return TCL_ERROR;
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
    } else if (string[0] == 'i') {
	if (strncmp(string, "insert", length) == 0) {
	    *indexPtr = entryPtr->insertPos;
	} else {
	    goto badIndex;
	}
    } else if (string[0] == 's') {
	if (entryPtr->selectFirst == -1) {
	    interp->result = "selection isn't in entry";
	    return TCL_ERROR;
	}
	if (length < 5) {
	    goto badIndex;
	}
	if (strncmp(string, "sel.first", length) == 0) {
	    *indexPtr = entryPtr->selectFirst;
	} else if (strncmp(string, "sel.last", length) == 0) {
	    *indexPtr = entryPtr->selectLast;
	} else {
	    goto badIndex;
	}
    } else if (string[0] == '@') {
	int x, roundUp;

	if (Tcl_GetInt(interp, string+1, &x) != TCL_OK) {
	    goto badIndex;
	}
	if (x < entryPtr->inset) {
	    x = entryPtr->inset;
	}
	roundUp = 0;
	if (x >= (Tk_Width(entryPtr->tkwin) - entryPtr->inset)) {







|
|















|







2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
    } else if (string[0] == 'i') {
	if (strncmp(string, "insert", length) == 0) {
	    *indexPtr = entryPtr->insertPos;
	} else {
	    goto badIndex;
	}
    } else if (string[0] == 's') {
	if (entryPtr->selectFirst < 0) {
	    Tcl_SetResult(interp, "selection isn't in entry", TCL_STATIC);
	    return TCL_ERROR;
	}
	if (length < 5) {
	    goto badIndex;
	}
	if (strncmp(string, "sel.first", length) == 0) {
	    *indexPtr = entryPtr->selectFirst;
	} else if (strncmp(string, "sel.last", length) == 0) {
	    *indexPtr = entryPtr->selectLast;
	} else {
	    goto badIndex;
	}
    } else if (string[0] == '@') {
	int x, roundUp;

	if (Tcl_GetInt(interp, string + 1, &x) != TCL_OK) {
	    goto badIndex;
	}
	if (x < entryPtr->inset) {
	    x = entryPtr->inset;
	}
	roundUp = 0;
	if (x >= (Tk_Width(entryPtr->tkwin) - entryPtr->inset)) {
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
	if (Tcl_GetInt(interp, string, indexPtr) != TCL_OK) {
	    goto badIndex;
	}
	if (*indexPtr < 0){
	    *indexPtr = 0;
	} else if (*indexPtr > entryPtr->numChars) {
	    *indexPtr = entryPtr->numChars;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|







2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
	if (Tcl_GetInt(interp, string, indexPtr) != TCL_OK) {
	    goto badIndex;
	}
	if (*indexPtr < 0){
	    *indexPtr = 0;
	} else if (*indexPtr > entryPtr->numChars) {
	    *indexPtr = entryPtr->numChars;
	} 
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865

1866
1867
1868
1869




1870
1871
1872
1873
1874
1875
1876
 *	The view in the window may change.
 *
 *----------------------------------------------------------------------
 */

static void
EntryScanTo(entryPtr, x)
    register Entry *entryPtr;		/* Information about widget. */
    int x;				/* X-coordinate to use for scan
					 * operation. */
{
    int newLeftIndex;

    /*
     * Compute new leftIndex for entry by amplifying the difference
     * between the current position and the place where the scan
     * started (the "mark" position).  If we run off the left or right
     * side of the entry, then reset the mark point so that the current
     * position continues to correspond to the edge of the window.
     * This means that the picture will start dragging as soon as the
     * mouse reverses direction (without this reset, might have to slide
     * mouse a long ways back before the picture starts moving again).
     */

    newLeftIndex = entryPtr->scanMarkIndex
	    - (10*(x - entryPtr->scanMarkX))/entryPtr->avgWidth;
    if (newLeftIndex >= entryPtr->numChars) {
	newLeftIndex = entryPtr->scanMarkIndex = entryPtr->numChars-1;
	entryPtr->scanMarkX = x;
    }
    if (newLeftIndex < 0) {
	newLeftIndex = entryPtr->scanMarkIndex = 0;
	entryPtr->scanMarkX = x;
    } 

    if (newLeftIndex != entryPtr->leftIndex) {
	entryPtr->leftIndex = newLeftIndex;
	entryPtr->flags |= UPDATE_SCROLLBAR;
	EntryComputeGeometry(entryPtr);




	EventuallyRedraw(entryPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *







|
|
<















|

|






>




>
>
>
>







2080
2081
2082
2083
2084
2085
2086
2087
2088

2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
 *	The view in the window may change.
 *
 *----------------------------------------------------------------------
 */

static void
EntryScanTo(entryPtr, x)
    Entry *entryPtr;		/* Information about widget. */
    int x;			/* X-coordinate to use for scan operation. */

{
    int newLeftIndex;

    /*
     * Compute new leftIndex for entry by amplifying the difference
     * between the current position and the place where the scan
     * started (the "mark" position).  If we run off the left or right
     * side of the entry, then reset the mark point so that the current
     * position continues to correspond to the edge of the window.
     * This means that the picture will start dragging as soon as the
     * mouse reverses direction (without this reset, might have to slide
     * mouse a long ways back before the picture starts moving again).
     */

    newLeftIndex = entryPtr->scanMarkIndex
	    - (10 * (x - entryPtr->scanMarkX)) / entryPtr->avgWidth;
    if (newLeftIndex >= entryPtr->numChars) {
	newLeftIndex = entryPtr->scanMarkIndex = entryPtr->numChars - 1;
	entryPtr->scanMarkX = x;
    }
    if (newLeftIndex < 0) {
	newLeftIndex = entryPtr->scanMarkIndex = 0;
	entryPtr->scanMarkX = x;
    } 

    if (newLeftIndex != entryPtr->leftIndex) {
	entryPtr->leftIndex = newLeftIndex;
	entryPtr->flags |= UPDATE_SCROLLBAR;
	EntryComputeGeometry(entryPtr);
	if (newLeftIndex != entryPtr->leftIndex) {
	    entryPtr->scanMarkIndex = entryPtr->leftIndex;
	    entryPtr->scanMarkX = x;
	}
	EventuallyRedraw(entryPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
 *	The selection changes.
 *
 *----------------------------------------------------------------------
 */

static void
EntrySelectTo(entryPtr, index)
    register Entry *entryPtr;		/* Information about widget. */
    int index;				/* Index of element that is to
					 * become the "other" end of the
					 * selection. */
{
    int newFirst, newLast;

    /*
     * Grab the selection if we don't own it already.
     */








|
|
|
<







2138
2139
2140
2141
2142
2143
2144
2145
2146
2147

2148
2149
2150
2151
2152
2153
2154
 *	The selection changes.
 *
 *----------------------------------------------------------------------
 */

static void
EntrySelectTo(entryPtr, index)
    Entry *entryPtr;		/* Information about widget. */
    int index;			/* Character index of element that is to
				 * become the "other" end of the selection. */

{
    int newFirst, newLast;

    /*
     * Grab the selection if we don't own it already.
     */

1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974



1975

1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
EntryFetchSelection(clientData, offset, buffer, maxBytes)
    ClientData clientData;		/* Information about entry widget. */
    int offset;				/* Offset within selection of first
					 * character to be returned. */
    char *buffer;			/* Location in which to place
					 * selection. */
    int maxBytes;			/* Maximum number of bytes to place
					 * at buffer, not including terminating
					 * NULL character. */
{
    Entry *entryPtr = (Entry *) clientData;
    int count;
    char *displayString;

    if ((entryPtr->selectFirst < 0) || !(entryPtr->exportSelection)) {
	return -1;
    }



    count = entryPtr->selectLast - entryPtr->selectFirst - offset;

    if (count > maxBytes) {
	count = maxBytes;
    }
    if (count <= 0) {
	return 0;
    }
    if (entryPtr->displayString == NULL) {
	displayString = entryPtr->string;
    } else {
	displayString = entryPtr->displayString;
    }
    strncpy(buffer, displayString + entryPtr->selectFirst + offset,
	    (size_t) count);
    buffer[count] = '\0';
    return count;
}

/*
 *----------------------------------------------------------------------
 *
 * EntryLostSelection --
 *







|
|
|
|
<
|
|
|


|
|




>
>
>
|
>
|
|

|


<
<
<
<
<
<
|
|
|







2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213

2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235






2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
EntryFetchSelection(clientData, offset, buffer, maxBytes)
    ClientData clientData;	/* Information about entry widget. */
    int offset;			/* Byte offset within selection of first
				 * character to be returned. */
    char *buffer;		/* Location in which to place selection. */

    int maxBytes;		/* Maximum number of bytes to place at
				 * buffer, not including terminating NULL
				 * character. */
{
    Entry *entryPtr = (Entry *) clientData;
    int byteCount;
    char *string, *selStart, *selEnd;

    if ((entryPtr->selectFirst < 0) || !(entryPtr->exportSelection)) {
	return -1;
    }
    string = entryPtr->displayString;
    selStart = Tcl_UtfAtIndex(string, entryPtr->selectFirst);
    selEnd = Tcl_UtfAtIndex(selStart,
	    entryPtr->selectLast - entryPtr->selectFirst);
    byteCount = selEnd - selStart - offset;
    if (byteCount > maxBytes) {
	byteCount = maxBytes;
    }
    if (byteCount <= 0) {
	return 0;
    }






    memcpy(buffer, selStart + offset, (size_t) byteCount);
    buffer[byteCount] = '\0';
    return byteCount;
}

/*
 *----------------------------------------------------------------------
 *
 * EntryLostSelection --
 *
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
 *	marked as not containing a selection.
 *
 *----------------------------------------------------------------------
 */

static void
EntryLostSelection(clientData)
    ClientData clientData;		/* Information about entry widget. */
{
    Entry *entryPtr = (Entry *) clientData;

    entryPtr->flags &= ~GOT_SELECTION;

    /*
     * On Windows and Mac systems, we want to remember the selection
     * for the next time the focus enters the window.  On Unix, we need
     * to clear the selection since it is always visible.
     */

#ifdef ALWAYS_SHOW_SELECTION
    if ((entryPtr->selectFirst != -1) && entryPtr->exportSelection) {
	entryPtr->selectFirst = -1;
	entryPtr->selectLast = -1;
	EventuallyRedraw(entryPtr);
    }
#endif
}








|












|







2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
 *	marked as not containing a selection.
 *
 *----------------------------------------------------------------------
 */

static void
EntryLostSelection(clientData)
    ClientData clientData;	/* Information about entry widget. */
{
    Entry *entryPtr = (Entry *) clientData;

    entryPtr->flags &= ~GOT_SELECTION;

    /*
     * On Windows and Mac systems, we want to remember the selection
     * for the next time the focus enters the window.  On Unix, we need
     * to clear the selection since it is always visible.
     */

#ifdef ALWAYS_SHOW_SELECTION
    if ((entryPtr->selectFirst >= 0) && entryPtr->exportSelection) {
	entryPtr->selectFirst = -1;
	entryPtr->selectLast = -1;
	EventuallyRedraw(entryPtr);
    }
#endif
}

2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
 *	could be changed.
 *
 *----------------------------------------------------------------------
 */

static void
EventuallyRedraw(entryPtr)
    register Entry *entryPtr;		/* Information about widget. */
{
    if ((entryPtr->tkwin == NULL) || !Tk_IsMapped(entryPtr->tkwin)) {
	return;
    }

    /*
     * Right now we don't do selective redisplays:  the whole window







|







2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
 *	could be changed.
 *
 *----------------------------------------------------------------------
 */

static void
EventuallyRedraw(entryPtr)
    Entry *entryPtr;		/* Information about widget. */
{
    if ((entryPtr->tkwin == NULL) || !Tk_IsMapped(entryPtr->tkwin)) {
	return;
    }

    /*
     * Right now we don't do selective redisplays:  the whole window
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120

2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
EntryVisibleRange(entryPtr, firstPtr, lastPtr)
    Entry *entryPtr;			/* Information about widget. */
    double *firstPtr;			/* Return position of first visible
					 * character in widget. */
    double *lastPtr;			/* Return position of char just after
					 * last visible one. */
{
    int charsInWindow;

    if (entryPtr->numChars == 0) {
	*firstPtr = 0.0;
	*lastPtr = 1.0;
    } else {
	charsInWindow = Tk_PointToChar(entryPtr->textLayout,
		Tk_Width(entryPtr->tkwin) - entryPtr->inset
			- entryPtr->layoutX - 1, 0) + 1;
	if (charsInWindow > entryPtr->numChars) {
	    /*
	     * If all chars were visible, then charsInWindow will be
	     * the index just after the last char that was visible.
	     */
	     
	    charsInWindow = entryPtr->numChars;
	}
	charsInWindow -= entryPtr->leftIndex;
	if (charsInWindow == 0) {
	    charsInWindow = 1;
	}

	*firstPtr = ((double) entryPtr->leftIndex)/entryPtr->numChars;
	*lastPtr = ((double) (entryPtr->leftIndex + charsInWindow))
		/entryPtr->numChars;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * EntryUpdateScrollbar --







|
|
|
|
|









|
|
<
<
<
<
<
|





>
|
|
|







2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357





2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
EntryVisibleRange(entryPtr, firstPtr, lastPtr)
    Entry *entryPtr;		/* Information about widget. */
    double *firstPtr;		/* Return position of first visible
				 * character in widget. */
    double *lastPtr;		/* Return position of char just after last
				 * visible one. */
{
    int charsInWindow;

    if (entryPtr->numChars == 0) {
	*firstPtr = 0.0;
	*lastPtr = 1.0;
    } else {
	charsInWindow = Tk_PointToChar(entryPtr->textLayout,
		Tk_Width(entryPtr->tkwin) - entryPtr->inset
			- entryPtr->layoutX - 1, 0);
	if (charsInWindow < entryPtr->numChars) {





	    charsInWindow++;
	}
	charsInWindow -= entryPtr->leftIndex;
	if (charsInWindow == 0) {
	    charsInWindow = 1;
	}

	*firstPtr = (double) entryPtr->leftIndex / entryPtr->numChars;
	*lastPtr = (double) (entryPtr->leftIndex + charsInWindow)
		/ entryPtr->numChars;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * EntryUpdateScrollbar --
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
 *----------------------------------------------------------------------
 */

static void
EntryUpdateScrollbar(entryPtr)
    Entry *entryPtr;			/* Information about widget. */
{
    char args[100];
    int code;
    double first, last;
    Tcl_Interp *interp;

    if (entryPtr->scrollCmd == NULL) {
	return;
    }







|







2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
 *----------------------------------------------------------------------
 */

static void
EntryUpdateScrollbar(entryPtr)
    Entry *entryPtr;			/* Information about widget. */
{
    char args[TCL_DOUBLE_SPACE * 2];
    int code;
    double first, last;
    Tcl_Interp *interp;

    if (entryPtr->scrollCmd == NULL) {
	return;
    }
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
 *----------------------------------------------------------------------
 */

static void
EntryBlinkProc(clientData)
    ClientData clientData;	/* Pointer to record describing entry. */
{
    register Entry *entryPtr = (Entry *) clientData;

    if (!(entryPtr->flags & GOT_FOCUS) || (entryPtr->insertOffTime == 0)) {
	return;
    }
    if (entryPtr->flags & CURSOR_ON) {
	entryPtr->flags &= ~CURSOR_ON;
	entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler(







|







2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
 *----------------------------------------------------------------------
 */

static void
EntryBlinkProc(clientData)
    ClientData clientData;	/* Pointer to record describing entry. */
{
    Entry *entryPtr = (Entry *) clientData;

    if (!(entryPtr->flags & GOT_FOCUS) || (entryPtr->insertOffTime == 0)) {
	return;
    }
    if (entryPtr->flags & CURSOR_ON) {
	entryPtr->flags &= ~CURSOR_ON;
	entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
 *	The cursor gets turned on or off.
 *
 *----------------------------------------------------------------------
 */

static void
EntryFocusProc(entryPtr, gotFocus)
    register Entry *entryPtr;	/* Entry that got or lost focus. */
    int gotFocus;		/* 1 means window is getting focus, 0 means
				 * it's losing it. */
{
    Tcl_DeleteTimerHandler(entryPtr->insertBlinkHandler);
    if (gotFocus) {
	entryPtr->flags |= GOT_FOCUS | CURSOR_ON;
	if (entryPtr->insertOffTime != 0) {







|







2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
 *	The cursor gets turned on or off.
 *
 *----------------------------------------------------------------------
 */

static void
EntryFocusProc(entryPtr, gotFocus)
    Entry *entryPtr;		/* Entry that got or lost focus. */
    int gotFocus;		/* 1 means window is getting focus, 0 means
				 * it's losing it. */
{
    Tcl_DeleteTimerHandler(entryPtr->insertBlinkHandler);
    if (gotFocus) {
	entryPtr->flags |= GOT_FOCUS | CURSOR_ON;
	if (entryPtr->insertOffTime != 0) {
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
EntryTextVarProc(clientData, interp, name1, name2, flags)
    ClientData clientData;	/* Information about button. */
    Tcl_Interp *interp;		/* Interpreter containing variable. */
    char *name1;		/* Not used. */
    char *name2;		/* Not used. */
    int flags;			/* Information about what happened. */
{
    register Entry *entryPtr = (Entry *) clientData;
    char *value;

    /*
     * If the variable is unset, then immediately recreate it unless
     * the whole interpreter is going away.
     */








|







2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
EntryTextVarProc(clientData, interp, name1, name2, flags)
    ClientData clientData;	/* Information about button. */
    Tcl_Interp *interp;		/* Interpreter containing variable. */
    char *name1;		/* Not used. */
    char *name2;		/* Not used. */
    int flags;			/* Information about what happened. */
{
    Entry *entryPtr = (Entry *) clientData;
    char *value;

    /*
     * If the variable is unset, then immediately recreate it unless
     * the whole interpreter is going away.
     */

Changes to generic/tkError.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkError.c 1.23 97/04/25 16:51:27
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * The default X error handler gets saved here, so that it can







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkError.c,v 1.1.4.1 1998/09/30 02:16:54 stanton Exp $
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * The default X error handler gets saved here, so that it can

Changes to generic/tkEvent.c.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkEvent.c --
 *
 *	This file provides basic low-level facilities for managing
 *	X events in Tk.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkEvent.c 1.20 96/09/20 09:33:38
 */

#include "tkPort.h"
#include "tkInt.h"
#include <signal.h>

/*








>




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkEvent.c --
 *
 *	This file provides basic low-level facilities for managing
 *	X events in Tk.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkEvent.c,v 1.1.4.3 1998/12/13 08:16:04 lfb Exp $
 */

#include "tkPort.h"
#include "tkInt.h"
#include <signal.h>

/*
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
    TkWindow *winPtr;		 /* Window for event.  Gets set to None if
				  * window is deleted while event is being
				  * handled. */
    TkEventHandler *nextHandler; /* Next handler in search. */
    struct InProgress *nextPtr;	 /* Next higher nested search. */
} InProgress;

static InProgress *pendingPtr = NULL;
				/* Topmost search in progress, or
				 * NULL if none. */

/*
 * For each call to Tk_CreateGenericHandler, an instance of the following
 * structure will be created.  All of the active handlers are linked into a
 * list.
 */

typedef struct GenericHandler {
    Tk_GenericProc *proc;	/* Procedure to dispatch on all X events. */
    ClientData clientData;	/* Client data to pass to procedure. */
    int deleteFlag;		/* Flag to set when this handler is deleted. */
    struct GenericHandler *nextPtr;
				/* Next handler in list of all generic
				 * handlers, or NULL for end of list. */
} GenericHandler;

static GenericHandler *genericList = NULL;
				/* First handler in the list, or NULL. */
static GenericHandler *lastGenericPtr = NULL;
				/* Last handler in list. */

/*
 * There's a potential problem if Tk_HandleEvent is entered recursively.
 * A handler cannot be deleted physically until we have returned from
 * calling it.  Otherwise, we're looking at unallocated memory in advancing to
 * its `next' entry.  We deal with the problem by using the `delete flag' and
 * deleting handlers only when it's known that there's no handler active.
 *
 * The following variable has a non-zero value when a handler is active.
 */

static int genericHandlersActive = 0;

/*
 * The following structure is used for queueing X-style events on the
 * Tcl event queue.
 */

typedef struct TkWindowEvent {
    Tcl_Event header;		/* Standard information for all events. */







<
<
<
<















<
<
<
<
<







<


<
<







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
    TkWindow *winPtr;		 /* Window for event.  Gets set to None if
				  * window is deleted while event is being
				  * handled. */
    TkEventHandler *nextHandler; /* Next handler in search. */
    struct InProgress *nextPtr;	 /* Next higher nested search. */
} InProgress;





/*
 * For each call to Tk_CreateGenericHandler, an instance of the following
 * structure will be created.  All of the active handlers are linked into a
 * list.
 */

typedef struct GenericHandler {
    Tk_GenericProc *proc;	/* Procedure to dispatch on all X events. */
    ClientData clientData;	/* Client data to pass to procedure. */
    int deleteFlag;		/* Flag to set when this handler is deleted. */
    struct GenericHandler *nextPtr;
				/* Next handler in list of all generic
				 * handlers, or NULL for end of list. */
} GenericHandler;






/*
 * There's a potential problem if Tk_HandleEvent is entered recursively.
 * A handler cannot be deleted physically until we have returned from
 * calling it.  Otherwise, we're looking at unallocated memory in advancing to
 * its `next' entry.  We deal with the problem by using the `delete flag' and
 * deleting handlers only when it's known that there's no handler active.
 *

 */



/*
 * The following structure is used for queueing X-style events on the
 * Tcl event queue.
 */

typedef struct TkWindowEvent {
    Tcl_Event header;		/* Standard information for all events. */
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
    0,					/* SelectionRequest */
    0,					/* SelectionNotify */
    ColormapChangeMask,			/* ColormapNotify */
    0,					/* ClientMessage */
    0,					/* Mapping Notify */
    VirtualEventMask,			/* VirtualEvents */
    ActivateMask,			/* ActivateNotify */
    ActivateMask			/* DeactivateNotify */

};


/*



















 * If someone has called Tk_RestrictEvents, the information below
 * keeps track of it.
 */

static Tk_RestrictProc *restrictProc;
				/* Procedure to call.  NULL means no
				 * restrictProc is currently in effect. */
static ClientData restrictArg;	/* Argument to pass to restrictProc. */



/*
 * Prototypes for procedures that are only referenced locally within
 * this file.
 */

static void		DelayedMotionProc _ANSI_ARGS_((ClientData clientData));







|
>


>

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

|


|
>
>







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
    0,					/* SelectionRequest */
    0,					/* SelectionNotify */
    ColormapChangeMask,			/* ColormapNotify */
    0,					/* ClientMessage */
    0,					/* Mapping Notify */
    VirtualEventMask,			/* VirtualEvents */
    ActivateMask,			/* ActivateNotify */
    ActivateMask,			/* DeactivateNotify */
    MouseWheelMask			/* MouseWheelEvent */
};


/*
 * The structure below is used to store Data for the Event module that
 * must be kept thread-local.  The "dataKey" is used to fetch the 
 * thread-specific storage for the current thread.
 */

typedef struct ThreadSpecificData {

    int genericHandlersActive;
                                /* The following variable has a non-zero 
				 * value when a handler is active. */
    InProgress *pendingPtr;
				/* Topmost search in progress, or
				 * NULL if none. */
    GenericHandler *genericList;
				/* First handler in the list, or NULL. */
    GenericHandler *lastGenericPtr;
				/* Last handler in list. */

    /*
     * If someone has called Tk_RestrictEvents, the information below
     * keeps track of it.
     */

    Tk_RestrictProc *restrictProc;
				/* Procedure to call.  NULL means no
				 * restrictProc is currently in effect. */
    ClientData restrictArg;     /* Argument to pass to restrictProc. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Prototypes for procedures that are only referenced locally within
 * this file.
 */

static void		DelayedMotionProc _ANSI_ARGS_((ClientData clientData));
260
261
262
263
264
265
266


267
268
269
270
271
272
273
    Tk_EventProc *proc;
    ClientData clientData;
{
    register TkEventHandler *handlerPtr;
    register InProgress *ipPtr;
    TkEventHandler *prevPtr;
    register TkWindow *winPtr = (TkWindow *) token;



    /*
     * Find the event handler to be deleted, or return
     * immediately if it doesn't exist.
     */

    for (handlerPtr = winPtr->handlerList, prevPtr = NULL; ;







>
>







272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
    Tk_EventProc *proc;
    ClientData clientData;
{
    register TkEventHandler *handlerPtr;
    register InProgress *ipPtr;
    TkEventHandler *prevPtr;
    register TkWindow *winPtr = (TkWindow *) token;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Find the event handler to be deleted, or return
     * immediately if it doesn't exist.
     */

    for (handlerPtr = winPtr->handlerList, prevPtr = NULL; ;
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
    }

    /*
     * If Tk_HandleEvent is about to process this handler, tell it to
     * process the next one instead.
     */

    for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	if (ipPtr->nextHandler == handlerPtr) {
	    ipPtr->nextHandler = handlerPtr->nextPtr;
	}
    }

    /*
     * Free resources associated with the handler.







|







296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
    }

    /*
     * If Tk_HandleEvent is about to process this handler, tell it to
     * process the next one instead.
     */

    for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	if (ipPtr->nextHandler == handlerPtr) {
	    ipPtr->nextHandler = handlerPtr->nextPtr;
	}
    }

    /*
     * Free resources associated with the handler.
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

void
Tk_CreateGenericHandler(proc, clientData)
     Tk_GenericProc *proc;	/* Procedure to call on every event. */
     ClientData clientData;	/* One-word value to pass to proc. */
{
    GenericHandler *handlerPtr;


    
    handlerPtr = (GenericHandler *) ckalloc (sizeof (GenericHandler));
    
    handlerPtr->proc = proc;
    handlerPtr->clientData = clientData;
    handlerPtr->deleteFlag = 0;
    handlerPtr->nextPtr = NULL;
    if (genericList == NULL) {
	genericList = handlerPtr;
    } else {
	lastGenericPtr->nextPtr = handlerPtr;
    }
    lastGenericPtr = handlerPtr;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_DeleteGenericHandler --
 *







>
>







|
|

|

|







345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373

void
Tk_CreateGenericHandler(proc, clientData)
     Tk_GenericProc *proc;	/* Procedure to call on every event. */
     ClientData clientData;	/* One-word value to pass to proc. */
{
    GenericHandler *handlerPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    
    handlerPtr = (GenericHandler *) ckalloc (sizeof (GenericHandler));
    
    handlerPtr->proc = proc;
    handlerPtr->clientData = clientData;
    handlerPtr->deleteFlag = 0;
    handlerPtr->nextPtr = NULL;
    if (tsdPtr->genericList == NULL) {
	tsdPtr->genericList = handlerPtr;
    } else {
	tsdPtr->lastGenericPtr->nextPtr = handlerPtr;
    }
    tsdPtr->lastGenericPtr = handlerPtr;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_DeleteGenericHandler --
 *
371
372
373
374
375
376
377


378
379
380
381
382
383
384

































385
386
387
388
389
390
391

void
Tk_DeleteGenericHandler(proc, clientData)
     Tk_GenericProc *proc;
     ClientData clientData;
{
    GenericHandler * handler;


    
    for (handler = genericList; handler; handler = handler->nextPtr) {
	if ((handler->proc == proc) && (handler->clientData == clientData)) {
	    handler->deleteFlag = 1;
	}
    }
}


































/*
 *--------------------------------------------------------------
 *
 * Tk_HandleEvent --
 *
 *	Given an event, invoke all the handlers that have







>
>

|





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







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

void
Tk_DeleteGenericHandler(proc, clientData)
     Tk_GenericProc *proc;
     ClientData clientData;
{
    GenericHandler * handler;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    
    for (handler = tsdPtr->genericList; handler; handler = handler->nextPtr) {
	if ((handler->proc == proc) && (handler->clientData == clientData)) {
	    handler->deleteFlag = 1;
	}
    }
}

/*
 *--------------------------------------------------------------
 *
 * TkEventInit --
 *
 *	This procedures initializes all the event module 
 *      structures used by the current thread.  It must be
 *      called before any other procedure in this file is 
 *      called.
 *
 * Results:
 *	None.
 *
 * Side Effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

void
TkEventInit(void)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    tsdPtr->genericHandlersActive = 0;
    tsdPtr->pendingPtr = NULL;
    tsdPtr->genericList = NULL;
    tsdPtr->lastGenericPtr = NULL;
    tsdPtr->restrictProc = NULL;
    tsdPtr->restrictArg = NULL;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_HandleEvent --
 *
 *	Given an event, invoke all the handlers that have
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
    register GenericHandler *genPrevPtr;
    TkWindow *winPtr;
    unsigned long mask;
    InProgress ip;
    Window handlerWindow;
    TkDisplay *dispPtr;
    Tcl_Interp *interp = (Tcl_Interp *) NULL;



    /* 
     * Next, invoke all the generic event handlers (those that are
     * invoked for all events).  If a generic event handler reports that
     * an event is fully processed, go no further.
     */

    for (genPrevPtr = NULL, genericPtr = genericList;  genericPtr != NULL; ) {

	if (genericPtr->deleteFlag) {
	    if (!genericHandlersActive) {
		GenericHandler *tmpPtr;

		/*
		 * This handler needs to be deleted and there are no
		 * calls pending through the handler, so now is a safe
		 * time to delete it.
		 */

		tmpPtr = genericPtr->nextPtr;
		if (genPrevPtr == NULL) {
		    genericList = tmpPtr;
		} else {
		    genPrevPtr->nextPtr = tmpPtr;
		}
		if (tmpPtr == NULL) {
		    lastGenericPtr = genPrevPtr;
		}
		(void) ckfree((char *) genericPtr);
		genericPtr = tmpPtr;
		continue;
	    }
	} else {
	    int done;

	    genericHandlersActive++;
	    done = (*genericPtr->proc)(genericPtr->clientData, eventPtr);
	    genericHandlersActive--;
	    if (done) {
		return;
	    }
	}
	genPrevPtr = genericPtr;
	genericPtr = genPrevPtr->nextPtr;
    }







>
>







|
>

|










|




|








|

|







460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
    register GenericHandler *genPrevPtr;
    TkWindow *winPtr;
    unsigned long mask;
    InProgress ip;
    Window handlerWindow;
    TkDisplay *dispPtr;
    Tcl_Interp *interp = (Tcl_Interp *) NULL;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /* 
     * Next, invoke all the generic event handlers (those that are
     * invoked for all events).  If a generic event handler reports that
     * an event is fully processed, go no further.
     */

    for (genPrevPtr = NULL, genericPtr = tsdPtr->genericList;  
            genericPtr != NULL; ) {
	if (genericPtr->deleteFlag) {
	    if (!tsdPtr->genericHandlersActive) {
		GenericHandler *tmpPtr;

		/*
		 * This handler needs to be deleted and there are no
		 * calls pending through the handler, so now is a safe
		 * time to delete it.
		 */

		tmpPtr = genericPtr->nextPtr;
		if (genPrevPtr == NULL) {
		    tsdPtr->genericList = tmpPtr;
		} else {
		    genPrevPtr->nextPtr = tmpPtr;
		}
		if (tmpPtr == NULL) {
		    tsdPtr->lastGenericPtr = genPrevPtr;
		}
		(void) ckfree((char *) genericPtr);
		genericPtr = tmpPtr;
		continue;
	    }
	} else {
	    int done;

	    tsdPtr->genericHandlersActive++;
	    done = (*genericPtr->proc)(genericPtr->clientData, eventPtr);
	    tsdPtr->genericHandlersActive--;
	    if (done) {
		return;
	    }
	}
	genPrevPtr = genericPtr;
	genericPtr = genPrevPtr->nextPtr;
    }
542
543
544
545
546
547
548
549



550
551
552
553
554
555
556
557
558
559
		&& !TkFocusFilterEvent(winPtr, eventPtr)) {
            Tcl_Release((ClientData) interp);
	    return;
	}
    
	/*
	 * Redirect KeyPress and KeyRelease events to the focus window,
	 * or ignore them entirely if there is no focus window.



	 */
    
	if (mask & (KeyPressMask|KeyReleaseMask)) {
	    winPtr->dispPtr->lastEventTime = eventPtr->xkey.time;
	    winPtr = TkFocusKeyEvent(winPtr, eventPtr);
	    if (winPtr == NULL) {
                Tcl_Release((ClientData) interp);
		return;
	    }
	}







|
>
>
>


|







596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
		&& !TkFocusFilterEvent(winPtr, eventPtr)) {
            Tcl_Release((ClientData) interp);
	    return;
	}
    
	/*
	 * Redirect KeyPress and KeyRelease events to the focus window,
	 * or ignore them entirely if there is no focus window.  We also
	 * route the MouseWheel event to the focus window.  The MouseWheel
	 * event is an extension to the X event set.  Currently, it is only
	 * available on the Windows version of Tk.
	 */
    
	if (mask & (KeyPressMask|KeyReleaseMask|MouseWheelMask)) {
	    winPtr->dispPtr->lastEventTime = eventPtr->xkey.time;
	    winPtr = TkFocusKeyEvent(winPtr, eventPtr);
	    if (winPtr == NULL) {
                Tcl_Release((ClientData) interp);
		return;
	    }
	}
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
     * There's a potential interaction here with Tk_DeleteEventHandler.
     * Read the documentation for pendingPtr.
     */

    ip.eventPtr = eventPtr;
    ip.winPtr = winPtr;
    ip.nextHandler = NULL;
    ip.nextPtr = pendingPtr;
    pendingPtr = &ip;
    if (mask == 0) {
	if ((eventPtr->type == SelectionClear)
		|| (eventPtr->type == SelectionRequest)
		|| (eventPtr->type == SelectionNotify)) {
	    TkSelEventProc((Tk_Window) winPtr, eventPtr);
	} else if ((eventPtr->type == ClientMessage)
		&& (eventPtr->xclient.message_type ==







|
|







671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
     * There's a potential interaction here with Tk_DeleteEventHandler.
     * Read the documentation for pendingPtr.
     */

    ip.eventPtr = eventPtr;
    ip.winPtr = winPtr;
    ip.nextHandler = NULL;
    ip.nextPtr = tsdPtr->pendingPtr;
    tsdPtr->pendingPtr = &ip;
    if (mask == 0) {
	if ((eventPtr->type == SelectionClear)
		|| (eventPtr->type == SelectionRequest)
		|| (eventPtr->type == SelectionNotify)) {
	    TkSelEventProc((Tk_Window) winPtr, eventPtr);
	} else if ((eventPtr->type == ClientMessage)
		&& (eventPtr->xclient.message_type ==
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
	 * these events here than in the lower-level procedures.
	 */

	if ((ip.winPtr != None) && (mask != SubstructureNotifyMask)) {
	    TkBindEventProc(winPtr, eventPtr);
	}
    }
    pendingPtr = ip.nextPtr;
done:

    /*
     * Release the interpreter for this window so that it can be potentially
     * deleted if requested.
     */
    







|







705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
	 * these events here than in the lower-level procedures.
	 */

	if ((ip.winPtr != None) && (mask != SubstructureNotifyMask)) {
	    TkBindEventProc(winPtr, eventPtr);
	}
    }
    tsdPtr->pendingPtr = ip.nextPtr;
done:

    /*
     * Release the interpreter for this window so that it can be potentially
     * deleted if requested.
     */
    
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
void
TkEventDeadWindow(winPtr)
    TkWindow *winPtr;		/* Information about the window
				 * that is being deleted. */
{
    register TkEventHandler *handlerPtr;
    register InProgress *ipPtr;



    /*
     * While deleting all the handlers, be careful to check for
     * Tk_HandleEvent being about to process one of the deleted
     * handlers.  If it is, tell it to quit (all of the handlers
     * are being deleted).
     */

    while (winPtr->handlerList != NULL) {
	handlerPtr = winPtr->handlerList;
	winPtr->handlerList = handlerPtr->nextPtr;

	for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->nextHandler == handlerPtr) {
		ipPtr->nextHandler = NULL;
	    }
	    if (ipPtr->winPtr == winPtr) {
		ipPtr->winPtr = None;
	    }
	}







>
>











>
|







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
void
TkEventDeadWindow(winPtr)
    TkWindow *winPtr;		/* Information about the window
				 * that is being deleted. */
{
    register TkEventHandler *handlerPtr;
    register InProgress *ipPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * While deleting all the handlers, be careful to check for
     * Tk_HandleEvent being about to process one of the deleted
     * handlers.  If it is, tell it to quit (all of the handlers
     * are being deleted).
     */

    while (winPtr->handlerList != NULL) {
	handlerPtr = winPtr->handlerList;
	winPtr->handlerList = handlerPtr->nextPtr;
	for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL; 
                ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->nextHandler == handlerPtr) {
		ipPtr->nextHandler = NULL;
	    }
	    if (ipPtr->winPtr == winPtr) {
		ipPtr->winPtr = None;
	    }
	}
735
736
737
738
739
740
741


742
743
744
745
746
747
748
749
750
751
752
753
 */

Time
TkCurrentTime(dispPtr)
    TkDisplay *dispPtr;		/* Display for which the time is desired. */
{
    register XEvent *eventPtr;



    if (pendingPtr == NULL) {
	return dispPtr->lastEventTime;
    }
    eventPtr = pendingPtr->eventPtr;
    switch (eventPtr->type) {
	case ButtonPress:
	case ButtonRelease:
	    return eventPtr->xbutton.time;
	case KeyPress:
	case KeyRelease:
	    return eventPtr->xkey.time;







>
>

|


|







795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
 */

Time
TkCurrentTime(dispPtr)
    TkDisplay *dispPtr;		/* Display for which the time is desired. */
{
    register XEvent *eventPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (tsdPtr->pendingPtr == NULL) {
	return dispPtr->lastEventTime;
    }
    eventPtr = tsdPtr->pendingPtr->eventPtr;
    switch (eventPtr->type) {
	case ButtonPress:
	case ButtonRelease:
	    return eventPtr->xbutton.time;
	case KeyPress:
	case KeyRelease:
	    return eventPtr->xkey.time;
789
790
791
792
793
794
795


796
797
798
799
800
801
802
803
804
805
806
807
    Tk_RestrictProc *proc;	/* Procedure to call for each incoming
				 * event. */
    ClientData arg;		/* Arbitrary argument to pass to proc. */
    ClientData *prevArgPtr;	/* Place to store information about previous
				 * argument. */
{
    Tk_RestrictProc *prev;



    prev = restrictProc;
    *prevArgPtr = restrictArg;
    restrictProc = proc;
    restrictArg = arg;
    return prev;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_QueueWindowEvent --







>
>

|
|
|
|







851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
    Tk_RestrictProc *proc;	/* Procedure to call for each incoming
				 * event. */
    ClientData arg;		/* Arbitrary argument to pass to proc. */
    ClientData *prevArgPtr;	/* Place to store information about previous
				 * argument. */
{
    Tk_RestrictProc *prev;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    prev = tsdPtr->restrictProc;
    *prevArgPtr = tsdPtr->restrictArg;
    tsdPtr->restrictProc = proc;
    tsdPtr->restrictArg = arg;
    return prev;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_QueueWindowEvent --
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
    TkWindowEvent *wevPtr;
    TkDisplay *dispPtr;

    /*
     * Find our display structure for the event's display.
     */

    for (dispPtr = tkDisplayList; ; dispPtr = dispPtr->nextPtr) {
	if (dispPtr == NULL) {
	    return;
	}
	if (dispPtr->display == eventPtr->xany.display) {
	    break;
	}
    }







|







896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
    TkWindowEvent *wevPtr;
    TkDisplay *dispPtr;

    /*
     * Find our display structure for the event's display.
     */

    for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) {
	if (dispPtr == NULL) {
	    return;
	}
	if (dispPtr->display == eventPtr->xany.display) {
	    break;
	}
    }
953
954
955
956
957
958
959


960
961
962
963
964
965
966
967
968
969
970
971
972
WindowEventProc(evPtr, flags)
    Tcl_Event *evPtr;		/* Event to service. */
    int flags;			/* Flags that indicate what events to
				 * handle, such as TCL_WINDOW_EVENTS. */
{
    TkWindowEvent *wevPtr = (TkWindowEvent *) evPtr;
    Tk_RestrictAction result;



    if (!(flags & TCL_WINDOW_EVENTS)) {
	return 0;
    }
    if (restrictProc != NULL) {
	result = (*restrictProc)(restrictArg, &wevPtr->event);
	if (result != TK_PROCESS_EVENT) {
	    if (result == TK_DEFER_EVENT) {
		return 0;
	    } else {
		/*
		 * TK_DELETE_EVENT: return and say we processed the event,
		 * even though we didn't do anything at all.







>
>




|
|







1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
WindowEventProc(evPtr, flags)
    Tcl_Event *evPtr;		/* Event to service. */
    int flags;			/* Flags that indicate what events to
				 * handle, such as TCL_WINDOW_EVENTS. */
{
    TkWindowEvent *wevPtr = (TkWindowEvent *) evPtr;
    Tk_RestrictAction result;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (!(flags & TCL_WINDOW_EVENTS)) {
	return 0;
    }
    if (tsdPtr->restrictProc != NULL) {
	result = (*tsdPtr->restrictProc)(tsdPtr->restrictArg, &wevPtr->event);
	if (result != TK_PROCESS_EVENT) {
	    if (result == TK_DEFER_EVENT) {
		return 0;
	    } else {
		/*
		 * TK_DELETE_EVENT: return and say we processed the event,
		 * even though we didn't do anything at all.

Changes to generic/tkFileFilter.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkFileFilter.c --
 *
 *	Process the -filetypes option for the file dialogs on Windows and the
 *	Mac.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkFileFilter.c 1.6 97/04/30 15:55:35
 *
 */

#include "tkInt.h"
#include "tkFileFilter.h"

static int		AddClause _ANSI_ARGS_((
			    Tcl_Interp * interp, FileFilter * filterPtr,











|
<







1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
/*
 * tkFileFilter.c --
 *
 *	Process the -filetypes option for the file dialogs on Windows and the
 *	Mac.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkFileFilter.c,v 1.1.4.2 1998/09/30 02:16:55 stanton Exp $

 */

#include "tkInt.h"
#include "tkFileFilter.h"

static int		AddClause _ANSI_ARGS_((
			    Tcl_Interp * interp, FileFilter * filterPtr,

Changes to generic/tkFileFilter.h.

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
/*
 * tkFileFilter.h --
 *
 *	Declarations for the file filter processing routines needed by
 *	the file selection dialogs.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkFileFilter.h 1.1 96/08/27 15:05:38
 *
 */

#ifndef _TK_FILE_FILTER
#define _TK_FILE_FILTER

#ifdef MAC_TCL
#include <StandardFile.h>
#else
#define OSType long
#endif






typedef struct GlobPattern {
    struct GlobPattern * next;		/* Chains to the next glob pattern
					 * in a glob pattern list */
    char * pattern;			/* String value of the pattern, such
					 * as "*.txt" or "*.*"
					 */











|











>
>
>
>
>







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
/*
 * tkFileFilter.h --
 *
 *	Declarations for the file filter processing routines needed by
 *	the file selection dialogs.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkFileFilter.h,v 1.1.4.1 1998/09/30 02:16:56 stanton Exp $
 *
 */

#ifndef _TK_FILE_FILTER
#define _TK_FILE_FILTER

#ifdef MAC_TCL
#include <StandardFile.h>
#else
#define OSType long
#endif

#ifdef BUILD_tk
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

typedef struct GlobPattern {
    struct GlobPattern * next;		/* Chains to the next glob pattern
					 * in a glob pattern list */
    char * pattern;			/* String value of the pattern, such
					 * as "*.txt" or "*.*"
					 */
76
77
78
79
80
81
82




83
EXTERN void		TkFreeFileFilters _ANSI_ARGS_((
			    FileFilterList * flistPtr));
EXTERN void		TkInitFileFilters _ANSI_ARGS_((
			    FileFilterList * flistPtr));
EXTERN int		TkGetFileFilters _ANSI_ARGS_ ((Tcl_Interp *interp,
    			    FileFilterList * flistPtr, char * string,
			    int isWindows));




#endif







>
>
>
>

81
82
83
84
85
86
87
88
89
90
91
92
EXTERN void		TkFreeFileFilters _ANSI_ARGS_((
			    FileFilterList * flistPtr));
EXTERN void		TkInitFileFilters _ANSI_ARGS_((
			    FileFilterList * flistPtr));
EXTERN int		TkGetFileFilters _ANSI_ARGS_ ((Tcl_Interp *interp,
    			    FileFilterList * flistPtr, char * string,
			    int isWindows));

# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT

#endif

Changes to generic/tkFocus.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkFocus.c --
 *
 *	This file contains procedures that manage the input
 *	focus for Tk.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkFocus.c 1.48 97/10/31 09:55:22
 */

#include "tkInt.h"
#include "tkPort.h"


/*












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkFocus.c --
 *
 *	This file contains procedures that manage the input
 *	focus for Tk.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkFocus.c,v 1.1.4.4 1999/02/11 04:13:45 stanton Exp $
 */

#include "tkInt.h"
#include "tkPort.h"


/*
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
				 * focus notifications coming from the
				 * X server. */
    struct TkDisplayFocusInfo *nextPtr;
				/* Next in list of all display focus
				 * records for a given application. */
} DisplayFocusInfo;

/*
 * Global used for debugging.
 */

int tclFocusDebug = 0;

/*
 * The following magic value is stored in the "send_event" field of
 * FocusIn and FocusOut events that are generated in this file.  This
 * allows us to separate "real" events coming from the server from
 * those that we generated.
 */








<
<
<
<
<
<







71
72
73
74
75
76
77






78
79
80
81
82
83
84
				 * focus notifications coming from the
				 * X server. */
    struct TkDisplayFocusInfo *nextPtr;
				/* Next in list of all display focus
				 * records for a given application. */
} DisplayFocusInfo;







/*
 * The following magic value is stored in the "send_event" field of
 * FocusIn and FocusOut events that are generated in this file.  This
 * allows us to separate "real" events coming from the server from
 * those that we generated.
 */

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130


131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155

156





157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173

174
175
176
177
178



179
180
181
182
183
184
185
186


187
188
189
190
191



192
193
194
195
196
197
198
199
200
201
202
203
204
205
206


207
208
209
210
211
212
213
214
215
216
217

218

219
220
221
222
223
224
225
226

227
228
229


230
231
232
233
234
235
236
static void		GenerateFocusEvents _ANSI_ARGS_((TkWindow *sourcePtr,
			    TkWindow *destPtr));
static void		SetFocus _ANSI_ARGS_((TkWindow *winPtr, int force));

/*
 *--------------------------------------------------------------
 *
 * Tk_FocusCmd --
 *
 *	This procedure is invoked to process the "focus" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_FocusCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{


    Tk_Window tkwin = (Tk_Window) clientData;
    TkWindow *winPtr = (TkWindow *) clientData;
    TkWindow *newPtr, *focusWinPtr, *topLevelPtr;
    ToplevelFocusInfo *tlFocusPtr;
    char c;
    size_t length;

    /*
     * If invoked with no arguments, just return the current focus window.
     */

    if (argc == 1) {
	focusWinPtr = TkGetFocusWin(winPtr);
	if (focusWinPtr != NULL) {
	    interp->result = focusWinPtr->pathName;
	}
	return TCL_OK;
    }

    /*
     * If invoked with a single argument beginning with "." then focus
     * on that window.
     */

    if (argc == 2) {

	if (argv[1][0] == 0) {





	    return TCL_OK;
	}
	if (argv[1][0] == '.') {
	    newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
	    if (newPtr == NULL) {
		return TCL_ERROR;
	    }
	    if (!(newPtr->flags & TK_ALREADY_DEAD)) {
		SetFocus(newPtr, 0);
	    }
	    return TCL_OK;
	}
    }

    length = strlen(argv[1]);
    c = argv[1][1];
    if ((c == 'd') && (strncmp(argv[1], "-displayof", length) == 0)) {

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " -displayof window\"", (char *) NULL);
	    return TCL_ERROR;
	}



	newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
	if (newPtr == NULL) {
	    return TCL_ERROR;
	}
	newPtr = TkGetFocusWin(newPtr);
	if (newPtr != NULL) {
	    interp->result = newPtr->pathName;
	}


    } else if ((c == 'f') && (strncmp(argv[1], "-force", length) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " -force window\"", (char *) NULL);
	    return TCL_ERROR;



	}
	if (argv[2][0] == 0) {
	    return TCL_OK;
	}
	newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
	if (newPtr == NULL) {
	    return TCL_ERROR;
	}
	SetFocus(newPtr, 1);
    } else if ((c == 'l') && (strncmp(argv[1], "-lastfor", length) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " -lastfor window\"", (char *) NULL);
	    return TCL_ERROR;
	}


	newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
	if (newPtr == NULL) {
	    return TCL_ERROR;
	}
	for (topLevelPtr = newPtr; topLevelPtr != NULL;
		topLevelPtr = topLevelPtr->parentPtr)  {
	    if (topLevelPtr->flags & TK_TOP_LEVEL) {
		for (tlFocusPtr = newPtr->mainPtr->tlFocusPtr;
			tlFocusPtr != NULL;
			tlFocusPtr = tlFocusPtr->nextPtr) {
		    if (tlFocusPtr->topLevelPtr == topLevelPtr) {

			interp->result = tlFocusPtr->focusWinPtr->pathName;

			return TCL_OK;
		    }
		}
		interp->result = topLevelPtr->pathName;
		return TCL_OK;
	    }
	}
    } else {

	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be -displayof, -force, or -lastfor", (char *) NULL);
	return TCL_ERROR;


    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *







|














|



|
|

>
>




|
|





|


|









|
>
|
>
>
>
>
>


|
|










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

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







96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178

179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194


195
196
197
198
199
200
201
202
203
204
205
206
207
208




209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236


237
238
239
240
241
242
243
244
245
static void		GenerateFocusEvents _ANSI_ARGS_((TkWindow *sourcePtr,
			    TkWindow *destPtr));
static void		SetFocus _ANSI_ARGS_((TkWindow *winPtr, int force));

/*
 *--------------------------------------------------------------
 *
 * Tk_FocusObjCmd --
 *
 *	This procedure is invoked to process the "focus" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_FocusObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    static char *focusOptions[] = {"-displayof", "-force", "-lastfor",
				   (char *) NULL};
    Tk_Window tkwin = (Tk_Window) clientData;
    TkWindow *winPtr = (TkWindow *) clientData;
    TkWindow *newPtr, *focusWinPtr, *topLevelPtr;
    ToplevelFocusInfo *tlFocusPtr;
    char *windowName;
    int index;

    /*
     * If invoked with no arguments, just return the current focus window.
     */

    if (objc == 1) {
	focusWinPtr = TkGetFocusWin(winPtr);
	if (focusWinPtr != NULL) {
	    Tcl_SetResult(interp, focusWinPtr->pathName, TCL_STATIC);
	}
	return TCL_OK;
    }

    /*
     * If invoked with a single argument beginning with "." then focus
     * on that window.
     */

    if (objc == 2) {
	windowName = Tcl_GetStringFromObj(objv[1], (int *) NULL);

	/*
	 * The empty string case exists for backwards compatibility.
	 */
	
	if (windowName[0] == '\0') {
	    return TCL_OK;
	}
	if (windowName[0] == '.') {
	    newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
	    if (newPtr == NULL) {
		return TCL_ERROR;
	    }
	    if (!(newPtr->flags & TK_ALREADY_DEAD)) {
		SetFocus(newPtr, 0);
	    }
	    return TCL_OK;
	}
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], focusOptions, "option", 0,
	    &index) != TCL_OK) {
    	return TCL_ERROR;
    }
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "window");

	return TCL_ERROR;
    }
    switch (index) {
        case 0: {        /* -displayof */
	    windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
	    newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
	    if (newPtr == NULL) {
		return TCL_ERROR;
	    }
	    newPtr = TkGetFocusWin(newPtr);
	    if (newPtr != NULL) {
		Tcl_SetResult(interp, newPtr->pathName, TCL_STATIC);
	    }
	    break;
	}
        case 1: {        /* -force */


	    windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL);

	    /*
	     * The empty string case exists for backwards compatibility.
	     */
	
	    if (windowName[0] == '\0') {
		return TCL_OK;
	    }
	    newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
	    if (newPtr == NULL) {
		return TCL_ERROR;
	    }
	    SetFocus(newPtr, 1);




	    break;
	}
        case 2: {        /* -lastfor */
	    windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
	    newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
	    if (newPtr == NULL) {
		return TCL_ERROR;
	    }
	    for (topLevelPtr = newPtr; topLevelPtr != NULL;
		    topLevelPtr = topLevelPtr->parentPtr)  {
		if (topLevelPtr->flags & TK_TOP_LEVEL) {
		    for (tlFocusPtr = newPtr->mainPtr->tlFocusPtr;
			    tlFocusPtr != NULL;
			    tlFocusPtr = tlFocusPtr->nextPtr) {
		        if (tlFocusPtr->topLevelPtr == topLevelPtr) {
			    Tcl_SetResult(interp,
				    tlFocusPtr->focusWinPtr->pathName,
				    TCL_STATIC);
			    return TCL_OK;
			}
		    }
		    Tcl_SetResult(interp, topLevelPtr->pathName, TCL_STATIC);
		    return TCL_OK;
		}
	    }
	    break;
	}
	default: {


	    panic("bad const entries to focusOptions in focus command");
	}
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
	 * application will give us the focus explicitly if it wants us
	 * to have it.
	 */

	if (eventPtr->xcrossing.focus &&
                (displayFocusPtr->focusWinPtr == NULL)
		&& !(winPtr->flags & TK_EMBEDDED)) {
	    if (tclFocusDebug) {
		printf("Focussed implicitly on %s\n",
			newFocusPtr->pathName);
	    }

	    GenerateFocusEvents(displayFocusPtr->focusWinPtr, newFocusPtr);
	    displayFocusPtr->focusWinPtr = newFocusPtr;
	    dispPtr->implicitWinPtr = winPtr;







|







484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
	 * application will give us the focus explicitly if it wants us
	 * to have it.
	 */

	if (eventPtr->xcrossing.focus &&
                (displayFocusPtr->focusWinPtr == NULL)
		&& !(winPtr->flags & TK_EMBEDDED)) {
	    if (dispPtr->focusDebug) {
		printf("Focussed implicitly on %s\n",
			newFocusPtr->pathName);
	    }

	    GenerateFocusEvents(displayFocusPtr->focusWinPtr, newFocusPtr);
	    displayFocusPtr->focusWinPtr = newFocusPtr;
	    dispPtr->implicitWinPtr = winPtr;
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
	 * dispPtr->implicitWinPtr)!!  In addition, we generate events
	 * because the window manager won't give us a FocusOut event when
	 * we focus on the root. 
	 */

	if ((dispPtr->implicitWinPtr != NULL)
		&& !(winPtr->flags & TK_EMBEDDED)) {
	    if (tclFocusDebug) {
		printf("Defocussed implicit Async\n");
	    }
	    GenerateFocusEvents(displayFocusPtr->focusWinPtr,
		    (TkWindow *) NULL);
	    XSetInputFocus(dispPtr->display, PointerRoot, RevertToPointerRoot,
		    CurrentTime);
	    displayFocusPtr->focusWinPtr = NULL;







|







509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
	 * dispPtr->implicitWinPtr)!!  In addition, we generate events
	 * because the window manager won't give us a FocusOut event when
	 * we focus on the root. 
	 */

	if ((dispPtr->implicitWinPtr != NULL)
		&& !(winPtr->flags & TK_EMBEDDED)) {
	    if (dispPtr->focusDebug) {
		printf("Defocussed implicit Async\n");
	    }
	    GenerateFocusEvents(displayFocusPtr->focusWinPtr,
		    (TkWindow *) NULL);
	    XSetInputFocus(dispPtr->display, PointerRoot, RevertToPointerRoot,
		    CurrentTime);
	    displayFocusPtr->focusWinPtr = NULL;
546
547
548
549
550
551
552







553
554
555
556
557
558
559
560
{
    ToplevelFocusInfo *tlFocusPtr;
    DisplayFocusInfo *displayFocusPtr;
    TkWindow *topLevelPtr;
    int allMapped, serial;

    displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);







    if (winPtr == displayFocusPtr->focusWinPtr) {
	return;
    }

    /*
     * Find the top-level window for winPtr, then find (or create)
     * a record for the top-level.  Also see whether winPtr and all its
     * ancestors are mapped.







>
>
>
>
>
>
>
|







555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
{
    ToplevelFocusInfo *tlFocusPtr;
    DisplayFocusInfo *displayFocusPtr;
    TkWindow *topLevelPtr;
    int allMapped, serial;

    displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);

    /*
     * If force is set, we should make sure we grab the focus regardless
     * of the current focus window since under Windows, we may need to
     * take control away from another application.
     */

    if (winPtr == displayFocusPtr->focusWinPtr && !force) {
	return;
    }

    /*
     * Find the top-level window for winPtr, then find (or create)
     * a record for the top-level.  Also see whether winPtr and all its
     * ancestors are mapped.
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
	    /*
	     * The top-level window is the one being deleted: free
	     * the focus record and release the focus back to PointerRoot
	     * if we acquired it implicitly.
	     */

	    if (dispPtr->implicitWinPtr == winPtr) {
		if (tclFocusDebug) {
		    printf("releasing focus to root after %s died\n",
			    tlFocusPtr->topLevelPtr->pathName);
		}
		dispPtr->implicitWinPtr = NULL;
		displayFocusPtr->focusWinPtr = NULL;
		dispPtr->focusPtr = NULL;
	    }







|







825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
	    /*
	     * The top-level window is the one being deleted: free
	     * the focus record and release the focus back to PointerRoot
	     * if we acquired it implicitly.
	     */

	    if (dispPtr->implicitWinPtr == winPtr) {
		if (dispPtr->focusDebug) {
		    printf("releasing focus to root after %s died\n",
			    tlFocusPtr->topLevelPtr->pathName);
		}
		dispPtr->implicitWinPtr = NULL;
		displayFocusPtr->focusWinPtr = NULL;
		dispPtr->focusPtr = NULL;
	    }
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
	     * The deleted window had the focus for its top-level:
	     * move the focus to the top-level itself.
	     */

	    tlFocusPtr->focusWinPtr = tlFocusPtr->topLevelPtr;
	    if ((displayFocusPtr->focusWinPtr == winPtr)
		    && !(tlFocusPtr->topLevelPtr->flags & TK_ALREADY_DEAD)) {
		if (tclFocusDebug) {
		    printf("forwarding focus to %s after %s died\n",
			    tlFocusPtr->topLevelPtr->pathName,
			    winPtr->pathName);
		}
		GenerateFocusEvents(displayFocusPtr->focusWinPtr,
			tlFocusPtr->topLevelPtr);
		displayFocusPtr->focusWinPtr = tlFocusPtr->topLevelPtr;







|







853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
	     * The deleted window had the focus for its top-level:
	     * move the focus to the top-level itself.
	     */

	    tlFocusPtr->focusWinPtr = tlFocusPtr->topLevelPtr;
	    if ((displayFocusPtr->focusWinPtr == winPtr)
		    && !(tlFocusPtr->topLevelPtr->flags & TK_ALREADY_DEAD)) {
		if (dispPtr->focusDebug) {
		    printf("forwarding focus to %s after %s died\n",
			    tlFocusPtr->topLevelPtr->pathName,
			    winPtr->pathName);
		}
		GenerateFocusEvents(displayFocusPtr->focusWinPtr,
			tlFocusPtr->topLevelPtr);
		displayFocusPtr->focusWinPtr = tlFocusPtr->topLevelPtr;
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
{
    TkWindow *winPtr = (TkWindow *) clientData;
    DisplayFocusInfo *displayFocusPtr;

    if (eventPtr->type == VisibilityNotify) {
	displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr,
		winPtr->dispPtr);
	if (tclFocusDebug) {
	    printf("auto-focussing on %s, force %d\n", winPtr->pathName,
		    displayFocusPtr->forceFocus);
	}
	Tk_DeleteEventHandler((Tk_Window) winPtr, VisibilityChangeMask,
		FocusMapProc, clientData);
	displayFocusPtr->focusOnMapPtr = NULL;
	SetFocus(winPtr, displayFocusPtr->forceFocus);







|







948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
{
    TkWindow *winPtr = (TkWindow *) clientData;
    DisplayFocusInfo *displayFocusPtr;

    if (eventPtr->type == VisibilityNotify) {
	displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr,
		winPtr->dispPtr);
	if (winPtr->dispPtr->focusDebug) {
	    printf("auto-focussing on %s, force %d\n", winPtr->pathName,
		    displayFocusPtr->forceFocus);
	}
	Tk_DeleteEventHandler((Tk_Window) winPtr, VisibilityChangeMask,
		FocusMapProc, clientData);
	displayFocusPtr->focusOnMapPtr = NULL;
	SetFocus(winPtr, displayFocusPtr->forceFocus);

Changes to generic/tkFont.c.

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
/* 
 * tkFont.c --
 *
 *	This file maintains a database of fonts for the Tk toolkit.
 *	It also provides several utility procedures for measuring and
 *	displaying text.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkFont.c 1.74 97/10/10 14:34:11
 */


#include "tkInt.h"
#include "tkFont.h"

/*
 * The following structure is used to keep track of all the fonts that
 * exist in the current application.  It must be stored in the
 * TkMainInfo for the application.
 */
 
typedef struct TkFontInfo {
    Tcl_HashTable fontCache;	/* Map a string to an existing Tk_Font.
				 * Keys are CachedFontKey structs, values are
				 * TkFont structs. */
    Tcl_HashTable namedTable;	/* Map a name to a set of attributes for a
				 * font, used when constructing a Tk_Font from
				 * a named font description.  Keys are
				 * Tk_Uids, values are NamedFont structs. */
    TkMainInfo *mainPtr;	/* Application that owns this structure. */
    int updatePending;		


} TkFontInfo;

/*
 * The following structure is used as a key in the fontCache.
 */

typedef struct CachedFontKey {
    Display *display;		/* Display for which font was constructed. */
    Tk_Uid string;		/* String that describes font. */
} CachedFontKey;

/*
 * The following data structure is used to keep track of the font attributes
 * for each named font that has been defined.  The named font is only deleted
 * when the last reference to it goes away.
 */

typedef struct NamedFont {








|




|


>











|
|



|

|
>
>


<
<
<
<
<
<
<
<
<







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
/* 
 * tkFont.c --
 *
 *	This file maintains a database of fonts for the Tk toolkit.
 *	It also provides several utility procedures for measuring and
 *	displaying text.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkFont.c,v 1.1.4.6 1999/03/30 04:12:56 stanton Exp $
 */

#include "tkPort.h"
#include "tkInt.h"
#include "tkFont.h"

/*
 * The following structure is used to keep track of all the fonts that
 * exist in the current application.  It must be stored in the
 * TkMainInfo for the application.
 */
 
typedef struct TkFontInfo {
    Tcl_HashTable fontCache;	/* Map a string to an existing Tk_Font.
				 * Keys are string font names, values are
				 * TkFont pointers. */
    Tcl_HashTable namedTable;	/* Map a name to a set of attributes for a
				 * font, used when constructing a Tk_Font from
				 * a named font description.  Keys are
				 * strings, values are NamedFont pointers. */
    TkMainInfo *mainPtr;	/* Application that owns this structure. */
    int updatePending;		/* Non-zero when a World Changed event has
				 * already been queued to handle a change to
				 * a named font. */
} TkFontInfo;










/*
 * The following data structure is used to keep track of the font attributes
 * for each named font that has been defined.  The named font is only deleted
 * when the last reference to it goes away.
 */

typedef struct NamedFont {
73
74
75
76
77
78
79

80
81
82
83
84
85
86
 * opaque token.
 */

typedef struct LayoutChunk {
    CONST char *start;		/* Pointer to simple string to be displayed.
				 * This is a pointer into the TkTextLayout's
				 * string. */

    int numChars;		/* The number of characters in this chunk. */
    int numDisplayChars;	/* The number of characters to display when
				 * this chunk is displayed.  Can be less than
				 * numChars if extra space characters were
				 * absorbed by the end of the chunk.  This
				 * will be < 0 if this is a chunk that is
				 * holding a tab or newline. */







>







67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
 * opaque token.
 */

typedef struct LayoutChunk {
    CONST char *start;		/* Pointer to simple string to be displayed.
				 * This is a pointer into the TkTextLayout's
				 * string. */
    int numBytes;		/* The number of bytes in this chunk. */
    int numChars;		/* The number of characters in this chunk. */
    int numDisplayChars;	/* The number of characters to display when
				 * this chunk is displayed.  Can be less than
				 * numChars if extra space characters were
				 * absorbed by the end of the chunk.  This
				 * will be < 0 if this is a chunk that is
				 * holding a tab or newline. */
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
    {TK_SW_NORMAL,	"normal"},
    {TK_SW_CONDENSE,	"narrow"},
    {TK_SW_CONDENSE,	"semicondensed"},
    {TK_SW_CONDENSE,	"condensed"},
    {TK_SW_UNKNOWN,	NULL}
};

static TkStateMap xlfdCharsetMap[] = {
    {TK_CS_NORMAL,	"iso8859"},
    {TK_CS_SYMBOL,	"adobe"},
    {TK_CS_SYMBOL,	"sun"},
    {TK_CS_OTHER,	NULL}
};
    
/*
 * The following structure and defines specify the valid builtin options 
 * when configuring a set of font attributes.
 */

static char *fontOpt[] = {
    "-family",







<
<
<
<
<
<
<







159
160
161
162
163
164
165







166
167
168
169
170
171
172
    {TK_SW_NORMAL,	"normal"},
    {TK_SW_CONDENSE,	"narrow"},
    {TK_SW_CONDENSE,	"semicondensed"},
    {TK_SW_CONDENSE,	"condensed"},
    {TK_SW_UNKNOWN,	NULL}
};








/*
 * The following structure and defines specify the valid builtin options 
 * when configuring a set of font attributes.
 */

static char *fontOpt[] = {
    "-family",
192
193
194
195
196
197
198
199
































































































































200
201
202
203
204
205
206
207
208
209
210





211

212
213
214
215
216
217
218
219
220


221
222
223
224
225






226







227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258


259
260
261
262
263
264
265

#define FONT_FAMILY	0
#define FONT_SIZE	1
#define FONT_WEIGHT	2
#define FONT_SLANT	3
#define FONT_UNDERLINE	4
#define FONT_OVERSTRIKE	5
#define FONT_NUMFIELDS	6	    /* Length of fontOpt array. */

































































































































#define GetFontAttributes(tkfont) \
		((CONST TkFontAttributes *) &((TkFont *) (tkfont))->fa)

#define GetFontMetrics(tkfont)    \
		((CONST TkFontMetrics *) &((TkFont *) (tkfont))->fm)


static int		ConfigAttributesObj _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, int objc, Tcl_Obj *CONST objv[],
			    TkFontAttributes *faPtr));





static int		FieldSpecified _ANSI_ARGS_((CONST char *field));

static int		GetAttributeInfoObj _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST TkFontAttributes *faPtr, Tcl_Obj *objPtr));
static LayoutChunk *	NewChunk _ANSI_ARGS_((TextLayout **layoutPtrPtr,
			    int *maxPtr, CONST char *start, int numChars,
			    int curX, int newX, int y));
static int		ParseFontNameObj _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Tcl_Obj *objPtr,
			    TkFontAttributes *faPtr));
static void		RecomputeWidgets _ANSI_ARGS_((TkWindow *winPtr));


static void		TheWorldHasChanged _ANSI_ARGS_((
			    ClientData clientData));
static void		UpdateDependantFonts _ANSI_ARGS_((TkFontInfo *fiPtr,
			    Tk_Window tkwin, Tcl_HashEntry *namedHashPtr));







			









/*
 *---------------------------------------------------------------------------
 *
 * TkFontPkgInit --
 *
 *	This procedure is called when an application is created.  It
 *	initializes all the structures that are used by the font
 *	package on a per application basis.
 *
 * Results:
 *	Returns a token that must be stored in the TkMainInfo for this
 *	application.
 *
 * Side effects:
 *	Memory allocated.
 *
 *---------------------------------------------------------------------------
 */
void
TkFontPkgInit(mainPtr)
    TkMainInfo *mainPtr;	/* The application being created. */
{
    TkFontInfo *fiPtr;

    fiPtr = (TkFontInfo *) ckalloc(sizeof(TkFontInfo));
    Tcl_InitHashTable(&fiPtr->fontCache, sizeof(CachedFontKey) / sizeof(int));
    Tcl_InitHashTable(&fiPtr->namedTable, TCL_ONE_WORD_KEYS);
    fiPtr->mainPtr = mainPtr;
    fiPtr->updatePending = 0;
    mainPtr->fontInfoPtr = fiPtr;


}

/*
 *---------------------------------------------------------------------------
 *
 * TkFontPkgFree --
 *







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











>
>
>
>
>

>









>
>


|


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












|
|













|
|



>
>







180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404

#define FONT_FAMILY	0
#define FONT_SIZE	1
#define FONT_WEIGHT	2
#define FONT_SLANT	3
#define FONT_UNDERLINE	4
#define FONT_OVERSTRIKE	5
#define FONT_NUMFIELDS	6

/*
 * Hardcoded font aliases.  These are used to describe (mostly) identical
 * fonts whose names differ from platform to platform.  If the
 * user-supplied font name matches any of the names in one of the alias
 * lists, the other names in the alias list are also automatically tried.
 */

static char *timesAliases[] = {
    "Times",			/* Unix. */
    "Times New Roman",		/* Windows. */
    "New York",			/* Mac. */
    NULL
};

static char *helveticaAliases[] = {
    "Helvetica",		/* Unix. */
    "Arial",			/* Windows. */
    "Geneva",			/* Mac. */
    NULL
};

static char *courierAliases[] = {
    "Courier",			/* Unix and Mac. */
    "Courier New",		/* Windows. */
    NULL
};

static char *minchoAliases[] = {
    "mincho",			/* Unix. */
    "\357\274\255\357\274\263 \346\230\216\346\234\235",
				/* Windows (MS mincho). */
    "\346\234\254\346\230\216\346\234\235\342\210\222\357\274\255",
				/* Mac (honmincho-M). */
    NULL
};

static char *gothicAliases[] = {
    "gothic",			/* Unix. */
    "\357\274\255\357\274\263 \343\202\264\343\202\267\343\203\203\343\202\257",
				/* Windows (MS goshikku). */
    "\344\270\270\343\202\264\343\202\267\343\203\203\343\202\257\342\210\222\357\274\255",
				/* Mac (goshikku-M). */
    NULL    
};

static char *dingbatsAliases[] = {
    "dingbats", "zapfdingbats", "itc zapfdingbats",
				/* Unix. */
				/* Windows. */
    "zapf dingbats",		/* Mac. */
    NULL
};

static char **fontAliases[] = {
    timesAliases,
    helveticaAliases,
    courierAliases,
    minchoAliases,
    gothicAliases,
    dingbatsAliases,
    NULL
};  

/*
 * Hardcoded font classes.  If the character cannot be found in the base 
 * font, the classes are examined in order to see if some other similar 
 * font should be examined also.  
 */

static char *systemClass[] = {
    "fixed",				/* Unix. */
					/* Windows. */
    "chicago", "osaka", "sistemny",	/* Mac. */
    NULL
};

static char *serifClass[] = {
    "times", "palatino", "mincho",	/* All platforms. */
    "song ti",				/* Unix. */
    "ms serif", "simplified arabic", 	/* Windows. */
    "latinski",				/* Mac. */
    NULL
};

static char *sansClass[] = {
    "helvetica", "gothic",		/* All platforms. */
					/* Unix. */
    "ms sans serif", "traditional arabic",
					/* Windows. */
    "bastion",				/* Mac. */
    NULL
};

static char *monoClass[] = {
    "courier", "gothic",		/* All platforms. */
    "fangsong ti",			/* Unix. */
    "simplified arabic fixed",		/* Windows. */
    "monaco", "pryamoy",		/* Mac. */
    NULL
};

static char *symbolClass[] = {
    "symbol", "dingbats", "wingdings", NULL
};

static char **fontFallbacks[] = {
    systemClass,
    serifClass,
    sansClass,
    monoClass,
    symbolClass,
    NULL
};

/*
 * Global fallbacks.  If the character could not be found in the preferred
 * fallback list, this list is examined.  If the character still cannot be
 * found, all font families in the system are examined. 
 */

static char *globalFontClass[] = {
    "symbol",			/* All platforms. */
				/* Unix. */
    "lucida sans unicode",	/* Windows. */
    "chicago",			/* Mac. */
    NULL
};

#define GetFontAttributes(tkfont) \
		((CONST TkFontAttributes *) &((TkFont *) (tkfont))->fa)

#define GetFontMetrics(tkfont)    \
		((CONST TkFontMetrics *) &((TkFont *) (tkfont))->fm)


static int		ConfigAttributesObj _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, int objc, Tcl_Obj *CONST objv[],
			    TkFontAttributes *faPtr));
static int		CreateNamedFont _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, CONST char *name,
			    TkFontAttributes *faPtr));
static void		DupFontObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
			    Tcl_Obj *dupObjPtr));
static int		FieldSpecified _ANSI_ARGS_((CONST char *field));
static void		FreeFontObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
static int		GetAttributeInfoObj _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST TkFontAttributes *faPtr, Tcl_Obj *objPtr));
static LayoutChunk *	NewChunk _ANSI_ARGS_((TextLayout **layoutPtrPtr,
			    int *maxPtr, CONST char *start, int numChars,
			    int curX, int newX, int y));
static int		ParseFontNameObj _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Tcl_Obj *objPtr,
			    TkFontAttributes *faPtr));
static void		RecomputeWidgets _ANSI_ARGS_((TkWindow *winPtr));
static int		SetFontFromAny _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr));
static void		TheWorldHasChanged _ANSI_ARGS_((
			    ClientData clientData));
static void		UpdateDependentFonts _ANSI_ARGS_((TkFontInfo *fiPtr,
			    Tk_Window tkwin, Tcl_HashEntry *namedHashPtr));

/*
 * The following structure defines the implementation of the "font" Tcl
 * object, used for drawing. The internalRep.twoPtrValue.ptr1 field of
 * each font object points to the TkFont structure for the font, or
 * NULL.
 */

static Tcl_ObjType fontObjType = {
    "font",			/* name */
    FreeFontObjProc,		/* freeIntRepProc */
    DupFontObjProc,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetFontFromAny		/* setFromAnyProc */
};


/*
 *---------------------------------------------------------------------------
 *
 * TkFontPkgInit --
 *
 *	This procedure is called when an application is created.  It
 *	initializes all the structures that are used by the font
 *	package on a per application basis.
 *
 * Results:
 *	Stores a token in the mainPtr to hold information needed by this 
 *	package on a per application basis. 
 *
 * Side effects:
 *	Memory allocated.
 *
 *---------------------------------------------------------------------------
 */
void
TkFontPkgInit(mainPtr)
    TkMainInfo *mainPtr;	/* The application being created. */
{
    TkFontInfo *fiPtr;

    fiPtr = (TkFontInfo *) ckalloc(sizeof(TkFontInfo));
    Tcl_InitHashTable(&fiPtr->fontCache, TCL_STRING_KEYS);
    Tcl_InitHashTable(&fiPtr->namedTable, TCL_STRING_KEYS);
    fiPtr->mainPtr = mainPtr;
    fiPtr->updatePending = 0;
    mainPtr->fontInfoPtr = fiPtr;

    TkpFontPkgInit(mainPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkFontPkgFree --
 *
277
278
279
280
281
282
283
284
285

286
287
288






289


290
291
292
293
294
295
296
 */

void
TkFontPkgFree(mainPtr)
    TkMainInfo *mainPtr;	/* The application being deleted. */
{
    TkFontInfo *fiPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;


    fiPtr = mainPtr->fontInfoPtr;







    if (fiPtr->fontCache.numEntries != 0) {


	panic("TkFontPkgFree: all fonts should have been freed already");
    }
    Tcl_DeleteHashTable(&fiPtr->fontCache);

    hPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
    while (hPtr != NULL) {
	ckfree((char *) Tcl_GetHashValue(hPtr));







|

>



>
>
>
>
>
>
|
>
>







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
 */

void
TkFontPkgFree(mainPtr)
    TkMainInfo *mainPtr;	/* The application being deleted. */
{
    TkFontInfo *fiPtr;
    Tcl_HashEntry *hPtr, *searchPtr;
    Tcl_HashSearch search;
    int fontsLeft;

    fiPtr = mainPtr->fontInfoPtr;

    fontsLeft = 0;
    for (searchPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
	    searchPtr != NULL;
	    searchPtr = Tcl_NextHashEntry(&search)) {
	fontsLeft++;
	fprintf(stderr, "Font %s still in cache.\n", 
		Tcl_GetHashKey(&fiPtr->fontCache, searchPtr));
    }
    if (fontsLeft) {
	panic("TkFontPkgFree: all fonts should have been freed already");
    }
    Tcl_DeleteHashTable(&fiPtr->fontCache);

    hPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
    while (hPtr != NULL) {
	ckfree((char *) Tcl_GetHashValue(hPtr));
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
		return TCL_ERROR;
	    }
	    if ((objc < 3) || (objc - skip > 4)) {
		Tcl_WrongNumArgs(interp, 2, objv,
			"font ?-displayof window? ?option?");
		return TCL_ERROR;
	    }
	    tkfont = Tk_GetFontFromObj(interp, tkwin, objv[2]);
	    if (tkfont == NULL) {
		return TCL_ERROR;
	    }
	    objc -= skip;
	    objv += skip;
	    faPtr = GetFontAttributes(tkfont);
	    objPtr = NULL;







|







512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
		return TCL_ERROR;
	    }
	    if ((objc < 3) || (objc - skip > 4)) {
		Tcl_WrongNumArgs(interp, 2, objv,
			"font ?-displayof window? ?option?");
		return TCL_ERROR;
	    }
	    tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
	    if (tkfont == NULL) {
		return TCL_ERROR;
	    }
	    objc -= skip;
	    objv += skip;
	    faPtr = GetFontAttributes(tkfont);
	    objPtr = NULL;
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
	    NamedFont *nfPtr;
	    Tcl_HashEntry *namedHashPtr;

	    if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "fontname ?options?");
		return TCL_ERROR;
	    }
	    string = Tk_GetUid(Tcl_GetStringFromObj(objv[2], NULL));
	    namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
	    nfPtr = NULL;		/* lint. */
	    if (namedHashPtr != NULL) {
		nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
	    }
	    if ((namedHashPtr == NULL) || (nfPtr->deletePending != 0)) {
		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "named font \"", string,
			"\" doesn't exist", NULL);
		return TCL_ERROR;
	    }
	    if (objc == 3) {
		objPtr = NULL;
	    } else if (objc == 4) {
		objPtr = objv[3];
	    } else {
		result = ConfigAttributesObj(interp, tkwin, objc - 3,
			objv + 3, &nfPtr->fa);
		UpdateDependantFonts(fiPtr, tkwin, namedHashPtr);
		return result;
	    }
	    return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr);
	}
	case FONT_CREATE: {
	    int skip, i;
	    char *name;
	    char buf[32];
	    TkFontAttributes fa;
	    Tcl_HashEntry *namedHashPtr;

	    skip = 3;
	    if (objc < 3) {
		name = NULL;
	    } else {
		name = Tcl_GetStringFromObj(objv[2], NULL);
		if (name[0] == '-') {
		    name = NULL;
		}
	    }
	    if (name == NULL) {
		/*
		 * No font name specified.  Generate one of the form "fontX".
		 */

		for (i = 1; ; i++) {
		    sprintf(buf, "font%d", i);
		    namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable,
			    Tk_GetUid(buf));
		    if (namedHashPtr == NULL) {
			break;
		    }
		}
		name = buf;
		skip = 2;
	    }
	    TkInitFontAttributes(&fa);
	    if (ConfigAttributesObj(interp, tkwin, objc - skip, objv + skip,
		    &fa) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (TkCreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_SetStringObj(Tcl_GetObjResult(interp), name, -1);
	    break;
	}
	case FONT_DELETE: {
	    int i;
	    char *string;
	    NamedFont *nfPtr;
	    Tcl_HashEntry *namedHashPtr;

	    /*
	     * Delete the named font.  If there are still widgets using this
	     * font, then it isn't deleted right away.
	     */

	    if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "fontname ?fontname ...?");
		return TCL_ERROR;
	    }
	    for (i = 2; i < objc; i++) {
		string = Tk_GetUid(Tcl_GetStringFromObj(objv[i], NULL));
		namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
		if (namedHashPtr == NULL) {
		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "named font \"", string,
			    "\" doesn't exist", (char *) NULL);
		    return TCL_ERROR;
		}
		nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
		if (nfPtr->refCount != 0) {
		    nfPtr->deletePending = 1;
		} else {







|






|










|







|







|











|
<












|


|


















|


|







538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591

592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
	    NamedFont *nfPtr;
	    Tcl_HashEntry *namedHashPtr;

	    if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "fontname ?options?");
		return TCL_ERROR;
	    }
	    string = Tcl_GetString(objv[2]);
	    namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
	    nfPtr = NULL;		/* lint. */
	    if (namedHashPtr != NULL) {
		nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
	    }
	    if ((namedHashPtr == NULL) || (nfPtr->deletePending != 0)) {
		Tcl_AppendResult(interp, "named font \"", string,
			"\" doesn't exist", NULL);
		return TCL_ERROR;
	    }
	    if (objc == 3) {
		objPtr = NULL;
	    } else if (objc == 4) {
		objPtr = objv[3];
	    } else {
		result = ConfigAttributesObj(interp, tkwin, objc - 3,
			objv + 3, &nfPtr->fa);
		UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
		return result;
	    }
	    return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr);
	}
	case FONT_CREATE: {
	    int skip, i;
	    char *name;
	    char buf[16 + TCL_INTEGER_SPACE];
	    TkFontAttributes fa;
	    Tcl_HashEntry *namedHashPtr;

	    skip = 3;
	    if (objc < 3) {
		name = NULL;
	    } else {
		name = Tcl_GetString(objv[2]);
		if (name[0] == '-') {
		    name = NULL;
		}
	    }
	    if (name == NULL) {
		/*
		 * No font name specified.  Generate one of the form "fontX".
		 */

		for (i = 1; ; i++) {
		    sprintf(buf, "font%d", i);
		    namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, buf);

		    if (namedHashPtr == NULL) {
			break;
		    }
		}
		name = buf;
		skip = 2;
	    }
	    TkInitFontAttributes(&fa);
	    if (ConfigAttributesObj(interp, tkwin, objc - skip, objv + skip,
		    &fa) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (CreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_AppendResult(interp, name, NULL);
	    break;
	}
	case FONT_DELETE: {
	    int i;
	    char *string;
	    NamedFont *nfPtr;
	    Tcl_HashEntry *namedHashPtr;

	    /*
	     * Delete the named font.  If there are still widgets using this
	     * font, then it isn't deleted right away.
	     */

	    if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "fontname ?fontname ...?");
		return TCL_ERROR;
	    }
	    for (i = 2; i < objc; i++) {
		string = Tcl_GetString(objv[i]);
		namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
		if (namedHashPtr == NULL) {
		    Tcl_AppendResult(interp, "named font \"", string,
			    "\" doesn't exist", (char *) NULL);
		    return TCL_ERROR;
		}
		nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
		if (nfPtr->refCount != 0) {
		    nfPtr->deletePending = 1;
		} else {
507
508
509
510
511
512
513

514
515
516
517
518
519
520
521
522
523
524
525
526
527
528

529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558


559
560
561
562
563
564
565
566
567
568
569
570
	    TkpGetFontFamilies(interp, tkwin);
	    break;
	}
	case FONT_MEASURE: {
	    char *string;
	    Tk_Font tkfont;
	    int length, skip;

	    
	    skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
	    if (skip < 0) {
		return TCL_ERROR;
	    }
	    if (objc - skip != 4) {
		Tcl_WrongNumArgs(interp, 2, objv,
			"font ?-displayof window? text");
		return TCL_ERROR;
	    }
	    tkfont = Tk_GetFontFromObj(interp, tkwin, objv[2]);
	    if (tkfont == NULL) {
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[3 + skip], &length);

	    Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_TextWidth(tkfont, string, length));
	    Tk_FreeFont(tkfont);
	    break;
	}
	case FONT_METRICS: {
	    char buf[64];
	    Tk_Font tkfont;
	    int skip, index, i;
	    CONST TkFontMetrics *fmPtr;
	    static char *switches[] = {
		"-ascent", "-descent", "-linespace", "-fixed", NULL
	    };

	    skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
	    if (skip < 0) {
		return TCL_ERROR;
	    }
	    if ((objc < 3) || ((objc - skip) > 4)) {
		Tcl_WrongNumArgs(interp, 2, objv,
			"font ?-displayof window? ?option?");
		return TCL_ERROR;
	    }
	    tkfont = Tk_GetFontFromObj(interp, tkwin, objv[2]);
	    if (tkfont == NULL) {
		return TCL_ERROR;
	    }
	    objc -= skip;
	    objv += skip;
	    fmPtr = GetFontMetrics(tkfont);
	    if (objc == 3) {


		sprintf(buf, "-ascent %d -descent %d -linespace %d -fixed %d",
			fmPtr->ascent, fmPtr->descent,
			fmPtr->ascent + fmPtr->descent,
			fmPtr->fixed);
		Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
	    } else {
		if (Tcl_GetIndexFromObj(interp, objv[3], switches,
			"metric", 0, &index) != TCL_OK) {
		    Tk_FreeFont(tkfont);
		    return TCL_ERROR;
		}
		i = 0;			/* Needed only to prevent compiler







>










|




>
|




<
















|







>
>




|







654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682

683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
	    TkpGetFontFamilies(interp, tkwin);
	    break;
	}
	case FONT_MEASURE: {
	    char *string;
	    Tk_Font tkfont;
	    int length, skip;
	    Tcl_Obj *resultPtr;
	    
	    skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
	    if (skip < 0) {
		return TCL_ERROR;
	    }
	    if (objc - skip != 4) {
		Tcl_WrongNumArgs(interp, 2, objv,
			"font ?-displayof window? text");
		return TCL_ERROR;
	    }
	    tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
	    if (tkfont == NULL) {
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[3 + skip], &length);
	    resultPtr = Tcl_GetObjResult(interp);
	    Tcl_SetIntObj(resultPtr, Tk_TextWidth(tkfont, string, length));
	    Tk_FreeFont(tkfont);
	    break;
	}
	case FONT_METRICS: {

	    Tk_Font tkfont;
	    int skip, index, i;
	    CONST TkFontMetrics *fmPtr;
	    static char *switches[] = {
		"-ascent", "-descent", "-linespace", "-fixed", NULL
	    };

	    skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
	    if (skip < 0) {
		return TCL_ERROR;
	    }
	    if ((objc < 3) || ((objc - skip) > 4)) {
		Tcl_WrongNumArgs(interp, 2, objv,
			"font ?-displayof window? ?option?");
		return TCL_ERROR;
	    }
	    tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
	    if (tkfont == NULL) {
		return TCL_ERROR;
	    }
	    objc -= skip;
	    objv += skip;
	    fmPtr = GetFontMetrics(tkfont);
	    if (objc == 3) {
		char buf[64 + TCL_INTEGER_SPACE * 4];

		sprintf(buf, "-ascent %d -descent %d -linespace %d -fixed %d",
			fmPtr->ascent, fmPtr->descent,
			fmPtr->ascent + fmPtr->descent,
			fmPtr->fixed);
		Tcl_AppendResult(interp, buf, NULL);
	    } else {
		if (Tcl_GetIndexFromObj(interp, objv[3], switches,
			"metric", 0, &index) != TCL_OK) {
		    Tk_FreeFont(tkfont);
		    return TCL_ERROR;
		}
		i = 0;			/* Needed only to prevent compiler
578
579
580
581
582
583
584
585
586
587
588

589
590
591
592
593

594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653

654
655
656
657
658

659
660
661
662
663
664
665
		Tcl_SetIntObj(Tcl_GetObjResult(interp), i);
	    }
	    Tk_FreeFont(tkfont);
	    break;
	}
	case FONT_NAMES: {
	    char *string;
	    Tcl_Obj *strPtr;
	    NamedFont *nfPtr;
	    Tcl_HashSearch search;
	    Tcl_HashEntry *namedHashPtr;

	    
	    if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "names");
		return TCL_ERROR;
	    }

	    namedHashPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
	    while (namedHashPtr != NULL) {
		nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
		if (nfPtr->deletePending == 0) {
		    string = Tcl_GetHashKey(&fiPtr->namedTable, namedHashPtr);
		    strPtr = Tcl_NewStringObj(string, -1);
		    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), strPtr);
		}
		namedHashPtr = Tcl_NextHashEntry(&search);
	    }
	    break;
	}
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * UpdateDependantFonts, TheWorldHasChanged, RecomputeWidgets --
 *
 *	Called when the attributes of a named font changes.  Updates all
 *	the instantiated fonts that depend on that named font and then
 *	uses the brute force approach and prepares every widget to
 *	recompute its geometry.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Things get queued for redisplay.
 *
 *---------------------------------------------------------------------------
 */

static void
UpdateDependantFonts(fiPtr, tkwin, namedHashPtr)
    TkFontInfo *fiPtr;		/* Info about application's fonts. */
    Tk_Window tkwin;		/* A window in the application. */
    Tcl_HashEntry *namedHashPtr;/* The named font that is changing. */
{
    Tcl_HashEntry *cacheHashPtr;
    Tcl_HashSearch search;
    TkFont *fontPtr;
    NamedFont *nfPtr;

    nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
    if (nfPtr->refCount == 0) {
	/*
	 * Well nobody's using this named font, so don't have to tell
	 * any widgets to recompute themselves.
	 */

	return;
    }


    cacheHashPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
    while (cacheHashPtr != NULL) {
	fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);

	if (fontPtr->namedHashPtr == namedHashPtr) {
	    TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa);
	    if (fiPtr->updatePending == 0) {
		fiPtr->updatePending = 1;
		Tcl_DoWhenIdle(TheWorldHasChanged, (ClientData) fiPtr);

	    }
	}
	cacheHashPtr = Tcl_NextHashEntry(&search);
    }
}

static void







<



>





>






|












|
















|



















<


|
>
|
|
|
|
|
>







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
		Tcl_SetIntObj(Tcl_GetObjResult(interp), i);
	    }
	    Tk_FreeFont(tkfont);
	    break;
	}
	case FONT_NAMES: {
	    char *string;

	    NamedFont *nfPtr;
	    Tcl_HashSearch search;
	    Tcl_HashEntry *namedHashPtr;
	    Tcl_Obj *strPtr, *resultPtr;
	    
	    if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "names");
		return TCL_ERROR;
	    }
	    resultPtr = Tcl_GetObjResult(interp);
	    namedHashPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
	    while (namedHashPtr != NULL) {
		nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
		if (nfPtr->deletePending == 0) {
		    string = Tcl_GetHashKey(&fiPtr->namedTable, namedHashPtr);
		    strPtr = Tcl_NewStringObj(string, -1);
		    Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
		}
		namedHashPtr = Tcl_NextHashEntry(&search);
	    }
	    break;
	}
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * UpdateDependentFonts, TheWorldHasChanged, RecomputeWidgets --
 *
 *	Called when the attributes of a named font changes.  Updates all
 *	the instantiated fonts that depend on that named font and then
 *	uses the brute force approach and prepares every widget to
 *	recompute its geometry.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Things get queued for redisplay.
 *
 *---------------------------------------------------------------------------
 */

static void
UpdateDependentFonts(fiPtr, tkwin, namedHashPtr)
    TkFontInfo *fiPtr;		/* Info about application's fonts. */
    Tk_Window tkwin;		/* A window in the application. */
    Tcl_HashEntry *namedHashPtr;/* The named font that is changing. */
{
    Tcl_HashEntry *cacheHashPtr;
    Tcl_HashSearch search;
    TkFont *fontPtr;
    NamedFont *nfPtr;

    nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
    if (nfPtr->refCount == 0) {
	/*
	 * Well nobody's using this named font, so don't have to tell
	 * any widgets to recompute themselves.
	 */

	return;
    }


    cacheHashPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
    while (cacheHashPtr != NULL) {
	for (fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
		fontPtr != NULL; fontPtr = fontPtr->nextPtr) {
	    if (fontPtr->namedHashPtr == namedHashPtr) {
		TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa);
		if (fiPtr->updatePending == 0) {
		    fiPtr->updatePending = 1;
		    Tcl_DoWhenIdle(TheWorldHasChanged, (ClientData) fiPtr);
		}
	    }
	}
	cacheHashPtr = Tcl_NextHashEntry(&search);
    }
}

static void
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
	RecomputeWidgets(winPtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TkCreateNamedFont --
 *
 *	Create the specified named font with the given attributes in the
 *	named font table associated with the interp.  
 *
 * Results:
 *	Returns TCL_OK if the font was successfully created, or TCL_ERROR
 *	if the named font already existed.  If TCL_ERROR is returned, an
 *	error message is left in interp->result.
 *
 * Side effects:
 *	Assume there used to exist a named font by the specified name, and
 *	that the named font had been deleted, but there were still some
 *	widgets using the named font at the time it was deleted.  If a
 *	new named font is created with the same name, all those widgets
 *	that were using the old named font will be redisplayed using
 *	the new named font's attributes.
 *
 *---------------------------------------------------------------------------
 */

int
TkCreateNamedFont(interp, tkwin, name, faPtr)
    Tcl_Interp *interp;		/* Interp for error return. */
    Tk_Window tkwin;		/* A window associated with interp. */
    CONST char *name;		/* Name for the new named font. */
    TkFontAttributes *faPtr;	/* Attributes for the new named font. */
{
    TkFontInfo *fiPtr;
    Tcl_HashEntry *namedHashPtr;
    int new;
    NamedFont *nfPtr;    

    fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;

    name = Tk_GetUid(name);
    namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &new);
		    
    if (new == 0) {
	nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
	if (nfPtr->deletePending == 0) {
	    interp->result[0] = '\0';
	    Tcl_AppendResult(interp, "font \"", name,
		    "\" already exists", (char *) NULL);
	    return TCL_ERROR;
	}

	/*
	 * Recreating a named font with the same name as a previous
	 * named font.  Some widgets were still using that named
	 * font, so they need to get redisplayed.
	 */

	nfPtr->fa = *faPtr;
	nfPtr->deletePending = 0;
	UpdateDependantFonts(fiPtr, tkwin, namedHashPtr);
	return TCL_OK;
    }

    nfPtr = (NamedFont *) ckalloc(sizeof(NamedFont));
    nfPtr->deletePending = 0;
    Tcl_SetHashValue(namedHashPtr, nfPtr);
    nfPtr->fa = *faPtr;







|







|












|
|












<





|
|












|







838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879

880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
	RecomputeWidgets(winPtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * CreateNamedFont --
 *
 *	Create the specified named font with the given attributes in the
 *	named font table associated with the interp.  
 *
 * Results:
 *	Returns TCL_OK if the font was successfully created, or TCL_ERROR
 *	if the named font already existed.  If TCL_ERROR is returned, an
 *	error message is left in the interp's result.
 *
 * Side effects:
 *	Assume there used to exist a named font by the specified name, and
 *	that the named font had been deleted, but there were still some
 *	widgets using the named font at the time it was deleted.  If a
 *	new named font is created with the same name, all those widgets
 *	that were using the old named font will be redisplayed using
 *	the new named font's attributes.
 *
 *---------------------------------------------------------------------------
 */

static int
CreateNamedFont(interp, tkwin, name, faPtr)
    Tcl_Interp *interp;		/* Interp for error return. */
    Tk_Window tkwin;		/* A window associated with interp. */
    CONST char *name;		/* Name for the new named font. */
    TkFontAttributes *faPtr;	/* Attributes for the new named font. */
{
    TkFontInfo *fiPtr;
    Tcl_HashEntry *namedHashPtr;
    int new;
    NamedFont *nfPtr;    

    fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;


    namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &new);
		    
    if (new == 0) {
	nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
	if (nfPtr->deletePending == 0) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "named font \"", name,
		    "\" already exists", (char *) NULL);
	    return TCL_ERROR;
	}

	/*
	 * Recreating a named font with the same name as a previous
	 * named font.  Some widgets were still using that named
	 * font, so they need to get redisplayed.
	 */

	nfPtr->fa = *faPtr;
	nfPtr->deletePending = 0;
	UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
	return TCL_OK;
    }

    nfPtr = (NamedFont *) ckalloc(sizeof(NamedFont));
    nfPtr->deletePending = 0;
    Tcl_SetHashValue(namedHashPtr, nfPtr);
    nfPtr->fa = *faPtr;
765
766
767
768
769
770
771
772
773
774
775
776
777

778
779
780
781
782
783
784
785
786
787
788
789
790
791

792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844

845
846

847






848





849

850
851
852

853
854
855








856



857


858
859
860





861

862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878

879
880
881

882


883
884

885
886
887
888
889
890
891
892
893
894
895

896
897



898
899
900
901
902
903
904
905
906
 *
 *	Given a string description of a font, map the description to a
 *	corresponding Tk_Font that represents the font.
 *
 * Results:
 *	The return value is token for the font, or NULL if an error
 *	prevented the font from being created.  If NULL is returned, an
 *	error message will be left in interp->result.
 *
 * Side effects:
 *	Calls Tk_GetFontFromObj(), which modifies interp's result object,
 *	then copies the string from the result object into interp->result.
 *	This procedure will go away when Tk_ConfigureWidget() is

 *	made into an object command.
 *
 *---------------------------------------------------------------------------
 */

Tk_Font
Tk_GetFont(interp, tkwin, string)
    Tcl_Interp *interp;		/* Interp for database and error return. */
    Tk_Window tkwin;		/* For display on which font will be used. */
    CONST char *string;		/* String describing font, as: named font,
				 * native format, or parseable string. */
{
    Tcl_Obj *strPtr;
    Tk_Font tkfont;

    
    strPtr = Tcl_NewStringObj((char *) string, -1);
    
    tkfont = Tk_GetFontFromObj(interp, tkwin, strPtr);
    if (tkfont == NULL) {
	Tcl_SetResult(interp,
	        Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL),
		TCL_VOLATILE);
    }

    Tcl_DecrRefCount(strPtr);	/* done with object */
    return tkfont;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_GetFontFromObj -- 
 *
 *	Given a string description of a font, map the description to a
 *	corresponding Tk_Font that represents the font.
 *
 * Results:
 *	The return value is token for the font, or NULL if an error
 *	prevented the font from being created.  If NULL is returned, an
 *	error message will be left in interp's result object.
 *
 * Side effects:
 * 	The font is added to an internal database with a reference
 *	count.  For each call to this procedure, there should eventually
 *	be a call to Tk_FreeFont() so that the database is cleaned up when
 *	fonts aren't in use anymore.
 *
 *---------------------------------------------------------------------------
 */

Tk_Font
Tk_GetFontFromObj(interp, tkwin, objPtr)
    Tcl_Interp *interp;		/* Interp for database and error return. */
    Tk_Window tkwin;		/* For display on which font will be used. */
    Tcl_Obj *objPtr;		/* Object describing font, as: named font,
				 * native format, or parseable string. */
{
    TkFontInfo *fiPtr;
    CachedFontKey key;
    Tcl_HashEntry *cacheHashPtr, *namedHashPtr;
    TkFont *fontPtr;
    int new, descent;
    NamedFont *nfPtr;
    char *string;
    
    fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
    string = Tcl_GetStringFromObj(objPtr, NULL);


    key.display = Tk_Display(tkwin);

    key.string = Tk_GetUid(string);






    cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache, (char *) &key, &new);







    if (new == 0) {
	/*
	 * We have already constructed a font with this description for

	 * this display.  Bump the reference count of the cached font.
	 */









	fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);



	fontPtr->refCount++;


	return (Tk_Font) fontPtr;
    }






    namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, key.string);

    if (namedHashPtr != NULL) {
	/*
	 * Construct a font based on a named font.
	 */

	nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
	nfPtr->refCount++;

	fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &nfPtr->fa);
    } else {
	/*
	 * Native font?
	 */

	fontPtr = TkpGetNativeFont(tkwin, string);
	if (fontPtr == NULL) {
	    TkFontAttributes fa;


	    TkInitFontAttributes(&fa);
	    if (ParseFontNameObj(interp, tkwin, objPtr, &fa) != TCL_OK) {

		Tcl_DeleteHashEntry(cacheHashPtr);


		return NULL;
	    }


	    /*
	     * String contained the attributes inline.
	     */

	    fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &fa);
	}
    }
    Tcl_SetHashValue(cacheHashPtr, fontPtr);

    fontPtr->refCount	    = 1;

    fontPtr->cacheHashPtr   = cacheHashPtr;
    fontPtr->namedHashPtr   = namedHashPtr;




    Tk_MeasureChars((Tk_Font) fontPtr, "0", 1, 0, 0, &fontPtr->tabWidth);
    if (fontPtr->tabWidth == 0) {
	fontPtr->tabWidth = fontPtr->fm.maxWidth;
    }
    fontPtr->tabWidth *= 8;

    /*
     * Make sure the tab width isn't zero (some fonts may not have enough







|


|
<
|
>
|











<
|
>
|

|
|
<
<
<
<
<
<
|






|












|
|





|

|




<

|


<
|

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

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














|


>

<
|
>
|
>
>


>








<

|
>
|
|
>
>
>

|







916
917
918
919
920
921
922
923
924
925
926

927
928
929
930
931
932
933
934
935
936
937
938
939
940

941
942
943
944
945
946






947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980

981
982
983
984

985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008

1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056

1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072

1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
 *
 *	Given a string description of a font, map the description to a
 *	corresponding Tk_Font that represents the font.
 *
 * Results:
 *	The return value is token for the font, or NULL if an error
 *	prevented the font from being created.  If NULL is returned, an
 *	error message will be left in the interp's result.
 *
 * Side effects:
 *	The font is added to an internal database with a reference

 *	count.  For each call to this procedure, there should eventually
 *	be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the
 *	database is cleaned up when fonts aren't in use anymore.
 *
 *---------------------------------------------------------------------------
 */

Tk_Font
Tk_GetFont(interp, tkwin, string)
    Tcl_Interp *interp;		/* Interp for database and error return. */
    Tk_Window tkwin;		/* For display on which font will be used. */
    CONST char *string;		/* String describing font, as: named font,
				 * native format, or parseable string. */
{

    Tk_Font tkfont; 
    Tcl_Obj *strPtr;

    strPtr = Tcl_NewStringObj((char *) string, -1);
    Tcl_IncrRefCount(strPtr);
    tkfont = Tk_AllocFontFromObj(interp, tkwin, strPtr);






    Tcl_DecrRefCount(strPtr);	
    return tkfont;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_AllocFontFromObj -- 
 *
 *	Given a string description of a font, map the description to a
 *	corresponding Tk_Font that represents the font.
 *
 * Results:
 *	The return value is token for the font, or NULL if an error
 *	prevented the font from being created.  If NULL is returned, an
 *	error message will be left in interp's result object.
 *
 * Side effects:
 * 	The font is added to an internal database with a reference
 *	count.  For each call to this procedure, there should eventually
 *	be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the
 *	database is cleaned up when fonts aren't in use anymore.
 *
 *---------------------------------------------------------------------------
 */

Tk_Font
Tk_AllocFontFromObj(interp, tkwin, objPtr)
    Tcl_Interp *interp;		/* Interp for database and error return. */
    Tk_Window tkwin;		/* For screen on which font will be used. */
    Tcl_Obj *objPtr;		/* Object describing font, as: named font,
				 * native format, or parseable string. */
{
    TkFontInfo *fiPtr;

    Tcl_HashEntry *cacheHashPtr, *namedHashPtr;
    TkFont *fontPtr, *firstFontPtr, *oldFontPtr;
    int new, descent;
    NamedFont *nfPtr;


    fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
    if (objPtr->typePtr != &fontObjType) {
	SetFontFromAny(interp, objPtr);
    }

    oldFontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;

    if (oldFontPtr != NULL) {
	if (oldFontPtr->resourceRefCount == 0) {
	    /*
	     * This is a stale reference: it refers to a TkFont that's
	     * no longer in use.  Clear the reference.
	     */

	    FreeFontObjProc(objPtr);
	    oldFontPtr = NULL;
	} else if (Tk_Screen(tkwin) == oldFontPtr->screen) {
	    oldFontPtr->resourceRefCount++;
	    return (Tk_Font) oldFontPtr;
	}
    }

    /*

     * Next, search the list of fonts that have the name we want, to see
     * if one of them is for the right screen.
     */

    new = 0;
    if (oldFontPtr != NULL) {
	cacheHashPtr = oldFontPtr->cacheHashPtr;
	FreeFontObjProc(objPtr);
    } else {
	cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache,
		Tcl_GetString(objPtr), &new);
    }
    firstFontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
    for (fontPtr = firstFontPtr; (fontPtr != NULL);
	    fontPtr = fontPtr->nextPtr) {
	if (Tk_Screen(tkwin) == fontPtr->screen) {
	    fontPtr->resourceRefCount++;
	    fontPtr->objRefCount++;
	    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
	    return (Tk_Font) fontPtr;
	}
    }

    /*
     * The desired font isn't in the table.  Make a new one.
     */

    namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable,
	    Tcl_GetString(objPtr));
    if (namedHashPtr != NULL) {
	/*
	 * Construct a font based on a named font.
	 */

	nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
	nfPtr->refCount++;

	fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &nfPtr->fa);
    } else {
	/*
	 * Native font?
	 */

	fontPtr = TkpGetNativeFont(tkwin, Tcl_GetString(objPtr));
	if (fontPtr == NULL) {
	    TkFontAttributes fa;
	    Tcl_Obj *dupObjPtr = Tcl_DuplicateObj(objPtr);


	    if (ParseFontNameObj(interp, tkwin, dupObjPtr, &fa) != TCL_OK) {
		if (new) {
		    Tcl_DeleteHashEntry(cacheHashPtr);
		}
		Tcl_DecrRefCount(dupObjPtr);
		return NULL;
	    }
	    Tcl_DecrRefCount(dupObjPtr);

	    /*
	     * String contained the attributes inline.
	     */

	    fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &fa);
	}
    }


    fontPtr->resourceRefCount = 1;
    fontPtr->objRefCount = 1;
    fontPtr->cacheHashPtr = cacheHashPtr;
    fontPtr->namedHashPtr = namedHashPtr;
    fontPtr->screen = Tk_Screen(tkwin);
    fontPtr->nextPtr = firstFontPtr;
    Tcl_SetHashValue(cacheHashPtr, fontPtr);

    Tk_MeasureChars((Tk_Font) fontPtr, "0", 1, -1, 0, &fontPtr->tabWidth);
    if (fontPtr->tabWidth == 0) {
	fontPtr->tabWidth = fontPtr->fm.maxWidth;
    }
    fontPtr->tabWidth *= 8;

    /*
     * Make sure the tab width isn't zero (some fonts may not have enough
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938

939
940


















































































































941
942
943
944
945
946
947
    /*
     * Get information used for drawing underlines in generic code on a
     * non-underlined font.
     */
    
    descent = fontPtr->fm.descent;
    fontPtr->underlinePos = descent / 2;
    fontPtr->underlineHeight = fontPtr->fa.pointsize / 10;
    if (fontPtr->underlineHeight == 0) {
	fontPtr->underlineHeight = 1;
    }
    if (fontPtr->underlinePos + fontPtr->underlineHeight > descent) {
	/*
	 * If this set of values would cause the bottom of the underline
	 * bar to stick below the descent of the font, jack the underline
	 * up a bit higher.
	 */

	fontPtr->underlineHeight = descent - fontPtr->underlinePos;
	if (fontPtr->underlineHeight == 0) {
	    fontPtr->underlinePos--;
	    fontPtr->underlineHeight = 1;
	}
    }
    

    return (Tk_Font) fontPtr;
}



















































































































/*
 *---------------------------------------------------------------------------
 *
 * Tk_NameOfFont --
 *
 *	Given a font, return a textual string identifying it.







|

















>


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







1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
    /*
     * Get information used for drawing underlines in generic code on a
     * non-underlined font.
     */
    
    descent = fontPtr->fm.descent;
    fontPtr->underlinePos = descent / 2;
    fontPtr->underlineHeight = TkFontGetPixels(tkwin, fontPtr->fa.size) / 10;
    if (fontPtr->underlineHeight == 0) {
	fontPtr->underlineHeight = 1;
    }
    if (fontPtr->underlinePos + fontPtr->underlineHeight > descent) {
	/*
	 * If this set of values would cause the bottom of the underline
	 * bar to stick below the descent of the font, jack the underline
	 * up a bit higher.
	 */

	fontPtr->underlineHeight = descent - fontPtr->underlinePos;
	if (fontPtr->underlineHeight == 0) {
	    fontPtr->underlinePos--;
	    fontPtr->underlineHeight = 1;
	}
    }
    
    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
    return (Tk_Font) fontPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetFontFromObj --
 *
 *	Find the font that corresponds to a given object.  The font must
 *	have already been created by Tk_GetFont or Tk_AllocFontFromObj.
 *
 * Results:
 *	The return value is a token for the font that matches objPtr
 *	and is suitable for use in tkwin.
 *
 * Side effects:
 *	If the object is not already a font ref, the conversion will free
 *	any old internal representation. 
 *
 *----------------------------------------------------------------------
 */

Tk_Font
Tk_GetFontFromObj(tkwin, objPtr)
    Tk_Window tkwin;		/* The window that the font will be used in. */
    Tcl_Obj *objPtr;		/* The object from which to get the font. */
{
    TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
    TkFont *fontPtr;
    Tcl_HashEntry *hashPtr;
 
    if (objPtr->typePtr != &fontObjType) {
	SetFontFromAny((Tcl_Interp *) NULL, objPtr);
    }

    fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;

    if (fontPtr != NULL) {
	if (fontPtr->resourceRefCount == 0) {
	    /*
	     * This is a stale reference: it refers to a TkFont that's
	     * no longer in use.  Clear the reference.
	     */

	    FreeFontObjProc(objPtr);
	    fontPtr = NULL;
	} else if (Tk_Screen(tkwin) == fontPtr->screen) {
	    return (Tk_Font) fontPtr;
	}
    }

    /*
     * Next, search the list of fonts that have the name we want, to see
     * if one of them is for the right screen.
     */

    if (fontPtr != NULL) {
	hashPtr = fontPtr->cacheHashPtr;
	FreeFontObjProc(objPtr);
    } else {
	hashPtr = Tcl_FindHashEntry(&fiPtr->fontCache, Tcl_GetString(objPtr));
    }
    if (hashPtr != NULL) {
	for (fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr); fontPtr != NULL;
		fontPtr = fontPtr->nextPtr) {
	    if (Tk_Screen(tkwin) == fontPtr->screen) {
		fontPtr->objRefCount++;
		objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
		return (Tk_Font) fontPtr;
	    }
	}
    }

    panic("Tk_GetFontFromObj called with non-existent font!");
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * SetFontFromAny --
 *
 *	Convert the internal representation of a Tcl object to the
 *	font internal form.
 *
 * Results:
 *	Always returns TCL_OK.
 *
 * Side effects:
 *	The object is left with its typePtr pointing to fontObjType.
 *	The TkFont pointer is NULL.
 *
 *----------------------------------------------------------------------
 */

static int
SetFontFromAny(interp, objPtr)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr;		/* The object to convert. */
{
    Tcl_ObjType *typePtr;

    /*
     * Free the old internalRep before setting the new one. 
     */

    Tcl_GetString(objPtr);
    typePtr = objPtr->typePtr;
    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	(*typePtr->freeIntRepProc)(objPtr);
    }
    objPtr->typePtr = &fontObjType;
    objPtr->internalRep.twoPtrValue.ptr1 = NULL;

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_NameOfFont --
 *
 *	Given a font, return a textual string identifying it.
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
 */

char *
Tk_NameOfFont(tkfont)
    Tk_Font tkfont;		/* Font whose name is desired. */
{
    TkFont *fontPtr;
    Tcl_HashEntry *hPtr;
    CachedFontKey *keyPtr;

    fontPtr = (TkFont *) tkfont;
    hPtr = fontPtr->cacheHashPtr;

    keyPtr = (CachedFontKey *) Tcl_GetHashKey(hPtr->tablePtr, hPtr);
    return (char *) keyPtr->string;    
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_FreeFont -- 
 *







<
<


|
<
<
<







1257
1258
1259
1260
1261
1262
1263


1264
1265
1266



1267
1268
1269
1270
1271
1272
1273
 */

char *
Tk_NameOfFont(tkfont)
    Tk_Font tkfont;		/* Font whose name is desired. */
{
    TkFont *fontPtr;



    fontPtr = (TkFont *) tkfont;
    return fontPtr->cacheHashPtr->key.string;



}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_FreeFont -- 
 *
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005


1006
1007
1008
1009


1010
1011
1012
1013
1014
1015
1016
1017
1018




1019










1020

































































































1021
1022
1023
1024
1025
1026
1027
 *---------------------------------------------------------------------------
 */

void
Tk_FreeFont(tkfont)
    Tk_Font tkfont;		/* Font to be released. */
{
    TkFont *fontPtr;
    NamedFont *nfPtr;

    if (tkfont == NULL) {
	return;
    }
    fontPtr = (TkFont *) tkfont;
    fontPtr->refCount--;
    if (fontPtr->refCount == 0) {


	if (fontPtr->namedHashPtr != NULL) {
	    /*
	     * The font is being deleted.  Determine if the associated named
	     * font definition should and/or can be deleted too.


	     */

	    nfPtr = (NamedFont *) Tcl_GetHashValue(fontPtr->namedHashPtr);
	    nfPtr->refCount--;
	    if ((nfPtr->refCount == 0) && (nfPtr->deletePending != 0)) {
		Tcl_DeleteHashEntry(fontPtr->namedHashPtr);
		ckfree((char *) nfPtr);
	    }
	}




	Tcl_DeleteHashEntry(fontPtr->cacheHashPtr);










	TkpDeleteFont(fontPtr);

































































































    }
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_FontId --







|






|
|
>
>
|
|
<
|
>
>
|

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







1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302

1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
 *---------------------------------------------------------------------------
 */

void
Tk_FreeFont(tkfont)
    Tk_Font tkfont;		/* Font to be released. */
{
    TkFont *fontPtr, *prevPtr;
    NamedFont *nfPtr;

    if (tkfont == NULL) {
	return;
    }
    fontPtr = (TkFont *) tkfont;
    fontPtr->resourceRefCount--;
    if (fontPtr->resourceRefCount > 0) {
	return;
    }
    if (fontPtr->namedHashPtr != NULL) {
	/*

	 * This font derived from a named font.  Reduce the reference
	 * count on the named font and free it if no-one else is
	 * using it.
	 */

	nfPtr = (NamedFont *) Tcl_GetHashValue(fontPtr->namedHashPtr);
	nfPtr->refCount--;
	if ((nfPtr->refCount == 0) && (nfPtr->deletePending != 0)) {
	    Tcl_DeleteHashEntry(fontPtr->namedHashPtr);
	    ckfree((char *) nfPtr);
	}
    }

    prevPtr = (TkFont *) Tcl_GetHashValue(fontPtr->cacheHashPtr);
    if (prevPtr == fontPtr) {
	if (fontPtr->nextPtr == NULL) {
	    Tcl_DeleteHashEntry(fontPtr->cacheHashPtr);
	} else  {
	    Tcl_SetHashValue(fontPtr->cacheHashPtr, fontPtr->nextPtr);
	}
    } else {
	while (prevPtr->nextPtr != fontPtr) {
	    prevPtr = prevPtr->nextPtr;
	}
	prevPtr->nextPtr = fontPtr->nextPtr;
    }

    TkpDeleteFont(fontPtr);
    if (fontPtr->objRefCount == 0) {
	ckfree((char *) fontPtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_FreeFontFromObj -- 
 *
 *	Called to release a font inside a Tcl_Obj *. Decrements the refCount
 *	of the font and removes it from the hash tables if necessary.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The reference count associated with font is decremented, and
 *	only deallocated when no one is using it.
 *
 *---------------------------------------------------------------------------
 */

void
Tk_FreeFontFromObj(tkwin, objPtr)
    Tk_Window tkwin;		/* The window this font lives in. Needed
				 * for the screen value. */
    Tcl_Obj *objPtr;		/* The Tcl_Obj * to be freed. */
{
    Tk_FreeFont(Tk_GetFontFromObj(tkwin, objPtr));
}

/*
 *---------------------------------------------------------------------------
 *
 * FreeFontObjProc -- 
 *
 *	This proc is called to release an object reference to a font.
 *	Called when the object's internal rep is released or when
 *	the cached fontPtr needs to be changed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object reference count is decremented. When both it
 *	and the hash ref count go to zero, the font's resources
 *	are released.
 *
 *---------------------------------------------------------------------------
 */

static void
FreeFontObjProc(objPtr)
    Tcl_Obj *objPtr;		/* The object we are releasing. */
{
    TkFont *fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;

    if (fontPtr != NULL) {
	fontPtr->objRefCount--;
	if ((fontPtr->resourceRefCount == 0) && (fontPtr->objRefCount == 0)) {
	    ckfree((char *) fontPtr);
	    objPtr->internalRep.twoPtrValue.ptr1 = NULL;
	}
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * DupFontObjProc -- 
 *
 *	When a cached font object is duplicated, this is called to
 *	update the internal reps.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The font's objRefCount is incremented and the internal rep
 *	of the copy is set to point to it.
 *
 *---------------------------------------------------------------------------
 */

static void
DupFontObjProc(srcObjPtr, dupObjPtr)
    Tcl_Obj *srcObjPtr;		/* The object we are copying from. */
    Tcl_Obj *dupObjPtr;		/* The object we are copying to. */
{
    TkFont *fontPtr = (TkFont *) srcObjPtr->internalRep.twoPtrValue.ptr1;
    
    dupObjPtr->typePtr = srcObjPtr->typePtr;
    dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;

    if (fontPtr != NULL) {
	fontPtr->objRefCount++;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_FontId --
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
 *
 *	Any other Tk_Font font families may not print correctly
 *	because the computed Postscript font name may be incorrect.
 *
 *---------------------------------------------------------------------------
 */


int
Tk_PostscriptFontName(tkfont, dsPtr)
    Tk_Font tkfont;		/* Font in which text will be printed. */
    Tcl_DString *dsPtr;		/* Pointer to an initialized Tcl_DString to
				 * which the name of the Postscript font that
				 * corresponds to tkfont will be appended. */
{







<







1515
1516
1517
1518
1519
1520
1521

1522
1523
1524
1525
1526
1527
1528
 *
 *	Any other Tk_Font font families may not print correctly
 *	because the computed Postscript font name may be incorrect.
 *
 *---------------------------------------------------------------------------
 */


int
Tk_PostscriptFontName(tkfont, dsPtr)
    Tk_Font tkfont;		/* Font in which text will be printed. */
    Tcl_DString *dsPtr;		/* Pointer to an initialized Tcl_DString to
				 * which the name of the Postscript font that
				 * corresponds to tkfont will be appended. */
{
1150
1151
1152
1153
1154
1155
1156


1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174

1175


1176
1177

1178
1179
1180
1181
1182
1183
1184
    } else if (strcasecmp(family, "AvantGarde") == 0) {
	family = "AvantGarde";
    } else if (strcasecmp(family, "ZapfChancery") == 0) {
	family = "ZapfChancery";
    } else if (strcasecmp(family, "ZapfDingbats") == 0) {
	family = "ZapfDingbats";
    } else {


	/*
	 * Inline, capitalize the first letter of each word, lowercase the
	 * rest of the letters in each word, and then take out the spaces
	 * between the words.  This may make the DString shorter, which is
	 * safe to do.
	 */

	Tcl_DStringAppend(dsPtr, family, -1);

	src = dest = Tcl_DStringValue(dsPtr) + len;
	upper = 1;
	for (; *src != '\0'; src++, dest++) {
	    while (isspace(UCHAR(*src))) {
		src++;
		upper = 1;
	    }
	    *dest = *src;
	    if ((upper != 0) && (islower(UCHAR(*src)))) {

		*dest = toupper(UCHAR(*src));


	    }
	    upper = 0;

	}
	*dest = '\0';
	Tcl_DStringSetLength(dsPtr, dest - Tcl_DStringValue(dsPtr));
	family = Tcl_DStringValue(dsPtr) + len;
    }
    if (family != Tcl_DStringValue(dsPtr) + len) {
	Tcl_DStringAppend(dsPtr, family, -1);







>
>











|
|



|
|
>
|
>
>

<
>







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
    } else if (strcasecmp(family, "AvantGarde") == 0) {
	family = "AvantGarde";
    } else if (strcasecmp(family, "ZapfChancery") == 0) {
	family = "ZapfChancery";
    } else if (strcasecmp(family, "ZapfDingbats") == 0) {
	family = "ZapfDingbats";
    } else {
	Tcl_UniChar ch;

	/*
	 * Inline, capitalize the first letter of each word, lowercase the
	 * rest of the letters in each word, and then take out the spaces
	 * between the words.  This may make the DString shorter, which is
	 * safe to do.
	 */

	Tcl_DStringAppend(dsPtr, family, -1);

	src = dest = Tcl_DStringValue(dsPtr) + len;
	upper = 1;
	for (; *src != '\0'; ) {
	    while (isspace(UCHAR(*src))) { /* INTL: ISO space */
		src++;
		upper = 1;
	    }
	    src += Tcl_UtfToUniChar(src, &ch);
	    if (upper) {
		ch = Tcl_UniCharToUpper(ch);
		upper = 0;
	    } else {
	        ch = Tcl_UniCharToLower(ch);
	    }

	    dest += Tcl_UniCharToUtf(ch, dest);
	}
	*dest = '\0';
	Tcl_DStringSetLength(dsPtr, dest - Tcl_DStringValue(dsPtr));
	family = Tcl_DStringValue(dsPtr) + len;
    }
    if (family != Tcl_DStringValue(dsPtr) + len) {
	Tcl_DStringAppend(dsPtr, family, -1);
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
	    Tcl_DStringAppend(dsPtr, weightString, -1);
	}
	if (slantString != NULL) {
	    Tcl_DStringAppend(dsPtr, slantString, -1);
	}
    }

    return fontPtr->fa.pointsize;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_TextWidth --
 *







|







1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
	    Tcl_DStringAppend(dsPtr, weightString, -1);
	}
	if (slantString != NULL) {
	    Tcl_DStringAppend(dsPtr, slantString, -1);
	}
    }

    return fontPtr->fa.size;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_TextWidth --
 *
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
Tk_TextWidth(tkfont, string, numChars)
    Tk_Font tkfont;		/* Font in which text will be measured. */
    CONST char *string;		/* String whose width will be computed. */
    int numChars;		/* Number of characters to consider from
				 * string, or < 0 for strlen(). */
{
    int width;

    if (numChars < 0) {
	numChars = strlen(string);
    }
    Tk_MeasureChars(tkfont, string, numChars, 0, 0, &width);
    return width;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_UnderlineChars --







|


|




|
|

|







1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
Tk_TextWidth(tkfont, string, numBytes)
    Tk_Font tkfont;		/* Font in which text will be measured. */
    CONST char *string;		/* String whose width will be computed. */
    int numBytes;		/* Number of bytes to consider from
				 * string, or < 0 for strlen(). */
{
    int width;

    if (numBytes < 0) {
	numBytes = strlen(string);
    }
    Tk_MeasureChars(tkfont, string, numBytes, -1, 0, &width);
    return width;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_UnderlineChars --
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326

1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
 * Side effects:
 *	Information gets displayed in "drawable".
 *
 *----------------------------------------------------------------------
 */

void
Tk_UnderlineChars(display, drawable, gc, tkfont, string, x, y, firstChar,
	lastChar)
    Display *display;		/* Display on which to draw. */
    Drawable drawable;		/* Window or pixmap in which to draw. */
    GC gc;			/* Graphics context for actually drawing
				 * line. */
    Tk_Font tkfont;		/* Font used in GC;  must have been allocated
				 * by Tk_GetFont().  Used for character
				 * dimensions, etc. */
    CONST char *string;		/* String containing characters to be
				 * underlined or overstruck. */
    int x, y;			/* Coordinates at which first character of
				 * string is drawn. */

    int firstChar;		/* Index of first character. */
    int lastChar;		/* Index of one after the last character. */
{
    TkFont *fontPtr;
    int startX, endX;

    fontPtr = (TkFont *) tkfont;
    
    Tk_MeasureChars(tkfont, string, firstChar, 0, 0, &startX);
    Tk_MeasureChars(tkfont, string, lastChar, 0, 0, &endX);

    XFillRectangle(display, drawable, gc, x + startX,
	    y + fontPtr->underlinePos, (unsigned int) (endX - startX),
	    (unsigned int) fontPtr->underlineHeight);
}

/*







|
|











>
|
|






|
|







1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
 * Side effects:
 *	Information gets displayed in "drawable".
 *
 *----------------------------------------------------------------------
 */

void
Tk_UnderlineChars(display, drawable, gc, tkfont, string, x, y, firstByte,
	lastByte)
    Display *display;		/* Display on which to draw. */
    Drawable drawable;		/* Window or pixmap in which to draw. */
    GC gc;			/* Graphics context for actually drawing
				 * line. */
    Tk_Font tkfont;		/* Font used in GC;  must have been allocated
				 * by Tk_GetFont().  Used for character
				 * dimensions, etc. */
    CONST char *string;		/* String containing characters to be
				 * underlined or overstruck. */
    int x, y;			/* Coordinates at which first character of
				 * string is drawn. */
    int firstByte;		/* Index of first byte of first character. */
    int lastByte;		/* Index of first byte after the last
				 * character. */
{
    TkFont *fontPtr;
    int startX, endX;

    fontPtr = (TkFont *) tkfont;
    
    Tk_MeasureChars(tkfont, string, firstByte, -1, 0, &startX);
    Tk_MeasureChars(tkfont, string, lastByte, -1, 0, &endX);

    XFillRectangle(display, drawable, gc, x + startX,
	    y + fontPtr->underlinePos, (unsigned int) (endX - startX),
	    (unsigned int) fontPtr->underlineHeight);
}

/*
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416



1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445





1446
1447
1448
1449
1450
1451
1452
				 * means that newline characters should not
				 * cause a line break. */
    int *widthPtr;		/* Filled with width of string. */
    int *heightPtr;		/* Filled with height of string. */
{
    TkFont *fontPtr;
    CONST char *start, *end, *special;
    int n, y, charsThisChunk, maxChunks;
    int baseline, height, curX, newX, maxWidth;
    TextLayout *layoutPtr;
    LayoutChunk *chunkPtr;
    CONST TkFontMetrics *fmPtr;
#define MAX_LINES 50
    int staticLineLengths[MAX_LINES];
    int *lineLengths;
    int maxLines, curLine, layoutHeight;

    lineLengths = staticLineLengths;
    maxLines = MAX_LINES;
    
    fontPtr = (TkFont *) tkfont;
    fmPtr = &fontPtr->fm;

    height = fmPtr->ascent + fmPtr->descent;

    if (numChars < 0) {
	numChars = strlen(string);



    }

    maxChunks = 1;

    layoutPtr = (TextLayout *) ckalloc(sizeof(TextLayout)
	    + (maxChunks - 1) * sizeof(LayoutChunk));
    layoutPtr->tkfont	    = tkfont;
    layoutPtr->string	    = string;
    layoutPtr->numChunks    = 0;

    baseline = fmPtr->ascent;
    maxWidth = 0;

    /*
     * Divide the string up into simple strings and measure each string.
     */

    curX = 0;

    end = string + numChars;
    special = string;

    flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES;
    flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE;	    
    curLine = 0;
    for (start = string; start < end; ) {
	if (start >= special) {
	    /*
	     * Find the next special character in the string.





	     */

	    for (special = start; special < end; special++) {
		if (!(flags & TK_IGNORE_NEWLINES)) {
		    if ((*special == '\n') || (*special == '\r')) {
			break;
		    }







|




|
<

|

|
<







|
>
>
>



















|




<




>
>
>
>
>







1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814

1815
1816
1817
1818

1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853

1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
				 * means that newline characters should not
				 * cause a line break. */
    int *widthPtr;		/* Filled with width of string. */
    int *heightPtr;		/* Filled with height of string. */
{
    TkFont *fontPtr;
    CONST char *start, *end, *special;
    int n, y, bytesThisChunk, maxChunks;
    int baseline, height, curX, newX, maxWidth;
    TextLayout *layoutPtr;
    LayoutChunk *chunkPtr;
    CONST TkFontMetrics *fmPtr;
    Tcl_DString lineBuffer;

    int *lineLengths;
    int curLine, layoutHeight;

    Tcl_DStringInit(&lineBuffer);

    
    fontPtr = (TkFont *) tkfont;
    fmPtr = &fontPtr->fm;

    height = fmPtr->ascent + fmPtr->descent;

    if (numChars < 0) {
	numChars = Tcl_NumUtfChars(string, -1);
    }
    if (wrapLength == 0) {
	wrapLength = -1;
    }

    maxChunks = 1;

    layoutPtr = (TextLayout *) ckalloc(sizeof(TextLayout)
	    + (maxChunks - 1) * sizeof(LayoutChunk));
    layoutPtr->tkfont	    = tkfont;
    layoutPtr->string	    = string;
    layoutPtr->numChunks    = 0;

    baseline = fmPtr->ascent;
    maxWidth = 0;

    /*
     * Divide the string up into simple strings and measure each string.
     */

    curX = 0;

    end = Tcl_UtfAtIndex(string, numChars);
    special = string;

    flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES;
    flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE;	    

    for (start = string; start < end; ) {
	if (start >= special) {
	    /*
	     * Find the next special character in the string.
	     *
	     * INTL: Note that it is safe to increment by byte, because we are
	     * looking for 7-bit characters that will appear unchanged in
	     * UTF-8.  At some point we may need to support the full Unicode
	     * whitespace set.
	     */

	    for (special = start; special < end; special++) {
		if (!(flags & TK_IGNORE_NEWLINES)) {
		    if ((*special == '\n') || (*special == '\r')) {
			break;
		    }
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484



1485
1486
1487
1488
1489
1490
1491
	/*
	 * Special points at the next special character (or the end of the
	 * string).  Process characters between start and special.
	 */

	chunkPtr = NULL;
	if (start < special) {
	    charsThisChunk = Tk_MeasureChars(tkfont, start, special - start,
		    wrapLength - curX, flags, &newX);
	    newX += curX;
	    flags &= ~TK_AT_LEAST_ONE;
	    if (charsThisChunk > 0) {
		chunkPtr = NewChunk(&layoutPtr, &maxChunks, start,
			charsThisChunk, curX, newX, baseline);
			
		start += charsThisChunk;
		curX = newX;
	    }
	}

	if ((start == special) && (special < end)) {
	    /*
	     * Handle the special character.



	     */

	    chunkPtr = NULL;
	    if (*special == '\t') {
		newX = curX + fontPtr->tabWidth;
		newX -= newX % fontPtr->tabWidth;
		NewChunk(&layoutPtr, &maxChunks, start, 1, curX, newX,







|



|

|

|







>
>
>







1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
	/*
	 * Special points at the next special character (or the end of the
	 * string).  Process characters between start and special.
	 */

	chunkPtr = NULL;
	if (start < special) {
	    bytesThisChunk = Tk_MeasureChars(tkfont, start, special - start,
		    wrapLength - curX, flags, &newX);
	    newX += curX;
	    flags &= ~TK_AT_LEAST_ONE;
	    if (bytesThisChunk > 0) {
		chunkPtr = NewChunk(&layoutPtr, &maxChunks, start,
			bytesThisChunk, curX, newX, baseline);
			
		start += bytesThisChunk;
		curX = newX;
	    }
	}

	if ((start == special) && (special < end)) {
	    /*
	     * Handle the special character.
	     *
	     * INTL: Special will be pointing at a 7-bit character so we
	     * can safely treat it as a single byte.
	     */

	    chunkPtr = NULL;
	    if (*special == '\t') {
		newX = curX + fontPtr->tabWidth;
		newX -= newX % fontPtr->tabWidth;
		NewChunk(&layoutPtr, &maxChunks, start, 1, curX, newX,
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531


1532
1533
1534

1535

1536

1537
1538
1539
1540


1541
1542
1543
1544
1545
1546
1547

	/*
	 * No more characters are going to go on this line, either because
	 * no more characters can fit or there are no more characters left.
	 * Consume all extra spaces at end of line.  
	 */

	while ((start < end) && isspace(UCHAR(*start))) {
	    if (!(flags & TK_IGNORE_NEWLINES)) {
		if ((*start == '\n') || (*start == '\r')) {
		    break;
		}
	    }
	    if (!(flags & TK_IGNORE_TABS)) {
		if (*start == '\t') {
		    break;
		}
	    }
	    start++;
	}
	if (chunkPtr != NULL) {


	    /*
	     * Append all the extra spaces on this line to the end of the
	     * last text chunk.

	     */

	    charsThisChunk = start - (chunkPtr->start + chunkPtr->numChars);

	    if (charsThisChunk > 0) {
		chunkPtr->numChars += Tk_MeasureChars(tkfont,
			chunkPtr->start + chunkPtr->numChars, charsThisChunk,
			0, 0, &chunkPtr->totalWidth);


		chunkPtr->totalWidth += curX;
	    }
	}

        wrapLine: 
	flags |= TK_AT_LEAST_ONE;








|













>
>


|
>

>
|
>
|
|
<
|
>
>







1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963

1964
1965
1966
1967
1968
1969
1970
1971
1972
1973

	/*
	 * No more characters are going to go on this line, either because
	 * no more characters can fit or there are no more characters left.
	 * Consume all extra spaces at end of line.  
	 */

	while ((start < end) && isspace(UCHAR(*start))) { /* INTL: ISO space */
	    if (!(flags & TK_IGNORE_NEWLINES)) {
		if ((*start == '\n') || (*start == '\r')) {
		    break;
		}
	    }
	    if (!(flags & TK_IGNORE_TABS)) {
		if (*start == '\t') {
		    break;
		}
	    }
	    start++;
	}
	if (chunkPtr != NULL) {
	    CONST char *end;

	    /*
	     * Append all the extra spaces on this line to the end of the
	     * last text chunk.  This is a little tricky because we are
	     * switching back and forth between characters and bytes.
	     */

	    end = chunkPtr->start + chunkPtr->numBytes;
	    bytesThisChunk = start - end;
	    if (bytesThisChunk > 0) {
		bytesThisChunk = Tk_MeasureChars(tkfont, end, bytesThisChunk,

			-1, 0, &chunkPtr->totalWidth);
		chunkPtr->numBytes += bytesThisChunk;
		chunkPtr->numChars += Tcl_NumUtfChars(end, bytesThisChunk);
		chunkPtr->totalWidth += curX;
	    }
	}

        wrapLine: 
	flags |= TK_AT_LEAST_ONE;

1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590

1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631

1632
1633
1634
1635
1636
1637

























1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
	}

	/*
	 * Remember width of this line, so that all chunks on this line
	 * can be centered or right justified, if necessary.
	 */

	if (curLine >= maxLines) {
	    int *newLengths;
	    
	    newLengths = (int *) ckalloc(2 * maxLines * sizeof(int));
	    memcpy((void *) newLengths, lineLengths, maxLines * sizeof(int));
	    if (lineLengths != staticLineLengths) {
	        ckfree((char *) lineLengths);
	    }
	    lineLengths = newLengths;
	    maxLines *= 2;
	}
	lineLengths[curLine] = curX;
	curLine++;

	curX = 0;
	baseline += height;
    }

    /*
     * If last line ends with a newline, then we need to make a 0 width
     * chunk on the next line.  Otherwise "Hello" and "Hello\n" are the
     * same height.
     */

    if ((layoutPtr->numChunks > 0) && ((flags & TK_IGNORE_NEWLINES) == 0)) {
	if (layoutPtr->chunks[layoutPtr->numChunks - 1].start[0] == '\n') {
	    chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, 0, curX,
		    1000000000, baseline);
	    chunkPtr->numDisplayChars = -1;

	    baseline += height;
	}
    }	    

    /*
     * Using maximum line length, shift all the chunks so that the lines are
     * all justified correctly.
     */
    
    curLine = 0;
    chunkPtr = layoutPtr->chunks;
    y = chunkPtr->y;
    for (n = 0; n < layoutPtr->numChunks; n++) {
	int extra;

	if (chunkPtr->y != y) {
	    curLine++;
	    y = chunkPtr->y;
	}
	extra = maxWidth - lineLengths[curLine];
	if (justify == TK_JUSTIFY_CENTER) {
	    chunkPtr->x += extra / 2;
	} else if (justify == TK_JUSTIFY_RIGHT) {
	    chunkPtr->x += extra;
	}
	chunkPtr++;
    }

    layoutPtr->width = maxWidth;
    layoutHeight = baseline - fmPtr->ascent;
    if (layoutPtr->numChunks == 0) {
	layoutHeight = height;

	/*
	 * This fake chunk is used by the other procedures so that they can
	 * pretend that there is a chunk with no chars in it, which makes
	 * the coding simpler.
	 */

	layoutPtr->numChunks = 1;
	layoutPtr->chunks[0].start		= string;

	layoutPtr->chunks[0].numChars		= 0;
	layoutPtr->chunks[0].numDisplayChars	= -1;
	layoutPtr->chunks[0].x			= 0;
	layoutPtr->chunks[0].y			= fmPtr->ascent;
	layoutPtr->chunks[0].totalWidth		= 0;
	layoutPtr->chunks[0].displayWidth	= 0;

























    }

    if (widthPtr != NULL) {
	*widthPtr = layoutPtr->width;
    }
    if (heightPtr != NULL) {
	*heightPtr = layoutHeight;
    }
    if (lineLengths != staticLineLengths) {
	ckfree((char *) lineLengths);
    }

    return (Tk_TextLayout) layoutPtr;
}

/*
 *---------------------------------------------------------------------------
 *







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
















>




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













>






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








<
|
<







1981
1982
1983
1984
1985
1986
1987


1988










1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
























2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062

2063

2064
2065
2066
2067
2068
2069
2070
	}

	/*
	 * Remember width of this line, so that all chunks on this line
	 * can be centered or right justified, if necessary.
	 */



	Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));











	curX = 0;
	baseline += height;
    }

    /*
     * If last line ends with a newline, then we need to make a 0 width
     * chunk on the next line.  Otherwise "Hello" and "Hello\n" are the
     * same height.
     */

    if ((layoutPtr->numChunks > 0) && ((flags & TK_IGNORE_NEWLINES) == 0)) {
	if (layoutPtr->chunks[layoutPtr->numChunks - 1].start[0] == '\n') {
	    chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, 0, curX,
		    1000000000, baseline);
	    chunkPtr->numDisplayChars = -1;
	    Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));
	    baseline += height;
	}
    }	    

























    layoutPtr->width = maxWidth;
    layoutHeight = baseline - fmPtr->ascent;
    if (layoutPtr->numChunks == 0) {
	layoutHeight = height;

	/*
	 * This fake chunk is used by the other procedures so that they can
	 * pretend that there is a chunk with no chars in it, which makes
	 * the coding simpler.
	 */

	layoutPtr->numChunks = 1;
	layoutPtr->chunks[0].start		= string;
	layoutPtr->chunks[0].numBytes		= 0;
	layoutPtr->chunks[0].numChars		= 0;
	layoutPtr->chunks[0].numDisplayChars	= -1;
	layoutPtr->chunks[0].x			= 0;
	layoutPtr->chunks[0].y			= fmPtr->ascent;
	layoutPtr->chunks[0].totalWidth		= 0;
	layoutPtr->chunks[0].displayWidth	= 0;
    } else {
	/*
	 * Using maximum line length, shift all the chunks so that the lines
	 * are all justified correctly.
	 */
    
	curLine = 0;
	chunkPtr = layoutPtr->chunks;
	y = chunkPtr->y;
	lineLengths = (int *) Tcl_DStringValue(&lineBuffer);
	for (n = 0; n < layoutPtr->numChunks; n++) {
	    int extra;

	    if (chunkPtr->y != y) {
		curLine++;
		y = chunkPtr->y;
	    }
	    extra = maxWidth - lineLengths[curLine];
	    if (justify == TK_JUSTIFY_CENTER) {
		chunkPtr->x += extra / 2;
	    } else if (justify == TK_JUSTIFY_RIGHT) {
		chunkPtr->x += extra;
	    }
	    chunkPtr++;
	}
    }

    if (widthPtr != NULL) {
	*widthPtr = layoutPtr->width;
    }
    if (heightPtr != NULL) {
	*heightPtr = layoutHeight;
    }

    Tcl_DStringFree(&lineBuffer);


    return (Tk_TextLayout) layoutPtr;
}

/*
 *---------------------------------------------------------------------------
 *
1714
1715
1716
1717
1718
1719
1720


1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737

1738

1739
1740
1741
1742
1743
1744

1745
1746
1747
1748
1749
1750
1751
1752
1753
				 * beginning. */
    int lastChar;		/* The index just after the last character
				 * to draw from the given text item.  A number
				 * < 0 means to draw all characters. */
{
    TextLayout *layoutPtr;
    int i, numDisplayChars, drawX;


    LayoutChunk *chunkPtr;

    layoutPtr = (TextLayout *) layout;
    if (layoutPtr == NULL) {
	return;
    }

    if (lastChar < 0) {
	lastChar = 100000000;
    }
    chunkPtr = layoutPtr->chunks;
    for (i = 0; i < layoutPtr->numChunks; i++) {
	numDisplayChars = chunkPtr->numDisplayChars;
	if ((numDisplayChars > 0) && (firstChar < numDisplayChars)) {
	    if (firstChar <= 0) {
		drawX = 0;
		firstChar = 0;

	    } else {

		Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start, firstChar,
			0, 0, &drawX);
	    }
	    if (lastChar < numDisplayChars) {
		numDisplayChars = lastChar;
	    }

	    Tk_DrawChars(display, drawable, gc, layoutPtr->tkfont,
		    chunkPtr->start + firstChar, numDisplayChars - firstChar,
		    x + chunkPtr->x + drawX, y + chunkPtr->y);
	}
	firstChar -= chunkPtr->numChars;
	lastChar -= chunkPtr->numChars;
	if (lastChar <= 0) {
	    break;
	}







>
>

















>

>
|
|




>

|







2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
				 * beginning. */
    int lastChar;		/* The index just after the last character
				 * to draw from the given text item.  A number
				 * < 0 means to draw all characters. */
{
    TextLayout *layoutPtr;
    int i, numDisplayChars, drawX;
    CONST char *firstByte;
    CONST char *lastByte;
    LayoutChunk *chunkPtr;

    layoutPtr = (TextLayout *) layout;
    if (layoutPtr == NULL) {
	return;
    }

    if (lastChar < 0) {
	lastChar = 100000000;
    }
    chunkPtr = layoutPtr->chunks;
    for (i = 0; i < layoutPtr->numChunks; i++) {
	numDisplayChars = chunkPtr->numDisplayChars;
	if ((numDisplayChars > 0) && (firstChar < numDisplayChars)) {
	    if (firstChar <= 0) {
		drawX = 0;
		firstChar = 0;
		firstByte = chunkPtr->start;
	    } else {
		firstByte = Tcl_UtfAtIndex(chunkPtr->start, firstChar);
		Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start,
			firstByte - chunkPtr->start, -1, 0, &drawX);
	    }
	    if (lastChar < numDisplayChars) {
		numDisplayChars = lastChar;
	    }
	    lastByte = Tcl_UtfAtIndex(chunkPtr->start, numDisplayChars);
	    Tk_DrawChars(display, drawable, gc, layoutPtr->tkfont,
		    firstByte, lastByte - firstByte,
		    x + chunkPtr->x + drawX, y + chunkPtr->y);
	}
	firstChar -= chunkPtr->numChars;
	lastChar -= chunkPtr->numChars;
	if (lastChar <= 0) {
	    break;
	}
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869

1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
    int x, y;			/* Coordinates of point to check, with
				 * respect to the upper-left corner of the
				 * text layout. */
{
    TextLayout *layoutPtr;
    LayoutChunk *chunkPtr, *lastPtr;
    TkFont *fontPtr;
    int i, n, dummy, baseline, pos;

    if (y < 0) {
	/*
	 * Point lies above any line in this layout.  Return the index of
	 * the first char.
	 */

	return 0;
    }

    /*
     * Find which line contains the point.
     */

    layoutPtr = (TextLayout *) layout;
    fontPtr = (TkFont *) layoutPtr->tkfont;
    lastPtr = chunkPtr = layoutPtr->chunks;

    for (i = 0; i < layoutPtr->numChunks; i++) {
	baseline = chunkPtr->y;
	if (y < baseline + fontPtr->fm.descent) {
	    if (x < chunkPtr->x) {
		/*
		 * Point is to the left of all chunks on this line.  Return
		 * the index of the first character on this line.
		 */

		return chunkPtr->start - layoutPtr->string;
	    }
	    if (x >= layoutPtr->width) {
		/*
		 * If point lies off right side of the text layout, return
		 * the last char in the last chunk on this line.  Without
		 * this, it might return the index of the first char that
		 * was located outside of the text layout.







|

















>









|







2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
    int x, y;			/* Coordinates of point to check, with
				 * respect to the upper-left corner of the
				 * text layout. */
{
    TextLayout *layoutPtr;
    LayoutChunk *chunkPtr, *lastPtr;
    TkFont *fontPtr;
    int i, n, dummy, baseline, pos, numChars;

    if (y < 0) {
	/*
	 * Point lies above any line in this layout.  Return the index of
	 * the first char.
	 */

	return 0;
    }

    /*
     * Find which line contains the point.
     */

    layoutPtr = (TextLayout *) layout;
    fontPtr = (TkFont *) layoutPtr->tkfont;
    lastPtr = chunkPtr = layoutPtr->chunks;
    numChars = 0;
    for (i = 0; i < layoutPtr->numChunks; i++) {
	baseline = chunkPtr->y;
	if (y < baseline + fontPtr->fm.descent) {
	    if (x < chunkPtr->x) {
		/*
		 * Point is to the left of all chunks on this line.  Return
		 * the index of the first character on this line.
		 */

		return numChars;
	    }
	    if (x >= layoutPtr->width) {
		/*
		 * If point lies off right side of the text layout, return
		 * the last char in the last chunk on this line.  Without
		 * this, it might return the index of the first char that
		 * was located outside of the text layout.
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916

1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933

1934
1935
1936
1937
1938
1939
1940

		    if (chunkPtr->numDisplayChars < 0) {
			/*
			 * This is a special chunk that encapsulates a single
			 * tab or newline char.
			 */

			return chunkPtr->start - layoutPtr->string;
		    }
		    n = Tk_MeasureChars((Tk_Font) fontPtr, chunkPtr->start,
			    chunkPtr->numChars, x + 1 - chunkPtr->x,
			    TK_PARTIAL_OK, &dummy);
		    return (chunkPtr->start + n - 1) - layoutPtr->string;
		}

		lastPtr = chunkPtr;
		chunkPtr++;
		i++;
	    }

	    /*
	     * Point is to the right of all chars in all the chunks on this
	     * line.  Return the index just past the last char in the last
	     * chunk on this line.
	     */

	    pos = (lastPtr->start + lastPtr->numChars) - layoutPtr->string;
	    if (i < layoutPtr->numChunks) {
		pos--;
	    }
	    return pos;
	}

	lastPtr = chunkPtr;
	chunkPtr++;
    }

    /*
     * Point lies below any line in this text layout.  Return the index
     * just past the last char.







|


|
|
|

>











|





>







2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363

		    if (chunkPtr->numDisplayChars < 0) {
			/*
			 * This is a special chunk that encapsulates a single
			 * tab or newline char.
			 */

			return numChars;
		    }
		    n = Tk_MeasureChars((Tk_Font) fontPtr, chunkPtr->start,
			    chunkPtr->numBytes, x - chunkPtr->x,
			    0, &dummy);
		    return numChars + Tcl_NumUtfChars(chunkPtr->start, n);
		}
		numChars += chunkPtr->numChars;
		lastPtr = chunkPtr;
		chunkPtr++;
		i++;
	    }

	    /*
	     * Point is to the right of all chars in all the chunks on this
	     * line.  Return the index just past the last char in the last
	     * chunk on this line.
	     */

	    pos = numChars;
	    if (i < layoutPtr->numChunks) {
		pos--;
	    }
	    return pos;
	}
	numChars += chunkPtr->numChars;
	lastPtr = chunkPtr;
	chunkPtr++;
    }

    /*
     * Point lies below any line in this text layout.  Return the index
     * just past the last char.
1993
1994
1995
1996
1997
1998
1999

2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017

2018
2019

2020
2021
2022
2023

2024
2025
2026
2027
2028
2029
2030
			     * index, if non-NULL. */
{
    TextLayout *layoutPtr;
    LayoutChunk *chunkPtr;
    int i, x, w;
    Tk_Font tkfont;
    TkFont *fontPtr;


    if (index < 0) {
	return 0;
    }

    layoutPtr = (TextLayout *) layout;
    chunkPtr = layoutPtr->chunks;
    tkfont = layoutPtr->tkfont;
    fontPtr = (TkFont *) tkfont;

    for (i = 0; i < layoutPtr->numChunks; i++) {
	if (chunkPtr->numDisplayChars < 0) {
	    if (index == 0) {
		x = chunkPtr->x;
		w = chunkPtr->totalWidth;
		goto check;
	    }
	} else if (index < chunkPtr->numChars) {

	    if (xPtr != NULL) {
		Tk_MeasureChars(tkfont, chunkPtr->start, index, 0, 0, &x);

		x += chunkPtr->x;
	    }
	    if (widthPtr != NULL) {
		Tk_MeasureChars(tkfont, chunkPtr->start + index, 1, 0, 0, &w);

	    }
	    goto check;
	}
	index -= chunkPtr->numChars;
	chunkPtr++;
    }
    if (index == 0) {







>


















>

|
>



|
>







2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
			     * index, if non-NULL. */
{
    TextLayout *layoutPtr;
    LayoutChunk *chunkPtr;
    int i, x, w;
    Tk_Font tkfont;
    TkFont *fontPtr;
    CONST char *end;

    if (index < 0) {
	return 0;
    }

    layoutPtr = (TextLayout *) layout;
    chunkPtr = layoutPtr->chunks;
    tkfont = layoutPtr->tkfont;
    fontPtr = (TkFont *) tkfont;

    for (i = 0; i < layoutPtr->numChunks; i++) {
	if (chunkPtr->numDisplayChars < 0) {
	    if (index == 0) {
		x = chunkPtr->x;
		w = chunkPtr->totalWidth;
		goto check;
	    }
	} else if (index < chunkPtr->numChars) {
	    end = Tcl_UtfAtIndex(chunkPtr->start, index);
	    if (xPtr != NULL) {
		Tk_MeasureChars(tkfont, chunkPtr->start,
			end -  chunkPtr->start, -1, 0, &x);
		x += chunkPtr->x;
	    }
	    if (widthPtr != NULL) {
		Tk_MeasureChars(tkfont, end, Tcl_UtfNext(end) - end,
			-1, 0, &w);
	    }
	    goto check;
	}
	index -= chunkPtr->numChars;
	chunkPtr++;
    }
    if (index == 0) {
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296


2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316

2317







2318
2319
2320
2321
2322
2323
2324
2325
 *	justified text on the screen is justified with screen metrics.
 *	The same string needs to be justified with printer metrics on
 *	the printer to appear in the correct place with respect to other
 *	similarly justified strings.  In all circumstances, y is the
 *	location of the baseline for the string.
 *
 * Results:
 *	Interp->result is modified to hold the Postscript code that
 *	will render the text layout.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void
Tk_TextLayoutToPostscript(interp, layout)
    Tcl_Interp *interp;		/* Filled with Postscript code. */
    Tk_TextLayout layout;	/* The layout to be rendered. */
{
#define MAXUSE 128
    char buf[MAXUSE+10];
    LayoutChunk *chunkPtr;
    int i, j, used, c, baseline;


    TextLayout *layoutPtr;

    layoutPtr = (TextLayout *) layout;
    chunkPtr = layoutPtr->chunks;
    baseline = chunkPtr->y;
    used = 0;
    buf[used++] = '(';
    for (i = 0; i < layoutPtr->numChunks; i++) {
	if (baseline != chunkPtr->y) {
	    buf[used++] = ')';
	    buf[used++] = '\n';
	    buf[used++] = '(';
	    baseline = chunkPtr->y;
	}
	if (chunkPtr->numDisplayChars <= 0) {
	    if (chunkPtr->start[0] == '\t') {
		buf[used++] = '\\';
		buf[used++] = 't';
	    }
	} else {

	    for (j = 0; j < chunkPtr->numDisplayChars; j++) {







		c = UCHAR(chunkPtr->start[j]);
		if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20)
			|| (c >= UCHAR(0x7f))) {
		    /*
		     * Tricky point:  the "03" is necessary in the sprintf
		     * below, so that a full three digits of octal are
		     * always generated.  Without the "03", a number
		     * following this sequence could be interpreted by







|

















>
>




















>

>
>
>
>
>
>
>
|







2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
 *	justified text on the screen is justified with screen metrics.
 *	The same string needs to be justified with printer metrics on
 *	the printer to appear in the correct place with respect to other
 *	similarly justified strings.  In all circumstances, y is the
 *	location of the baseline for the string.
 *
 * Results:
 *	The interp's result is modified to hold the Postscript code that
 *	will render the text layout.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void
Tk_TextLayoutToPostscript(interp, layout)
    Tcl_Interp *interp;		/* Filled with Postscript code. */
    Tk_TextLayout layout;	/* The layout to be rendered. */
{
#define MAXUSE 128
    char buf[MAXUSE+10];
    LayoutChunk *chunkPtr;
    int i, j, used, c, baseline;
    Tcl_UniChar ch;
    CONST char *p;
    TextLayout *layoutPtr;

    layoutPtr = (TextLayout *) layout;
    chunkPtr = layoutPtr->chunks;
    baseline = chunkPtr->y;
    used = 0;
    buf[used++] = '(';
    for (i = 0; i < layoutPtr->numChunks; i++) {
	if (baseline != chunkPtr->y) {
	    buf[used++] = ')';
	    buf[used++] = '\n';
	    buf[used++] = '(';
	    baseline = chunkPtr->y;
	}
	if (chunkPtr->numDisplayChars <= 0) {
	    if (chunkPtr->start[0] == '\t') {
		buf[used++] = '\\';
		buf[used++] = 't';
	    }
	} else {
	    p = chunkPtr->start;
	    for (j = 0; j < chunkPtr->numDisplayChars; j++) {
		/*
		 * INTL: For now we just treat the characters as binary
		 * data and display the lower byte.  Eventually this should
		 * be revised to handle international postscript fonts.
		 */

		p += Tcl_UtfToUniChar(p, &ch);
		c = UCHAR(ch & 0xff);
		if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20)
			|| (c >= UCHAR(0x7f))) {
		    /*
		     * Tricky point:  the "03" is necessary in the sprintf
		     * below, so that a full three digits of octal are
		     * always generated.  Without the "03", a number
		     * following this sequence could be interpreted by
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
    buf[used] = '\0';
    Tcl_AppendResult(interp, buf, (char *) NULL);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkInitFontAttributes --
 *
 *	Initialize the font attributes structure to contain sensible
 *	values.  This must be called before using any other font
 *	attributes functions.
 *
 * Results:
 *	None.
 *
 * Side effects.
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void
TkInitFontAttributes(faPtr)
    TkFontAttributes *faPtr;	/* The attributes structure to initialize. */
{
    faPtr->family	= NULL;
    faPtr->pointsize	= 0;
    faPtr->weight	= TK_FW_NORMAL;
    faPtr->slant	= TK_FS_ROMAN;
    faPtr->underline	= 0;
    faPtr->overstrike	= 0;
}

/*
 *---------------------------------------------------------------------------
 *
 * ConfigAttributesObj --
 *
 *	Process command line options to fill in fields of a properly
 *	initialized font attributes structure.
 *
 * Results:
 *	A standard Tcl return value.  If TCL_ERROR is returned, an







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







2792
2793
2794
2795
2796
2797
2798






























2799
2800
2801
2802
2803
2804
2805
    buf[used] = '\0';
    Tcl_AppendResult(interp, buf, (char *) NULL);
}

/*
 *---------------------------------------------------------------------------
 *






























 * ConfigAttributesObj --
 *
 *	Process command line options to fill in fields of a properly
 *	initialized font attributes structure.
 *
 * Results:
 *	A standard Tcl return value.  If TCL_ERROR is returned, an
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439














2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483

2484
2485
2486
2487
2488
2489
2490
    int objc;			/* Number of elements in argv. */
    Tcl_Obj *CONST objv[];	/* Command line options. */
    TkFontAttributes *faPtr;	/* Font attributes structure whose fields
				 * are to be modified.  Structure must already
				 * be properly initialized. */
{
    int i, n, index;
    Tcl_Obj *value;
    char *option, *string;
    
    if (objc & 1) {
	string = Tcl_GetStringFromObj(objv[objc - 1], NULL);
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "missing value for \"",
		string, "\" option", (char *) NULL);
	return TCL_ERROR;
    }

    for (i = 0; i < objc; i += 2) {
	option = Tcl_GetStringFromObj(objv[i], NULL);
	value = objv[i + 1];

	if (Tcl_GetIndexFromObj(interp, objv[i], fontOpt, "option", 1,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}














	switch (index) {
	    case FONT_FAMILY:
		string = Tcl_GetStringFromObj(value, NULL);
		faPtr->family = Tk_GetUid(string);
		break;

	    case FONT_SIZE:
		if (Tcl_GetIntFromObj(interp, value, &n) != TCL_OK) {
		    return TCL_ERROR;
		}
		faPtr->pointsize = n;
		break;

	    case FONT_WEIGHT:
		string = Tcl_GetStringFromObj(value, NULL);
		n = TkFindStateNum(interp, option, weightMap, string);
		if (n == TK_FW_UNKNOWN) {
		    return TCL_ERROR;
		}
		faPtr->weight = n;
		break;

	    case FONT_SLANT: 
		string = Tcl_GetStringFromObj(value, NULL);
		n = TkFindStateNum(interp, option, slantMap, string);
		if (n == TK_FS_UNKNOWN) {
		    return TCL_ERROR;
		}
		faPtr->slant = n;
		break;

	    case FONT_UNDERLINE:
		if (Tcl_GetBooleanFromObj(interp, value, &n) != TCL_OK) {
		    return TCL_ERROR;
		}
		faPtr->underline = n;
		break;

	    case FONT_OVERSTRIKE:
		if (Tcl_GetBooleanFromObj(interp, value, &n) != TCL_OK) {
		    return TCL_ERROR;
		}
		faPtr->overstrike = n;
		break;

	}
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------







|
|

<
<
<
<
<
<
<

|
|

|



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

|
|
|

|
|
|


|

|
|
<
|





|
|
<
|





|
|
|




|
|
|




>







2822
2823
2824
2825
2826
2827
2828
2829
2830
2831







2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867

2868
2869
2870
2871
2872
2873
2874
2875

2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
    int objc;			/* Number of elements in argv. */
    Tcl_Obj *CONST objv[];	/* Command line options. */
    TkFontAttributes *faPtr;	/* Font attributes structure whose fields
				 * are to be modified.  Structure must already
				 * be properly initialized. */
{
    int i, n, index;
    Tcl_Obj *optionPtr, *valuePtr;
    char *value;
    







    for (i = 0; i < objc; i += 2) {
	optionPtr = objv[i];
	valuePtr = objv[i + 1];

	if (Tcl_GetIndexFromObj(interp, optionPtr, fontOpt, "option", 1,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc & 1) {
	    /*
	     * This test occurs after Tcl_GetIndexFromObj() so that
	     * "font create xyz -xyz" will return the error message
	     * that "-xyz" is a bad option, rather than that the value
	     * for "-xyz" is missing.
	     */

	    Tcl_AppendResult(interp, "value for \"",
		    Tcl_GetString(optionPtr), "\" option missing",
		    (char *) NULL);
	    return TCL_ERROR;
	}

	switch (index) {
	    case FONT_FAMILY: {
		value = Tcl_GetString(valuePtr);
		faPtr->family = Tk_GetUid(value);
		break;
	    }
	    case FONT_SIZE: {
		if (Tcl_GetIntFromObj(interp, valuePtr, &n) != TCL_OK) {
		    return TCL_ERROR;
		}
		faPtr->size = n;
		break;
	    }
	    case FONT_WEIGHT: {

		n = TkFindStateNumObj(interp, optionPtr, weightMap, valuePtr);
		if (n == TK_FW_UNKNOWN) {
		    return TCL_ERROR;
		}
		faPtr->weight = n;
		break;
	    }
	    case FONT_SLANT: {

		n = TkFindStateNumObj(interp, optionPtr, slantMap, valuePtr);
		if (n == TK_FS_UNKNOWN) {
		    return TCL_ERROR;
		}
		faPtr->slant = n;
		break;
	    }
	    case FONT_UNDERLINE: {
		if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
		    return TCL_ERROR;
		}
		faPtr->underline = n;
		break;
	    }
	    case FONT_OVERSTRIKE: {
		if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
		    return TCL_ERROR;
		}
		faPtr->overstrike = n;
		break;
	    }
	}
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524


2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536

2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554

2555
2556
2557
2558

2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576

2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617

2618
2619
2620

2621
2622
2623
2624
2625
2626
2627
2628
2629



2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643

2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656



2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734






























































2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752




2753

2754

2755
2756
2757
2758
2759
2760
2761

2762






2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775

2776
2777
2778
2779
2780
2781
2782
2783
2784
2785



2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796

2797
2798
2799
2800
2801
2802
2803

static int
GetAttributeInfoObj(interp, faPtr, objPtr)
    Tcl_Interp *interp;		  	/* Interp to hold result. */
    CONST TkFontAttributes *faPtr;	/* The font attributes to inspect. */
    Tcl_Obj *objPtr;		  	/* If non-NULL, indicates the single
					 * option whose value is to be
					 * returned. Otherwise
					 * information is returned for
					 * all options. */
{
    int i, index, start, end, num;
    char *str;
    Tcl_Obj *newPtr;



    start = 0;
    end = FONT_NUMFIELDS;
    if (objPtr != NULL) {
	if (Tcl_GetIndexFromObj(interp, objPtr, fontOpt, "option", 1,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	start = index;
	end = index + 1;
    }


    for (i = start; i < end; i++) {
	str = NULL;
	num = 0;			/* Needed only to prevent compiler
					 * warning. */
	switch (i) {
	    case FONT_FAMILY:
		str = faPtr->family;
		if (str == NULL) {
		    str = "";
		}
		break;

	    case FONT_SIZE:
		num = faPtr->pointsize;
		break;

	    case FONT_WEIGHT:
		str = TkFindStateString(weightMap, faPtr->weight);

		break;
	
	    case FONT_SLANT:
		str = TkFindStateString(slantMap, faPtr->slant);

		break;

	    case FONT_UNDERLINE:
		num = faPtr->underline;
		break;

	    case FONT_OVERSTRIKE:
		num = faPtr->overstrike;
		break;
	}
	if (objPtr == NULL) {
	    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
		    Tcl_NewStringObj(fontOpt[i], -1));
	    if (str != NULL) {
		newPtr = Tcl_NewStringObj(str, -1);
	    } else {
		newPtr = Tcl_NewIntObj(num);
	    }

	    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
		    newPtr);
	} else {
	    if (str != NULL) {
		Tcl_SetStringObj(Tcl_GetObjResult(interp), str, -1);
	    } else {
		Tcl_SetIntObj(Tcl_GetObjResult(interp), num);
	    }
	}
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * ParseFontNameObj --
 *
 *	Converts a object into a set of font attributes that can be used
 *	to construct a font.
 *
 *	The string rep of the object can be one of the following forms:
 *		XLFD (see X documentation)
 *		"Family [size [style] [style ...]]"
 *		"-option value [-option value ...]"
 *
 * Results:
 *	The return value is TCL_ERROR if the object was syntactically
 *	invalid.  In that case an error message is left in interp's
 *	result object.  Otherwise, fills the font attribute buffer with
 *	the values parsed from the string and returns TCL_OK;
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
ParseFontNameObj(interp, tkwin, objPtr, faPtr)
    Tcl_Interp *interp;		/* Interp for error return. */

    Tk_Window tkwin;		/* For display on which font is used. */
    Tcl_Obj *objPtr;		/* Parseable font description object. */
    TkFontAttributes *faPtr;	/* Font attributes structure whose fields

				 * are to be modified.  Structure must already
				 * be properly initialized. */
{
    char *dash;
    int objc, result, i, n;
    Tcl_Obj **objv;
    TkXLFDAttributes xa;
    char *string;
    



    string = Tcl_GetStringFromObj(objPtr, NULL);
    if (*string == '-') {
	/*
	 * This may be an XLFD or an "-option value" string.
	 *
	 * If the string begins with "-*" or a "-foundry-family-*" pattern,
	 * then consider it an XLFD.  
	 */

	if (string[1] == '*') {
	    goto xlfd;
	}
	dash = strchr(string + 1, '-');
	if ((dash != NULL) && (!isspace(UCHAR(dash[-1])))) {

	    goto xlfd;
	}

	if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
	    return TCL_ERROR;
	}

	return ConfigAttributesObj(interp, tkwin, objc, objv, faPtr);
    }
    
    if (*string == '*') {
	/*
	 * This appears to be an XLFD.



	 */

	xlfd:
	xa.fa = *faPtr;
	result = TkParseXLFD(string, &xa);
	if (result == TCL_OK) {
	    *faPtr = xa.fa;
	    return result;
	}
    }

    /*
     * Wasn't an XLFD or "-option value" string.  Try it as a
     * "font size style" list.
     */

    if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
	return TCL_ERROR;
    }
    if (objc < 1) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "font \"", string,
		"\" doesn't exist", (char *) NULL);
	return TCL_ERROR;
    }

    faPtr->family = Tk_GetUid(Tcl_GetStringFromObj(objv[0], NULL));
    if (objc > 1) {
	if (Tcl_GetIntFromObj(interp, objv[1], &n) != TCL_OK) {
	    return TCL_ERROR;
	}
	faPtr->pointsize = n;
    }

    i = 2;
    if (objc == 3) {
	if (Tcl_ListObjGetElements(interp, objv[2], &objc, &objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	i = 0;
    }
    for ( ; i < objc; i++) {
	string = Tcl_GetStringFromObj(objv[i], NULL);
	n = TkFindStateNum(NULL, NULL, weightMap, string);
	if (n != TK_FW_UNKNOWN) {
	    faPtr->weight = n;
	    continue;
	}
	n = TkFindStateNum(NULL, NULL, slantMap, string);
	if (n != TK_FS_UNKNOWN) {
	    faPtr->slant = n;
	    continue;
	}
	n = TkFindStateNum(NULL, NULL, underlineMap, string);
	if (n != 0) {
	    faPtr->underline = n;
	    continue;
	}
	n = TkFindStateNum(NULL, NULL, overstrikeMap, string);
	if (n != 0) {
	    faPtr->overstrike = n;
	    continue;
	}

	/*
	 * Unknown style.
	 */

	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"unknown font style \"", string, "\"",
		(char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *






























































 * TkParseXLFD --
 *
 *	Break up a fully specified XLFD into a set of font attributes.
 *
 * Results:
 *	Return value is TCL_ERROR if string was not a fully specified XLFD.
 *	Otherwise, fills font attribute buffer with the values parsed
 *	from the XLFD and returns TCL_OK.  
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TkParseXLFD(string, xaPtr)
    CONST char *string;		/* Parseable font description string. */




    TkXLFDAttributes *xaPtr;	/* XLFD attributes structure whose fields

				 * are to be modified.  Structure must already

				 * be properly initialized. */
{
    char *src;
    CONST char *str;
    int i, j;
    char *field[XLFD_NUMFIELDS + 2];
    Tcl_DString ds;

    






    memset(field, '\0', sizeof(field));

    str = string;
    if (*str == '-') {
	str++;
    }

    Tcl_DStringInit(&ds);
    Tcl_DStringAppend(&ds, (char *) str, -1);
    src = Tcl_DStringValue(&ds);

    field[0] = src;
    for (i = 0; *src != '\0'; src++) {

	if (isupper(UCHAR(*src))) {
	    *src = tolower(UCHAR(*src));
	}
	if (*src == '-') {
	    i++;
	    if (i > XLFD_NUMFIELDS) {
		break;
	    }
	    *src = '\0';
	    field[i] = src + 1;



	}
    }

    /*
     * An XLFD of the form -adobe-times-medium-r-*-12-*-* is pretty common, 
     * but it is (strictly) malformed, because the first * is eliding both
     * the Setwidth and the Addstyle fields.  If the Addstyle field is a
     * number, then assume the above incorrect form was used and shift all
     * the rest of the fields up by one, so the number gets interpreted
     * as a pixelsize.  This fix is so that we don't get a million reports
     * that "it works under X, but gives a syntax error under Windows".

     */

    if ((i > XLFD_ADD_STYLE) && (FieldSpecified(field[XLFD_ADD_STYLE]))) {
	if (atoi(field[XLFD_ADD_STYLE]) != 0) {
	    for (j = XLFD_NUMFIELDS - 1; j >= XLFD_ADD_STYLE; j--) {
		field[j + 1] = field[j];
	    }







|
<
|

|

|
>
>




|







>

<
<
<



<
|
<



|




>




>



|



|


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














|
















|
>


|
>
|
|




|


>
>
>
|












|
>












|
>
>
>



<
|

<
|








|
<
<
|
|
|



|




|










<
|




|




|




|









<
|
|








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















|

>
>
>
>
|
>
|
>
|






>

>
>
>
>
>
>













>
|
|



|
|



>
>
>




|



|

|
>







2924
2925
2926
2927
2928
2929
2930
2931

2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952



2953
2954
2955

2956

2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982




2983
2984
2985
2986
2987







2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070

3071
3072

3073
3074
3075
3076
3077
3078
3079
3080
3081
3082


3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104

3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129

3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288

static int
GetAttributeInfoObj(interp, faPtr, objPtr)
    Tcl_Interp *interp;		  	/* Interp to hold result. */
    CONST TkFontAttributes *faPtr;	/* The font attributes to inspect. */
    Tcl_Obj *objPtr;		  	/* If non-NULL, indicates the single
					 * option whose value is to be
					 * returned. Otherwise information is

					 * returned for all options. */
{
    int i, index, start, end;
    char *str;
    Tcl_Obj *optionPtr, *valuePtr, *resultPtr;

    resultPtr = Tcl_GetObjResult(interp);

    start = 0;
    end = FONT_NUMFIELDS;
    if (objPtr != NULL) {
	if (Tcl_GetIndexFromObj(interp, objPtr, fontOpt, "option", TCL_EXACT,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	start = index;
	end = index + 1;
    }

    valuePtr = NULL;
    for (i = start; i < end; i++) {



	switch (i) {
	    case FONT_FAMILY:
		str = faPtr->family;

		valuePtr = Tcl_NewStringObj(str, ((str == NULL) ? 0 : -1));

		break;

	    case FONT_SIZE:
		valuePtr = Tcl_NewIntObj(faPtr->size);
		break;

	    case FONT_WEIGHT:
		str = TkFindStateString(weightMap, faPtr->weight);
		valuePtr = Tcl_NewStringObj(str, -1);
		break;
	
	    case FONT_SLANT:
		str = TkFindStateString(slantMap, faPtr->slant);
		valuePtr = Tcl_NewStringObj(str, -1);
		break;

	    case FONT_UNDERLINE:
		valuePtr = Tcl_NewBooleanObj(faPtr->underline);
		break;

	    case FONT_OVERSTRIKE:
		valuePtr = Tcl_NewBooleanObj(faPtr->overstrike);
		break;
	}
	if (objPtr != NULL) {
	    Tcl_SetObjResult(interp, valuePtr);




	    return TCL_OK;
	}
	optionPtr = Tcl_NewStringObj(fontOpt[i], -1);
	Tcl_ListObjAppendElement(NULL, resultPtr, optionPtr);
	Tcl_ListObjAppendElement(NULL, resultPtr, valuePtr);







    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * ParseFontNameObj --
 *
 *	Converts a object into a set of font attributes that can be used
 *	to construct a font.
 *
 *	The string rep of the object can be one of the following forms:
 *		XLFD (see X documentation)
 *		"family [size] [style1 [style2 ...]"
 *		"-option value [-option value ...]"
 *
 * Results:
 *	The return value is TCL_ERROR if the object was syntactically
 *	invalid.  In that case an error message is left in interp's
 *	result object.  Otherwise, fills the font attribute buffer with
 *	the values parsed from the string and returns TCL_OK;
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
ParseFontNameObj(interp, tkwin, objPtr, faPtr)
    Tcl_Interp *interp;		/* Interp for error return.  Must not be
				 * NULL. */
    Tk_Window tkwin;		/* For display on which font is used. */
    Tcl_Obj *objPtr;		/* Parseable font description object. */
    TkFontAttributes *faPtr;	/* Filled with attributes parsed from font
				 * name.  Any attributes that were not
				 * specified in font name are filled with
				 * default values. */
{
    char *dash;
    int objc, result, i, n;
    Tcl_Obj **objv;
    Tcl_Obj *resultPtr;
    char *string;
    
    TkInitFontAttributes(faPtr);
    resultPtr = Tcl_GetObjResult(interp);

    string = Tcl_GetString(objPtr);
    if (*string == '-') {
	/*
	 * This may be an XLFD or an "-option value" string.
	 *
	 * If the string begins with "-*" or a "-foundry-family-*" pattern,
	 * then consider it an XLFD.  
	 */

	if (string[1] == '*') {
	    goto xlfd;
	}
	dash = strchr(string + 1, '-');
	if ((dash != NULL)
		&& (!isspace(UCHAR(dash[-1])))) { /* INTL: ISO space */
	    goto xlfd;
	}

	if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
	    return TCL_ERROR;
	}

	return ConfigAttributesObj(interp, tkwin, objc, objv, faPtr);
    }
    
    if (*string == '*') {
	/*
	 * This is appears to be an XLFD.  Under Unix, all valid XLFDs were
	 * already handled by TkpGetNativeFont.  If we are here, either we
	 * have something that initially looks like an XLFD but isn't or we
	 * have encountered an XLFD on Windows or Mac.
	 */

	xlfd:

	result = TkFontParseXLFD(string, faPtr, NULL);
	if (result == TCL_OK) {

	    return TCL_OK;
	}
    }

    /*
     * Wasn't an XLFD or "-option value" string.  Try it as a
     * "font size style" list.
     */

    if ((Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv) != TCL_OK)


	    || (objc < 1)) {
	Tcl_AppendResult(interp, "font \"", string, "\" doesn't exist",
		(char *) NULL);
	return TCL_ERROR;
    }

    faPtr->family = Tk_GetUid(Tcl_GetString(objv[0]));
    if (objc > 1) {
	if (Tcl_GetIntFromObj(interp, objv[1], &n) != TCL_OK) {
	    return TCL_ERROR;
	}
	faPtr->size = n;
    }

    i = 2;
    if (objc == 3) {
	if (Tcl_ListObjGetElements(interp, objv[2], &objc, &objv) != TCL_OK) {
	    return TCL_ERROR;
	}
	i = 0;
    }
    for ( ; i < objc; i++) {

	n = TkFindStateNumObj(NULL, NULL, weightMap, objv[i]);
	if (n != TK_FW_UNKNOWN) {
	    faPtr->weight = n;
	    continue;
	}
	n = TkFindStateNumObj(NULL, NULL, slantMap, objv[i]);
	if (n != TK_FS_UNKNOWN) {
	    faPtr->slant = n;
	    continue;
	}
	n = TkFindStateNumObj(NULL, NULL, underlineMap, objv[i]);
	if (n != 0) {
	    faPtr->underline = n;
	    continue;
	}
	n = TkFindStateNumObj(NULL, NULL, overstrikeMap, objv[i]);
	if (n != 0) {
	    faPtr->overstrike = n;
	    continue;
	}

	/*
	 * Unknown style.
	 */


	Tcl_AppendResult(interp, "unknown font style \"",
		Tcl_GetString(objv[i]), "\"", (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * NewChunk --
 *
 *	Helper function for Tk_ComputeTextLayout().  Encapsulates a
 *	measured set of characters in a chunk that can be quickly
 *	drawn.
 *
 * Results:
 *	A pointer to the new chunk in the text layout.
 *
 * Side effects:
 *	The text layout is reallocated to hold more chunks as necessary.
 *
 *	Currently, Tk_ComputeTextLayout() stores contiguous ranges of
 *	"normal" characters in a chunk, along with individual tab
 *	and newline chars in their own chunks.  All characters in the
 *	text layout are accounted for.
 *
 *---------------------------------------------------------------------------
 */
static LayoutChunk *
NewChunk(layoutPtrPtr, maxPtr, start, numBytes, curX, newX, y)
    TextLayout **layoutPtrPtr;
    int *maxPtr;
    CONST char *start;
    int numBytes;
    int curX;
    int newX;
    int y;
{
    TextLayout *layoutPtr;
    LayoutChunk *chunkPtr;
    int maxChunks, numChars;
    size_t s;
    
    layoutPtr = *layoutPtrPtr;
    maxChunks = *maxPtr;
    if (layoutPtr->numChunks == maxChunks) {
	maxChunks *= 2;
	s = sizeof(TextLayout) + ((maxChunks - 1) * sizeof(LayoutChunk));
	layoutPtr = (TextLayout *) ckrealloc((char *) layoutPtr, s);

	*layoutPtrPtr = layoutPtr;
	*maxPtr = maxChunks;
    }
    numChars = Tcl_NumUtfChars(start, numBytes);
    chunkPtr = &layoutPtr->chunks[layoutPtr->numChunks];
    chunkPtr->start		= start;
    chunkPtr->numBytes		= numBytes;
    chunkPtr->numChars		= numChars;
    chunkPtr->numDisplayChars	= numChars;
    chunkPtr->x			= curX;
    chunkPtr->y			= y;
    chunkPtr->totalWidth	= newX - curX;
    chunkPtr->displayWidth	= newX - curX;
    layoutPtr->numChunks++;

    return chunkPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkFontParseXLFD --
 *
 *	Break up a fully specified XLFD into a set of font attributes.
 *
 * Results:
 *	Return value is TCL_ERROR if string was not a fully specified XLFD.
 *	Otherwise, fills font attribute buffer with the values parsed
 *	from the XLFD and returns TCL_OK.  
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TkFontParseXLFD(string, faPtr, xaPtr)
    CONST char *string;		/* Parseable font description string. */
    TkFontAttributes *faPtr;	/* Filled with attributes parsed from font
				 * name.  Any attributes that were not
				 * specified in font name are filled with
				 * default values. */
    TkXLFDAttributes *xaPtr;	/* Filled with X-specific attributes parsed
				 * from font name.  Any attributes that were
				 * not specified in font name are filled with
				 * default values.  May be NULL if such
				 * information is not desired. */
{
    char *src;
    CONST char *str;
    int i, j;
    char *field[XLFD_NUMFIELDS + 2];
    Tcl_DString ds;
    TkXLFDAttributes xa;
    
    if (xaPtr == NULL) {
	xaPtr = &xa;
    }
    TkInitFontAttributes(faPtr);
    TkInitXLFDAttributes(xaPtr);

    memset(field, '\0', sizeof(field));

    str = string;
    if (*str == '-') {
	str++;
    }

    Tcl_DStringInit(&ds);
    Tcl_DStringAppend(&ds, (char *) str, -1);
    src = Tcl_DStringValue(&ds);

    field[0] = src;
    for (i = 0; *src != '\0'; src++) {
	if (!(*src & 0x90)
		&& isupper(UCHAR(*src))) { /* INTL: 7-bit ISO only. */
	    *src = tolower(UCHAR(*src)); /* INTL: 7-bit ISO only. */
	}
	if (*src == '-') {
	    i++;
	    if (i == XLFD_NUMFIELDS) {
		continue;
	    }
	    *src = '\0';
	    field[i] = src + 1;
	    if (i > XLFD_NUMFIELDS) {
		break;
	    }
	}
    }

    /*
     * An XLFD of the form -adobe-times-medium-r-*-12-*-* is pretty common,
     * but it is (strictly) malformed, because the first * is eliding both
     * the Setwidth and the Addstyle fields.  If the Addstyle field is a
     * number, then assume the above incorrect form was used and shift all
     * the rest of the fields right by one, so the number gets interpreted
     * as a pixelsize.  This fix is so that we don't get a million reports
     * that "it works under X (as a native font name), but gives a syntax
     * error under Windows (as a parsed set of attributes)".
     */

    if ((i > XLFD_ADD_STYLE) && (FieldSpecified(field[XLFD_ADD_STYLE]))) {
	if (atoi(field[XLFD_ADD_STYLE]) != 0) {
	    for (j = XLFD_NUMFIELDS - 1; j >= XLFD_ADD_STYLE; j--) {
		field[j + 1] = field[j];
	    }
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846

2847


2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
    }

    if (FieldSpecified(field[XLFD_FOUNDRY])) {
	xaPtr->foundry = Tk_GetUid(field[XLFD_FOUNDRY]);
    }

    if (FieldSpecified(field[XLFD_FAMILY])) {
	xaPtr->fa.family = Tk_GetUid(field[XLFD_FAMILY]);
    }
    if (FieldSpecified(field[XLFD_WEIGHT])) {
	xaPtr->fa.weight = TkFindStateNum(NULL, NULL, xlfdWeightMap,
		field[XLFD_WEIGHT]);
    }
    if (FieldSpecified(field[XLFD_SLANT])) {
	xaPtr->slant = TkFindStateNum(NULL, NULL, xlfdSlantMap,
		field[XLFD_SLANT]);
	if (xaPtr->slant == TK_FS_ROMAN) {
	    xaPtr->fa.slant = TK_FS_ROMAN;
	} else {
	    xaPtr->fa.slant = TK_FS_ITALIC;
	}
    }
    if (FieldSpecified(field[XLFD_SETWIDTH])) {
	xaPtr->setwidth = TkFindStateNum(NULL, NULL, xlfdSetwidthMap,
		field[XLFD_SETWIDTH]);
    }

    /* XLFD_ADD_STYLE ignored. */

    /*
     * Pointsize in tenths of a point, but treat it as tenths of a pixel.

     */



    if (FieldSpecified(field[XLFD_POINT_SIZE])) {
	if (field[XLFD_POINT_SIZE][0] == '[') {
	    /*
	     * Some X fonts have the point size specified as follows:
	     *
	     *	    [ N1 N2 N3 N4 ]
	     *
	     * where N1 is the point size (in points, not decipoints!), and
	     * N2, N3, and N4 are some additional numbers that I don't know
	     * the purpose of, so I ignore them.
	     */

	    xaPtr->fa.pointsize = atoi(field[XLFD_POINT_SIZE] + 1);
	} else if (Tcl_GetInt(NULL, field[XLFD_POINT_SIZE],
		&xaPtr->fa.pointsize) == TCL_OK) {
	    xaPtr->fa.pointsize /= 10;
	} else {
	    return TCL_ERROR;
	}
    }

    /*
     * Pixel height of font.  If specified, overrides pointsize.







|


|






|

|










|
>

>
>













|

|
|







3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
    }

    if (FieldSpecified(field[XLFD_FOUNDRY])) {
	xaPtr->foundry = Tk_GetUid(field[XLFD_FOUNDRY]);
    }

    if (FieldSpecified(field[XLFD_FAMILY])) {
	faPtr->family = Tk_GetUid(field[XLFD_FAMILY]);
    }
    if (FieldSpecified(field[XLFD_WEIGHT])) {
	faPtr->weight = TkFindStateNum(NULL, NULL, xlfdWeightMap,
		field[XLFD_WEIGHT]);
    }
    if (FieldSpecified(field[XLFD_SLANT])) {
	xaPtr->slant = TkFindStateNum(NULL, NULL, xlfdSlantMap,
		field[XLFD_SLANT]);
	if (xaPtr->slant == TK_FS_ROMAN) {
	    faPtr->slant = TK_FS_ROMAN;
	} else {
	    faPtr->slant = TK_FS_ITALIC;
	}
    }
    if (FieldSpecified(field[XLFD_SETWIDTH])) {
	xaPtr->setwidth = TkFindStateNum(NULL, NULL, xlfdSetwidthMap,
		field[XLFD_SETWIDTH]);
    }

    /* XLFD_ADD_STYLE ignored. */

    /*
     * Pointsize in tenths of a point, but treat it as tenths of a pixel
     * for historical compatibility.
     */

    faPtr->size = 12;

    if (FieldSpecified(field[XLFD_POINT_SIZE])) {
	if (field[XLFD_POINT_SIZE][0] == '[') {
	    /*
	     * Some X fonts have the point size specified as follows:
	     *
	     *	    [ N1 N2 N3 N4 ]
	     *
	     * where N1 is the point size (in points, not decipoints!), and
	     * N2, N3, and N4 are some additional numbers that I don't know
	     * the purpose of, so I ignore them.
	     */

	    faPtr->size = atoi(field[XLFD_POINT_SIZE] + 1);
	} else if (Tcl_GetInt(NULL, field[XLFD_POINT_SIZE],
		&faPtr->size) == TCL_OK) {
	    faPtr->size /= 10;
	} else {
	    return TCL_ERROR;
	}
    }

    /*
     * Pixel height of font.  If specified, overrides pointsize.
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
	     *	    [ N1 N2 N3 N4 ]
	     *
	     * where N1 is the pixel size, and where N2, N3, and N4 
	     * are some additional numbers that I don't know
	     * the purpose of, so I ignore them.
	     */

	    xaPtr->fa.pointsize = atoi(field[XLFD_PIXEL_SIZE] + 1);
	} else if (Tcl_GetInt(NULL, field[XLFD_PIXEL_SIZE],
		&xaPtr->fa.pointsize) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    xaPtr->fa.pointsize = -xaPtr->fa.pointsize;

    /* XLFD_RESOLUTION_X ignored. */

    /* XLFD_RESOLUTION_Y ignored. */

    /* XLFD_SPACING ignored. */

    /* XLFD_AVERAGE_WIDTH ignored. */

    if (FieldSpecified(field[XLFD_REGISTRY])) {
	xaPtr->charset = TkFindStateNum(NULL, NULL, xlfdCharsetMap,
		field[XLFD_REGISTRY]);
    }
    if (FieldSpecified(field[XLFD_ENCODING])) {
	xaPtr->encoding = atoi(field[XLFD_ENCODING]);
    }

    Tcl_DStringFree(&ds);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *







|

|




|









|
|
<
|
<
|

<







3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392

3393

3394
3395

3396
3397
3398
3399
3400
3401
3402
	     *	    [ N1 N2 N3 N4 ]
	     *
	     * where N1 is the pixel size, and where N2, N3, and N4 
	     * are some additional numbers that I don't know
	     * the purpose of, so I ignore them.
	     */

	    faPtr->size = atoi(field[XLFD_PIXEL_SIZE] + 1);
	} else if (Tcl_GetInt(NULL, field[XLFD_PIXEL_SIZE],
		&faPtr->size) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    faPtr->size = -faPtr->size;

    /* XLFD_RESOLUTION_X ignored. */

    /* XLFD_RESOLUTION_Y ignored. */

    /* XLFD_SPACING ignored. */

    /* XLFD_AVERAGE_WIDTH ignored. */

    if (FieldSpecified(field[XLFD_CHARSET])) {
	xaPtr->charset = Tk_GetUid(field[XLFD_CHARSET]);

    } else {

	xaPtr->charset = Tk_GetUid("iso8859-1");
    }

    Tcl_DStringFree(&ds);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962

2963


2964






2965



2966





2967













2968
2969
2970
2971
2972
2973
2974


2975


2976

2977

2978



2979

2980


















2981
2982



2983
2984




2985




2986



2987













2988
2989




2990
2991









2992








2993
2994



2995
2996
















2997
2998
2999


3000

3001
3002
3003
3004




3005













3006









3007







3008











    ch = field[0];
    return (ch != '*' && ch != '?');
}

/*
 *---------------------------------------------------------------------------
 *
 * NewChunk --
 *
 *	Helper function for Tk_ComputeTextLayout().  Encapsulates a
 *	measured set of characters in a chunk that can be quickly
 *	drawn.
 *
 * Results:
 *	A pointer to the new chunk in the text layout.
 *
 * Side effects:
 *	The text layout is reallocated to hold more chunks as necessary.

 *


 *	Currently, Tk_ComputeTextLayout() stores contiguous ranges of






 *	"normal" characters in a chunk, along with individual tab



 *	and newline chars in their own chunks.  All characters in the





 *	text layout are accounted for.













 *
 *---------------------------------------------------------------------------
 */
static LayoutChunk *
NewChunk(layoutPtrPtr, maxPtr, start, numChars, curX, newX, y)
    TextLayout **layoutPtrPtr;
    int *maxPtr;


    CONST char *start;


    int numChars;

    int curX;

    int newX;



    int y;

{


















    TextLayout *layoutPtr;
    LayoutChunk *chunkPtr;



    int maxChunks;
    size_t s;




    




    layoutPtr = *layoutPtrPtr;



    maxChunks = *maxPtr;













    if (layoutPtr->numChunks == maxChunks) {
	maxChunks *= 2;




	s = sizeof(TextLayout) + ((maxChunks - 1) * sizeof(LayoutChunk));
	layoutPtr = (TextLayout *) ckrealloc((char *) layoutPtr, s);


















	*layoutPtrPtr = layoutPtr;
	*maxPtr = maxChunks;



    }
    chunkPtr = &layoutPtr->chunks[layoutPtr->numChunks];
















    chunkPtr->start		= start;
    chunkPtr->numChars		= numChars;
    chunkPtr->numDisplayChars	= numChars;


    chunkPtr->x			= curX;

    chunkPtr->y			= y;
    chunkPtr->totalWidth	= newX - curX;
    chunkPtr->displayWidth	= newX - curX;
    layoutPtr->numChunks++;


















    return chunkPtr;









}


























|

|
|
<


|


<
>

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



|
<
<
|
>
>
|
>
>
|
>
|
>
|
>
>
>
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
>
|
|
>
>
>
>
|
>
>
>
>
|
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
|
<
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
|
|
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
<
>
>
|
>
|
<
<
<
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440

3441
3442
3443
3444
3445

3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484


3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560

3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603

3604
3605
3606
3607
3608



3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
    ch = field[0];
    return (ch != '*' && ch != '?');
}

/*
 *---------------------------------------------------------------------------
 *
 * TkFontGetPixels --
 *
 *	Given a font size specification (as described in the TkFontAttributes
 *	structure) return the number of pixels it represents.

 *
 * Results:
 *	As above.
 *
 * Side effects:

 *	None.
 *
 *---------------------------------------------------------------------------
 */
 
int
TkFontGetPixels(tkwin, size)
    Tk_Window tkwin;		/* For point->pixel conversion factor. */
    int size;			/* Font size. */
{
    double d;

    if (size < 0) {
	return -size;
    }

    d = size * 25.4 / 72.0;
    d *= WidthOfScreen(Tk_Screen(tkwin));
    d /= WidthMMOfScreen(Tk_Screen(tkwin));
    return (int) (d + 0.5);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkFontGetPoints --
 *
 *	Given a font size specification (as described in the TkFontAttributes
 *	structure) return the number of points it represents.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
 


int
TkFontGetPoints(tkwin, size)
    Tk_Window tkwin;		/* For pixel->point conversion factor. */
    int size;			/* Font size. */
{
    double d;

    if (size >= 0) {
	return size;
    }

    d = -size * 72.0 / 25.4;
    d *= WidthMMOfScreen(Tk_Screen(tkwin));
    d /= WidthOfScreen(Tk_Screen(tkwin));
    return (int) (d + 0.5);
}

/*
 *-------------------------------------------------------------------------
 *
 * TkFontGetAliasList --
 *
 *	Given a font name, find the list of all aliases for that font
 *	name.  One of the names in this list will probably be the name
 *	that this platform expects when asking for the font.
 *
 * Results:
 *	As above.  The return value is NULL if the font name has no 
 *	aliases.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */
	
char **
TkFontGetAliasList(faceName)
    CONST char *faceName;	/* Font name to test for aliases. */
{   
    int i, j;

    for (i = 0; fontAliases[i] != NULL; i++) {
	for (j = 0; fontAliases[i][j] != NULL; j++) {
	    if (strcasecmp(faceName, fontAliases[i][j]) == 0) {
		return fontAliases[i];
	    }
	}
    }
    return NULL;
}

/*
 *-------------------------------------------------------------------------
 *
 * TkFontGetFallbacks --
 *
 *	Get the list of font fallbacks that the platform-specific code
 *	can use to try to find the closest matching font the name 
 *	requested.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */
	
char ***
TkFontGetFallbacks()
{
    return fontFallbacks;
}


/*
 *-------------------------------------------------------------------------
 *
 * TkFontGetGlobalClass --
 *
 *	Get the list of fonts to try if the requested font name does not
 *	exist and no fallbacks for that font name could be used either.
 *	The names in this list are considered preferred over all the other
 *	font names in the system when looking for a last-ditch fallback.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */
	
char **
TkFontGetGlobalClass()
{
    return globalFontClass;
}

/*
 *-------------------------------------------------------------------------
 *
 * TkFontGetSymbolClass --
 *
 *	Get the list of fonts that are symbolic; used if the operating 
 *	system cannot apriori identify symbolic fonts on its own.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */
	
char **

TkFontGetSymbolClass()
{
    return symbolClass;
}




/*
 *----------------------------------------------------------------------
 *
 * TkDebugFont --
 *
 *	This procedure returns debugging information about a font.
 *
 * Results:
 *	The return value is a list with one sublist for each TkFont
 *	corresponding to "name".  Each sublist has two elements that
 *	contain the resourceRefCount and objRefCount fields from the
 *	TkFont structure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TkDebugFont(tkwin, name)
    Tk_Window tkwin;		/* The window in which the font will be
				 * used (not currently used). */
    char *name;			/* Name of the desired color. */
{
    TkFont *fontPtr;
    Tcl_HashEntry *hashPtr;
    Tcl_Obj *resultPtr, *objPtr;

    resultPtr = Tcl_NewObj();
    hashPtr = Tcl_FindHashEntry(
	    &((TkWindow *) tkwin)->mainPtr->fontInfoPtr->fontCache, name);
    if (hashPtr != NULL) {
	fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr);
	if (fontPtr == NULL) {
	    panic("TkDebugFont found empty hash table entry");
	}
	for ( ; (fontPtr != NULL); fontPtr = fontPtr->nextPtr) {
	    objPtr = Tcl_NewObj();
	    Tcl_ListObjAppendElement(NULL, objPtr,
		    Tcl_NewIntObj(fontPtr->resourceRefCount));
	    Tcl_ListObjAppendElement(NULL, objPtr,
		    Tcl_NewIntObj(fontPtr->objRefCount)); 
	    Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
	}
    }
    return resultPtr;
}

Changes to generic/tkFont.h.

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
/*
 * tkFont.h --
 *
 *	Declarations for interfaces between the generic and platform-
 *	specific parts of the font package.  This information is not
 *	visible outside of the font package.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkFont.h 1.11 97/05/07 14:44:13
 */

#ifndef _TKFONT
#define _TKFONT






/*
 * The following structure keeps track of the attributes of a font.  It can
 * be used to keep track of either the desired attributes or the actual
 * attributes gotten when the font was instantiated.
 */

typedef struct TkFontAttributes {
    Tk_Uid family;		/* Font family. The most important field. */

    int pointsize;		/* Pointsize of font, 0 for default size, or
				 * negative number meaning pixel size. */
    int weight;			/* Weight flag; see below for def'n. */
    int slant;			/* Slant flag; see below for def'n. */
    int underline;		/* Non-zero for underline font. */
    int overstrike;		/* Non-zero for overstrike font. */
} TkFontAttributes;








|




|




>
>
>
>
>








|
>
|







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
/*
 * tkFont.h --
 *
 *	Declarations for interfaces between the generic and platform-
 *	specific parts of the font package.  This information is not
 *	visible outside of the font package.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkFont.h,v 1.1.4.2 1998/09/30 02:16:58 stanton Exp $
 */

#ifndef _TKFONT
#define _TKFONT

#ifdef BUILD_tk
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * The following structure keeps track of the attributes of a font.  It can
 * be used to keep track of either the desired attributes or the actual
 * attributes gotten when the font was instantiated.
 */

typedef struct TkFontAttributes {
    Tk_Uid family;		/* Font family, or NULL to represent
				 * plaform-specific default system font. */
    int size;			/* Pointsize of font, 0 for default size, or
				 * negative number meaning pixel size. */
    int weight;			/* Weight flag; see below for def'n. */
    int slant;			/* Slant flag; see below for def'n. */
    int underline;		/* Non-zero for underline font. */
    int overstrike;		/* Non-zero for overstrike font. */
} TkFontAttributes;

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
 */

typedef struct TkFont {
    /*
     * Fields used and maintained exclusively by generic code.
     */

    int refCount;		/* Number of users of the TkFont. */











    Tcl_HashEntry *cacheHashPtr;/* Entry in font cache for this structure,
				 * used when deleting it. */
    Tcl_HashEntry *namedHashPtr;/* Pointer to hash table entry that
				 * corresponds to the named font that the
				 * tkfont was based on, or NULL if the tkfont
				 * was not based on a named font. */

    int tabWidth;		/* Width of tabs in this font (pixels). */
    int	underlinePos;		/* Offset from baseline to origin of
				 * underline bar (used for drawing underlines
				 * on a non-underlined font). */
    int underlineHeight;	/* Height of underline bar (used for drawing
				 * underlines on a non-underlined font). */

    /*
     * Fields in the generic font structure that are filled in by
     * platform-specific code.
     */

    Font fid;			/* For backwards compatibility with XGCValues
				 * structures.  Remove when TkGCValues is
				 * implemented.  */
    TkFontAttributes fa;	/* Actual font attributes obtained when the
				 * the font was created, as opposed to the
				 * desired attributes passed in to
				 * TkpGetFontFromAttributes().  The desired
				 * metrics can be determined from the string
				 * that was used to create this font. */
    TkFontMetrics fm;		/* Font metrics determined when font was
				 * created. */





} TkFont;

/*
 * The following structure is used to return attributes when parsing an
 * XLFD.  The extra information is of interest to the Unix-specific code
 * when attempting to find the closest matching font.
 */

typedef struct TkXLFDAttributes {
    TkFontAttributes fa;	/* Standard set of font attributes. */
    Tk_Uid foundry;		/* The foundry of the font. */
    int slant;			/* The tristate value for the slant, which
				 * is significant under X. */
    int setwidth;		/* The proportionate width, see below for
				 * definition. */
    int charset;		/* The character set encoding (the glyph
				 * family), see below for definition. */
    int encoding;		/* Variations within a charset for the
				 * glyphs above character 127. */
} TkXLFDAttributes;

/*
 * Possible values for the "setwidth" field in a TkXLFDAttributes structure.
 * The setwidth is whether characters are considered wider or narrower than
 * normal.
 */

#define TK_SW_NORMAL	0
#define TK_SW_CONDENSE	1
#define TK_SW_EXPAND	2
#define TK_SW_UNKNOWN	3	/* Unknown setwidth.  This value may be
				 * stored in the setwidth field. */

/*
 * Possible values for the "charset" field in a TkXLFDAttributes structure.
 * The charset is the set of glyphs that are used in the font.
 */

#define TK_CS_NORMAL	0
#define TK_CS_SYMBOL	1
#define TK_CS_OTHER	2

/*
 * The following defines specify the meaning of the fields in a fully
 * qualified XLFD.
 */

#define XLFD_FOUNDRY	    0
#define XLFD_FAMILY	    1
#define XLFD_WEIGHT	    2
#define XLFD_SLANT	    3
#define XLFD_SETWIDTH	    4
#define XLFD_ADD_STYLE	    5
#define XLFD_PIXEL_SIZE	    6
#define XLFD_POINT_SIZE	    7
#define XLFD_RESOLUTION_X   8
#define XLFD_RESOLUTION_Y   9
#define XLFD_SPACING	    10
#define XLFD_AVERAGE_WIDTH  11
#define XLFD_REGISTRY	    12
#define XLFD_ENCODING	    13
#define XLFD_NUMFIELDS	    14	/* Number of fields in XLFD. */

/*
 * Exported from generic code to platform-specific code.
 */



EXTERN int		TkCreateNamedFont _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, CONST char *name,
			    TkFontAttributes *faPtr));

EXTERN void		TkInitFontAttributes _ANSI_ARGS_((
			    TkFontAttributes *faPtr));

EXTERN int		TkParseXLFD _ANSI_ARGS_((CONST char *string, 
			    TkXLFDAttributes *xaPtr));



/*
 * Common APIs exported to tkFont.c from all platform-specific
 * implementations. 
 */

EXTERN void		TkpDeleteFont _ANSI_ARGS_((TkFont *tkFontPtr));

EXTERN TkFont *		TkpGetFontFromAttributes _ANSI_ARGS_((
			    TkFont *tkFontPtr, Tk_Window tkwin,
			    CONST TkFontAttributes *faPtr));
EXTERN void		TkpGetFontFamilies _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin));
EXTERN TkFont *		TkpGetNativeFont _ANSI_ARGS_((Tk_Window tkwin,
			    CONST char *name));




#endif	/* _TKFONT */







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






>








|














>
>
>
>
>









<





|
<
<
<














<
<
<
<
<
<
<
<
<

















|
<
|


|


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


|
<



>








>
>
>

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150

151
152
153
154
155
156



157
158
159
160
161
162
163
164
165
166
167
168
169
170









171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188

189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210

211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
 */

typedef struct TkFont {
    /*
     * Fields used and maintained exclusively by generic code.
     */

    int resourceRefCount;	/* Number of active uses of this font (each
				 * active use corresponds to a call to
				 * Tk_AllocFontFromTable or Tk_GetFont).
				 * If this count is 0, then this TkFont
				 * structure is no longer valid and it isn't
				 * present in a hash table: it is being
				 * kept around only because there are objects
				 * referring to it.  The structure is freed
				 * when resourceRefCount and objRefCount
				 * are both 0. */
    int objRefCount;		/* The number of Tcl objects that reference
				 * this structure. */
    Tcl_HashEntry *cacheHashPtr;/* Entry in font cache for this structure,
				 * used when deleting it. */
    Tcl_HashEntry *namedHashPtr;/* Pointer to hash table entry that
				 * corresponds to the named font that the
				 * tkfont was based on, or NULL if the tkfont
				 * was not based on a named font. */
    Screen *screen;		/* The screen where this font is valid. */
    int tabWidth;		/* Width of tabs in this font (pixels). */
    int	underlinePos;		/* Offset from baseline to origin of
				 * underline bar (used for drawing underlines
				 * on a non-underlined font). */
    int underlineHeight;	/* Height of underline bar (used for drawing
				 * underlines on a non-underlined font). */

    /*
     * Fields used in the generic code that are filled in by
     * platform-specific code.
     */

    Font fid;			/* For backwards compatibility with XGCValues
				 * structures.  Remove when TkGCValues is
				 * implemented.  */
    TkFontAttributes fa;	/* Actual font attributes obtained when the
				 * the font was created, as opposed to the
				 * desired attributes passed in to
				 * TkpGetFontFromAttributes().  The desired
				 * metrics can be determined from the string
				 * that was used to create this font. */
    TkFontMetrics fm;		/* Font metrics determined when font was
				 * created. */
    struct TkFont *nextPtr;	/* Points to the next TkFont structure with
				 * the same name.  All fonts with the
				 * same name (but different displays) are
				 * chained together off a single entry in
				 * a hash table. */
} TkFont;

/*
 * The following structure is used to return attributes when parsing an
 * XLFD.  The extra information is of interest to the Unix-specific code
 * when attempting to find the closest matching font.
 */

typedef struct TkXLFDAttributes {

    Tk_Uid foundry;		/* The foundry of the font. */
    int slant;			/* The tristate value for the slant, which
				 * is significant under X. */
    int setwidth;		/* The proportionate width, see below for
				 * definition. */
    Tk_Uid charset;		/* The actual charset string. */



} TkXLFDAttributes;

/*
 * Possible values for the "setwidth" field in a TkXLFDAttributes structure.
 * The setwidth is whether characters are considered wider or narrower than
 * normal.
 */

#define TK_SW_NORMAL	0
#define TK_SW_CONDENSE	1
#define TK_SW_EXPAND	2
#define TK_SW_UNKNOWN	3	/* Unknown setwidth.  This value may be
				 * stored in the setwidth field. */










/*
 * The following defines specify the meaning of the fields in a fully
 * qualified XLFD.
 */

#define XLFD_FOUNDRY	    0
#define XLFD_FAMILY	    1
#define XLFD_WEIGHT	    2
#define XLFD_SLANT	    3
#define XLFD_SETWIDTH	    4
#define XLFD_ADD_STYLE	    5
#define XLFD_PIXEL_SIZE	    6
#define XLFD_POINT_SIZE	    7
#define XLFD_RESOLUTION_X   8
#define XLFD_RESOLUTION_Y   9
#define XLFD_SPACING	    10
#define XLFD_AVERAGE_WIDTH  11
#define XLFD_CHARSET	    12

#define XLFD_NUMFIELDS	    13	/* Number of fields in XLFD. */

/*
 * Low-level API exported by generic code to platform-specific code.
 */

#define TkInitFontAttributes(fa)   memset((fa), 0, sizeof(TkFontAttributes));
#define TkInitXLFDAttributes(xa)   memset((xa), 0, sizeof(TkXLFDAttributes));

EXTERN int		TkFontParseXLFD _ANSI_ARGS_((CONST char *string,
			    TkFontAttributes *faPtr, TkXLFDAttributes *xaPtr));
EXTERN char **		TkFontGetAliasList _ANSI_ARGS_((CONST char *faceName));
EXTERN char ***		TkFontGetFallbacks _ANSI_ARGS_((void));
EXTERN int		TkFontGetPixels _ANSI_ARGS_((Tk_Window tkwin, 
			    int size));
EXTERN int		TkFontGetPoints _ANSI_ARGS_((Tk_Window tkwin, 
			    int size));
EXTERN char **		TkFontGetGlobalClass _ANSI_ARGS_((void));
EXTERN char **		TkFontGetSymbolClass _ANSI_ARGS_((void));

/*
 * Low-level API exported by platform-specific code to generic code. 

 */

EXTERN void		TkpDeleteFont _ANSI_ARGS_((TkFont *tkFontPtr));
EXTERN void		TkpFontPkgInit _ANSI_ARGS_((TkMainInfo *mainPtr));
EXTERN TkFont *		TkpGetFontFromAttributes _ANSI_ARGS_((
			    TkFont *tkFontPtr, Tk_Window tkwin,
			    CONST TkFontAttributes *faPtr));
EXTERN void		TkpGetFontFamilies _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin));
EXTERN TkFont *		TkpGetNativeFont _ANSI_ARGS_((Tk_Window tkwin,
			    CONST char *name));

# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT

#endif	/* _TKFONT */

Changes to generic/tkFrame.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
/* 
 * tkFrame.c --
 *
 *	This module implements "frame"  and "toplevel" widgets for
 *	the Tk toolkit.  Frames are windows with a background color
 *	and possibly a 3-D effect, but not much else in the way of
 *	attributes.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkFrame.c 1.82 97/08/08 17:26:26
 */

#include "default.h"
#include "tkPort.h"
#include "tkInt.h"

/*









|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
/* 
 * tkFrame.c --
 *
 *	This module implements "frame"  and "toplevel" widgets for
 *	the Tk toolkit.  Frames are windows with a background color
 *	and possibly a 3-D effect, but not much else in the way of
 *	attributes.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkFrame.c,v 1.1.4.2 1998/09/30 02:16:58 stanton Exp $
 */

#include "default.h"
#include "tkPort.h"
#include "tkInt.h"

/*
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
		    "and the -container option set.");
	    return TCL_ERROR;
	}
    }
    if (toplevel) {
	Tcl_DoWhenIdle(MapFrame, (ClientData) framePtr);
    }
    interp->result = Tk_PathName(new);
    return TCL_OK;

    error:
    if (new != NULL) {
	Tk_DestroyWindow(new);
    }
    return TCL_ERROR;







|







437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
		    "and the -container option set.");
	    return TCL_ERROR;
	}
    }
    if (toplevel) {
	Tcl_DoWhenIdle(MapFrame, (ClientData) framePtr);
    }
    Tcl_SetResult(interp, Tk_PathName(new), TCL_STATIC);
    return TCL_OK;

    error:
    if (new != NULL) {
	Tk_DestroyWindow(new);
    }
    return TCL_ERROR;
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a frame widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as text string, colors, font,
 *	etc. get set for framePtr;  old resources get freed, if there
 *	were any.
 *
 *----------------------------------------------------------------------







|







593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a frame widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as text string, colors, font,
 *	etc. get set for framePtr;  old resources get freed, if there
 *	were any.
 *
 *----------------------------------------------------------------------

Changes to generic/tkGC.c.

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
/* 
 * tkGC.c --
 *
 *	This file maintains a database of read-only graphics contexts 
 *	for the Tk toolkit, in order to allow GC's to be shared.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkGC.c 1.18 96/02/15 18:53:32
 */

#include "tkPort.h"
#include "tk.h"

/*
 * One of the following data structures exists for each GC that is
 * currently active.  The structure is indexed with two hash tables,
 * one based on the values in the graphics context and the other
 * based on the display and GC identifier.
 */

typedef struct {
    GC gc;			/* Graphics context. */
    Display *display;		/* Display to which gc belongs. */
    int refCount;		/* Number of active uses of gc. */
    Tcl_HashEntry *valueHashPtr;/* Entry in valueTable (needed when deleting
				 * this structure). */
} TkGC;

/*
 * Hash table to map from a GC's values to a TkGC structure describing
 * a GC with those values (used by Tk_GetGC).
 */

static Tcl_HashTable valueTable;
typedef struct {
    XGCValues values;		/* Desired values for GC. */
    Display *display;		/* Display for which GC is valid. */
    int screenNum;		/* screen number of display */
    int depth;			/* and depth for which GC is valid. */
} ValueKey;

/*
 * Hash table for <display + GC> -> TkGC mapping. This table is used by
 * Tk_FreeGC.
 */

static Tcl_HashTable idTable;
typedef struct {
    Display *display;		/* Display for which GC was allocated. */
    GC gc;			/* X's identifier for GC. */
} IdKey;

static int initialized = 0;	/* 0 means static structures haven't been
				 * initialized yet. */

/*
 * Forward declarations for procedures defined in this file:
 */

static void		GCInit _ANSI_ARGS_((void));

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetGC --
 *
 *	Given a desired set of values for a graphics context, find












|



|
















<
<
<
<
<
<







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




|







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
/* 
 * tkGC.c --
 *
 *	This file maintains a database of read-only graphics contexts 
 *	for the Tk toolkit, in order to allow GC's to be shared.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkGC.c,v 1.1.4.3 1999/03/20 01:27:51 redman Exp $
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * One of the following data structures exists for each GC that is
 * currently active.  The structure is indexed with two hash tables,
 * one based on the values in the graphics context and the other
 * based on the display and GC identifier.
 */

typedef struct {
    GC gc;			/* Graphics context. */
    Display *display;		/* Display to which gc belongs. */
    int refCount;		/* Number of active uses of gc. */
    Tcl_HashEntry *valueHashPtr;/* Entry in valueTable (needed when deleting
				 * this structure). */
} TkGC;







typedef struct {
    XGCValues values;		/* Desired values for GC. */
    Display *display;		/* Display for which GC is valid. */
    int screenNum;		/* screen number of display */
    int depth;			/* and depth for which GC is valid. */
} ValueKey;















/*
 * Forward declarations for procedures defined in this file:
 */

static void		GCInit _ANSI_ARGS_((TkDisplay *dispPtr));

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetGC --
 *
 *	Given a desired set of values for a graphics context, find
94
95
96
97
98
99
100
101
102
103
104
105

106
107
108
109
110
111
112
113
114
115
				 * in *valuesPtr;  other values are set
				 * from defaults. */
    register XGCValues *valuePtr;
				/* Values are specified here for bits set
				 * in valueMask. */
{
    ValueKey valueKey;
    IdKey idKey;
    Tcl_HashEntry *valueHashPtr, *idHashPtr;
    register TkGC *gcPtr;
    int new;
    Drawable d, freeDrawable;


    if (!initialized) {
	GCInit();
    }

    /*
     * Must zero valueKey at start to clear out pad bytes that may be
     * part of structure on some systems.
     */








<




>

|
|







74
75
76
77
78
79
80

81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
				 * in *valuesPtr;  other values are set
				 * from defaults. */
    register XGCValues *valuePtr;
				/* Values are specified here for bits set
				 * in valueMask. */
{
    ValueKey valueKey;

    Tcl_HashEntry *valueHashPtr, *idHashPtr;
    register TkGC *gcPtr;
    int new;
    Drawable d, freeDrawable;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    if (!dispPtr->gcInit) {
	GCInit(dispPtr);
    }

    /*
     * Must zero valueKey at start to clear out pad bytes that may be
     * part of structure on some systems.
     */

234
235
236
237
238
239
240
241

242
243
244
245
246
247
248
	valueKey.values.dashes = valuePtr->dashes;
    } else {
	valueKey.values.dashes = 4;
    }
    valueKey.display = Tk_Display(tkwin);
    valueKey.screenNum = Tk_ScreenNumber(tkwin);
    valueKey.depth = Tk_Depth(tkwin);
    valueHashPtr = Tcl_CreateHashEntry(&valueTable, (char *) &valueKey, &new);

    if (!new) {
	gcPtr = (TkGC *) Tcl_GetHashValue(valueHashPtr);
	gcPtr->refCount++;
	return gcPtr->gc;
    }

    /*







|
>







214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
	valueKey.values.dashes = valuePtr->dashes;
    } else {
	valueKey.values.dashes = 4;
    }
    valueKey.display = Tk_Display(tkwin);
    valueKey.screenNum = Tk_ScreenNumber(tkwin);
    valueKey.depth = Tk_Depth(tkwin);
    valueHashPtr = Tcl_CreateHashEntry(&dispPtr->gcValueTable, 
            (char *) &valueKey, &new);
    if (!new) {
	gcPtr = (TkGC *) Tcl_GetHashValue(valueHashPtr);
	gcPtr->refCount++;
	return gcPtr->gc;
    }

    /*
271
272
273
274
275
276
277
278
279
280

281
282
283
284
285
286
287
	freeDrawable = d;
    }

    gcPtr->gc = XCreateGC(valueKey.display, d, valueMask, &valueKey.values);
    gcPtr->display = valueKey.display;
    gcPtr->refCount = 1;
    gcPtr->valueHashPtr = valueHashPtr;
    idKey.display = valueKey.display;
    idKey.gc = gcPtr->gc;
    idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, &new);

    if (!new) {
	panic("GC already registered in Tk_GetGC");
    }
    Tcl_SetHashValue(valueHashPtr, gcPtr);
    Tcl_SetHashValue(idHashPtr, gcPtr);
    if (freeDrawable != None) {
	Tk_FreePixmap(valueKey.display, freeDrawable);







<
<
|
>







252
253
254
255
256
257
258


259
260
261
262
263
264
265
266
267
	freeDrawable = d;
    }

    gcPtr->gc = XCreateGC(valueKey.display, d, valueMask, &valueKey.values);
    gcPtr->display = valueKey.display;
    gcPtr->refCount = 1;
    gcPtr->valueHashPtr = valueHashPtr;


    idHashPtr = Tcl_CreateHashEntry(&dispPtr->gcIdTable, 
            (char *) gcPtr->gc, &new);
    if (!new) {
	panic("GC already registered in Tk_GetGC");
    }
    Tcl_SetHashValue(valueHashPtr, gcPtr);
    Tcl_SetHashValue(idHashPtr, gcPtr);
    if (freeDrawable != None) {
	Tk_FreePixmap(valueKey.display, freeDrawable);
309
310
311
312
313
314
315
316
317
318

319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
 */

void
Tk_FreeGC(display, gc)
    Display *display;		/* Display for which gc was allocated. */
    GC gc;			/* Graphics context to be released. */
{
    IdKey idKey;
    Tcl_HashEntry *idHashPtr;
    register TkGC *gcPtr;


    if (!initialized) {
	panic("Tk_FreeGC called before Tk_GetGC");
    }

    idKey.display = display;
    idKey.gc = gc;
    idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
    if (idHashPtr == NULL) {
	panic("Tk_FreeGC received unknown gc argument");
    }
    gcPtr = (TkGC *) Tcl_GetHashValue(idHashPtr);
    gcPtr->refCount--;
    if (gcPtr->refCount == 0) {
	Tk_FreeXId(gcPtr->display, (XID) XGContextFromGC(gcPtr->gc));







<


>

|



<
<
|







289
290
291
292
293
294
295

296
297
298
299
300
301
302
303


304
305
306
307
308
309
310
311
 */

void
Tk_FreeGC(display, gc)
    Display *display;		/* Display for which gc was allocated. */
    GC gc;			/* Graphics context to be released. */
{

    Tcl_HashEntry *idHashPtr;
    register TkGC *gcPtr;
    TkDisplay *dispPtr = TkGetDisplay(display);

    if (!dispPtr->gcInit) {
	panic("Tk_FreeGC called before Tk_GetGC");
    }



    idHashPtr = Tcl_FindHashEntry(&dispPtr->gcIdTable, (char *) gc);
    if (idHashPtr == NULL) {
	panic("Tk_FreeGC received unknown gc argument");
    }
    gcPtr = (TkGC *) Tcl_GetHashValue(idHashPtr);
    gcPtr->refCount--;
    if (gcPtr->refCount == 0) {
	Tk_FreeXId(gcPtr->display, (XID) XGContextFromGC(gcPtr->gc));
351
352
353
354
355
356
357
358

359
360
361
362
363
 * Side effects:
 *	Read the code.
 *
 *----------------------------------------------------------------------
 */

static void
GCInit()

{
    initialized = 1;
    Tcl_InitHashTable(&valueTable, sizeof(ValueKey)/sizeof(int));
    Tcl_InitHashTable(&idTable, sizeof(IdKey)/sizeof(int));
}







|
>

|
|
|

329
330
331
332
333
334
335
336
337
338
339
340
341
342
 * Side effects:
 *	Read the code.
 *
 *----------------------------------------------------------------------
 */

static void
GCInit(dispPtr)
    TkDisplay *dispPtr;
{
    dispPtr->gcInit = 1;
    Tcl_InitHashTable(&dispPtr->gcValueTable, sizeof(ValueKey)/sizeof(int));
    Tcl_InitHashTable(&dispPtr->gcIdTable, TCL_ONE_WORD_KEYS);
}

Changes to generic/tkGeometry.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkGeometry.c --
 *
 *	This file contains generic Tk code for geometry management
 *	(stuff that's used by all geometry managers).
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkGeometry.c 1.31 96/02/15 18:53:32
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * Data structures of the following type are used by Tk_MaintainGeometry.












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkGeometry.c --
 *
 *	This file contains generic Tk code for geometry management
 *	(stuff that's used by all geometry managers).
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkGeometry.c,v 1.1.4.2 1998/12/13 08:16:05 lfb Exp $
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * Data structures of the following type are used by Tk_MaintainGeometry.
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
    int checkScheduled;		/* Non-zero means that there is already a
				 * call to MaintainCheckProc scheduled as
				 * an idle handler. */
    MaintainSlave *slavePtr;	/* First in list of all slaves associated
				 * with this master. */
} MaintainMaster;

/*
 * Hash table that maps from a master's Tk_Window token to a list of
 * Maintains for that master:
 */

static Tcl_HashTable maintainHashTable;

/*
 * Has maintainHashTable been initialized yet?
 */

static int initialized = 0;

/*
 * Prototypes for static procedures in this file:
 */

static void		MaintainCheckProc _ANSI_ARGS_((ClientData clientData));
static void		MaintainMasterProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));







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







48
49
50
51
52
53
54













55
56
57
58
59
60
61
    int checkScheduled;		/* Non-zero means that there is already a
				 * call to MaintainCheckProc scheduled as
				 * an idle handler. */
    MaintainSlave *slavePtr;	/* First in list of all slaves associated
				 * with this master. */
} MaintainMaster;














/*
 * Prototypes for static procedures in this file:
 */

static void		MaintainCheckProc _ANSI_ARGS_((ClientData clientData));
static void		MaintainMasterProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
257
258
259
260
261
262
263

264
265
266
267
268
269
270
271
272
273
274
275
276

277
278
279
280
281
282
283
    int width, height;		/* Desired dimensions for slave. */
{
    Tcl_HashEntry *hPtr;
    MaintainMaster *masterPtr;
    register MaintainSlave *slavePtr;
    int new, map;
    Tk_Window ancestor, parent;


    if (!initialized) {
	initialized = 1;
	Tcl_InitHashTable(&maintainHashTable, TCL_ONE_WORD_KEYS);
    }

    /*
     * See if there is already a MaintainMaster structure for the master;
     * if not, then create one.
     */

    parent = Tk_Parent(slave);
    hPtr = Tcl_CreateHashEntry(&maintainHashTable, (char *) master, &new);

    if (!new) {
	masterPtr = (MaintainMaster *) Tcl_GetHashValue(hPtr);
    } else {
	masterPtr = (MaintainMaster *) ckalloc(sizeof(MaintainMaster));
	masterPtr->ancestor = master;
	masterPtr->checkScheduled = 0;
	masterPtr->slavePtr = NULL;







>

|
|
|








|
>







244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
    int width, height;		/* Desired dimensions for slave. */
{
    Tcl_HashEntry *hPtr;
    MaintainMaster *masterPtr;
    register MaintainSlave *slavePtr;
    int new, map;
    Tk_Window ancestor, parent;
    TkDisplay *dispPtr = ((TkWindow *) master)->dispPtr;

    if (!dispPtr->geomInit) {
	dispPtr->geomInit = 1;
	Tcl_InitHashTable(&dispPtr->maintainHashTable, TCL_ONE_WORD_KEYS);
    }

    /*
     * See if there is already a MaintainMaster structure for the master;
     * if not, then create one.
     */

    parent = Tk_Parent(slave);
    hPtr = Tcl_CreateHashEntry(&dispPtr->maintainHashTable, 
            (char *) master, &new);
    if (!new) {
	masterPtr = (MaintainMaster *) Tcl_GetHashValue(hPtr);
    } else {
	masterPtr = (MaintainMaster *) ckalloc(sizeof(MaintainMaster));
	masterPtr->ancestor = master;
	masterPtr->checkScheduled = 0;
	masterPtr->slavePtr = NULL;
379
380
381
382
383
384
385

386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
    Tk_Window master;		/* Master for slave; must be a descendant
				 * of slave's parent. */
{
    Tcl_HashEntry *hPtr;
    MaintainMaster *masterPtr;
    register MaintainSlave *slavePtr, *prevPtr;
    Tk_Window ancestor;


    if (!initialized) {
	initialized = 1;
	Tcl_InitHashTable(&maintainHashTable, TCL_ONE_WORD_KEYS);
    }

    if (!(((TkWindow *) slave)->flags & TK_ALREADY_DEAD)) {
	Tk_UnmapWindow(slave);
    }
    hPtr = Tcl_FindHashEntry(&maintainHashTable, (char *) master);
    if (hPtr == NULL) {
	return;
    }
    masterPtr = (MaintainMaster *) Tcl_GetHashValue(hPtr);
    slavePtr = masterPtr->slavePtr;
    if (slavePtr->slave == slave) {
	masterPtr->slavePtr = slavePtr->nextPtr;







>

|
|
|





|







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
    Tk_Window master;		/* Master for slave; must be a descendant
				 * of slave's parent. */
{
    Tcl_HashEntry *hPtr;
    MaintainMaster *masterPtr;
    register MaintainSlave *slavePtr, *prevPtr;
    Tk_Window ancestor;
    TkDisplay *dispPtr = ((TkWindow *) slave)->dispPtr;

    if (!dispPtr->geomInit) {
	dispPtr->geomInit = 1;
	Tcl_InitHashTable(&dispPtr->maintainHashTable, TCL_ONE_WORD_KEYS);
    }

    if (!(((TkWindow *) slave)->flags & TK_ALREADY_DEAD)) {
	Tk_UnmapWindow(slave);
    }
    hPtr = Tcl_FindHashEntry(&dispPtr->maintainHashTable, (char *) master);
    if (hPtr == NULL) {
	return;
    }
    masterPtr = (MaintainMaster *) Tcl_GetHashValue(hPtr);
    slavePtr = masterPtr->slavePtr;
    if (slavePtr->slave == slave) {
	masterPtr->slavePtr = slavePtr->nextPtr;

Changes to generic/tkGet.c.

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
/* 
 * tkGet.c --
 *
 *	This file contains a number of "Tk_GetXXX" procedures, which
 *	parse text strings into useful forms for Tk.  This file has
 *	the simpler procedures, like Tk_GetDirection and Tk_GetUid.
 *	The more complex procedures like Tk_GetColor are in separate
 *	files.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkGet.c 1.13 96/04/26 10:25:46
 */

#include "tkInt.h"
#include "tkPort.h"

/*


 * The hash table below is used to keep track of all the Tk_Uids created
 * so far.

 */



static Tcl_HashTable uidTable;


static int initialized = 0;















































/*
 *--------------------------------------------------------------
 *
 * Tk_GetAnchor --
 *
 *	Given a string, return the corresponding Tk_Anchor.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	position is stored at *anchorPtr;  otherwise TCL_ERROR
 *	is returned and an error message is left in
 *	interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */











|




|






>
>
|
<
>


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













|







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
/* 
 * tkGet.c --
 *
 *	This file contains a number of "Tk_GetXXX" procedures, which
 *	parse text strings into useful forms for Tk.  This file has
 *	the simpler procedures, like Tk_GetDirection and Tk_GetUid.
 *	The more complex procedures like Tk_GetColor are in separate
 *	files.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkGet.c,v 1.1.4.5 1999/02/16 11:39:31 lfb Exp $
 */

#include "tkInt.h"
#include "tkPort.h"

/*
 * One of these structures is created per thread to store 
 * thread-specific data.  In this case, it is used to house the 
 * Tk_Uids used by each thread.  The "dataKey" below is used to 

 * locate the ThreadSpecificData for the current thread.
 */

typedef struct ThreadSpecificData {
    int initialized;
    Tcl_HashTable uidTable;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * The following tables defines the string values for reliefs, which are
 * used by Tk_GetAnchorFromObj and Tk_GetJustifyFromObj.
 */

static char *anchorStrings[] = {"n", "ne", "e", "se", "s", "sw", "w", "nw",
	"center", (char *) NULL};
static char *justifyStrings[] = {"left", "right", "center", (char *) NULL};


/*
 *----------------------------------------------------------------------
 *
 * Tk_GetAnchorFromObj --
 *
 *	Return a Tk_Anchor value based on the value of the objPtr.
 *
 * Results:
 *	The return value is a standard Tcl result. If an error occurs during
 *	conversion, an error message is left in the interpreter's result
 *	unless "interp" is NULL.
 *
 * Side effects:
 *	The object gets converted by Tcl_GetIndexFromObj.
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetAnchorFromObj(interp, objPtr, anchorPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    Tcl_Obj *objPtr;		/* The object we are trying to get the 
				 * value from. */
    Tk_Anchor *anchorPtr;	/* Where to place the Tk_Anchor that
				 * corresponds to the string value of
				 * objPtr. */
{
    int index, code;

    code = Tcl_GetIndexFromObj(interp, objPtr, anchorStrings, "anchor", 0, 
	    &index);
    if (code == TCL_OK) {
	*anchorPtr = (Tk_Anchor) index;
    }
    return code;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_GetAnchor --
 *
 *	Given a string, return the corresponding Tk_Anchor.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	position is stored at *anchorPtr;  otherwise TCL_ERROR
 *	is returned and an error message is left in
 *	the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
 *	Given a string, return the corresponding Tk_JoinStyle.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	justification is stored at *joinPtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */








|







203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
 *	Given a string, return the corresponding Tk_JoinStyle.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	justification is stored at *joinPtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
 *	Given a string, return the corresponding Tk_CapStyle.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	justification is stored at *capPtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */








|







285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
 *	Given a string, return the corresponding Tk_CapStyle.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	justification is stored at *capPtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

302
303
304
305
306
307
308





































309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
    switch (cap) {
	case CapButt: return "butt";
	case CapProjecting: return "projecting";
	case CapRound: return "round";
    }
    return "unknown cap style";
}






































/*
 *--------------------------------------------------------------
 *
 * Tk_GetJustify --
 *
 *	Given a string, return the corresponding Tk_Justify.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	justification is stored at *justifyPtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */








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













|







354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
    switch (cap) {
	case CapButt: return "butt";
	case CapProjecting: return "projecting";
	case CapRound: return "round";
    }
    return "unknown cap style";
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetJustifyFromObj --
 *
 *	Return a Tk_Justify value based on the value of the objPtr.
 *
 * Results:
 *	The return value is a standard Tcl result. If an error occurs during
 *	conversion, an error message is left in the interpreter's result
 *	unless "interp" is NULL.
 *
 * Side effects:
 *	The object gets converted by Tcl_GetIndexFromObj.
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetJustifyFromObj(interp, objPtr, justifyPtr)
    Tcl_Interp *interp;		/* Used for error reporting. */
    Tcl_Obj *objPtr;		/* The object we are trying to get the 
				 * value from. */
    Tk_Justify *justifyPtr;	/* Where to place the Tk_Justify that
				 * corresponds to the string value of
				 * objPtr. */
{
    int index, code;

    code = Tcl_GetIndexFromObj(interp, objPtr, justifyStrings,
	    "justification", 0, &index);
    if (code == TCL_OK) {
	*justifyPtr = (Tk_Justify) index;
    }
    return code;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_GetJustify --
 *
 *	Given a string, return the corresponding Tk_Justify.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	justification is stored at *justifyPtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

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
 */

Tk_Uid
Tk_GetUid(string)
    CONST char *string;		/* String to convert. */
{
    int dummy;




    if (!initialized) {
	Tcl_InitHashTable(&uidTable, TCL_STRING_KEYS);
	initialized = 1;
    }
    return (Tk_Uid) Tcl_GetHashKey(&uidTable,
	    Tcl_CreateHashEntry(&uidTable, string, &dummy));
}

/*
 *--------------------------------------------------------------
 *
 * Tk_GetScreenMM --
 *
 *	Given a string, returns the number of screen millimeters
 *	corresponding to that string.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	screen distance is stored at *doublePtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */








>
>
>

|
|
|

|
|















|







502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
 */

Tk_Uid
Tk_GetUid(string)
    CONST char *string;		/* String to convert. */
{
    int dummy;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    Tcl_HashTable *tablePtr = &tsdPtr->uidTable;

    if (!tsdPtr->initialized) {
	Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
	tsdPtr->initialized = 1;
    }
    return (Tk_Uid) Tcl_GetHashKey(tablePtr,
	    Tcl_CreateHashEntry(tablePtr, string, &dummy));
}

/*
 *--------------------------------------------------------------
 *
 * Tk_GetScreenMM --
 *
 *	Given a string, returns the number of screen millimeters
 *	corresponding to that string.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	screen distance is stored at *doublePtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
 *	to that string.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	rounded pixel distance is stored at *intPtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */








|







603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
 *	to that string.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the
 *	rounded pixel distance is stored at *intPtr;  otherwise
 *	TCL_ERROR is returned and an error message is left in
 *	the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

580
581
582
583
584
585
586


    if (d < 0) {
	*intPtr = (int) (d - 0.5);
    } else {
	*intPtr = (int) (d + 0.5);
    }
    return TCL_OK;
}









>
>
672
673
674
675
676
677
678
679
680
    if (d < 0) {
	*intPtr = (int) (d - 0.5);
    } else {
	*intPtr = (int) (d + 0.5);
    }
    return TCL_OK;
}


Changes to generic/tkGrab.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16




17
18
19
20
21
22
23
/* 
 * tkGrab.c --
 *
 *	This file provides procedures that implement grabs for Tk.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkGrab.c 1.52 97/03/21 11:14:34
 */

#include "tkPort.h"
#include "tkInt.h"





/*
 * The grab state machine has four states: ungrabbed, button pressed,
 * grabbed, and button pressed while grabbed.  In addition, there are
 * three pieces of grab state information: the current grab window,
 * the current restrict window, and whether the mouse is captured.
 *






|




|




>
>
>
>







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
/* 
 * tkGrab.c --
 *
 *	This file provides procedures that implement grabs for Tk.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkGrab.c,v 1.1.4.4 1999/03/10 07:13:40 stanton Exp $
 */

#include "tkPort.h"
#include "tkInt.h"

#if !defined(__WIN32__) && !defined(MAC_TCL)
#include "tkUnixInt.h"
#endif

/*
 * The grab state machine has four states: ungrabbed, button pressed,
 * grabbed, and button pressed while grabbed.  In addition, there are
 * three pieces of grab state information: the current grab window,
 * the current restrict window, and whether the mouse is captured.
 *
234
235
236
237
238
239
240
241

242
243
244
245
246
247
248
249
250
251
	if (argc == 3) {
	    tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData);
	    if (tkwin == NULL) {
		return TCL_ERROR;
	    }
	    dispPtr = ((TkWindow *) tkwin)->dispPtr;
	    if (dispPtr->eventualGrabWinPtr != NULL) {
		interp->result = dispPtr->eventualGrabWinPtr->pathName;

	    }
	} else {
	    for (dispPtr = tkDisplayList; dispPtr != NULL;
		    dispPtr = dispPtr->nextPtr) {
		if (dispPtr->eventualGrabWinPtr != NULL) {
		    Tcl_AppendElement(interp,
			    dispPtr->eventualGrabWinPtr->pathName);
		}
	    }
	}







|
>


|







238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
	if (argc == 3) {
	    tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData);
	    if (tkwin == NULL) {
		return TCL_ERROR;
	    }
	    dispPtr = ((TkWindow *) tkwin)->dispPtr;
	    if (dispPtr->eventualGrabWinPtr != NULL) {
		Tcl_SetResult(interp, dispPtr->eventualGrabWinPtr->pathName,
			TCL_STATIC);
	    }
	} else {
	    for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
		    dispPtr = dispPtr->nextPtr) {
		if (dispPtr->eventualGrabWinPtr != NULL) {
		    Tcl_AppendElement(interp,
			    dispPtr->eventualGrabWinPtr->pathName);
		}
	    }
	}
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
	winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2],
		(Tk_Window) clientData);
	if (winPtr == NULL) {
	    return TCL_ERROR;
	}
	dispPtr = winPtr->dispPtr;
	if (dispPtr->eventualGrabWinPtr != winPtr) {
	    interp->result = "none";
	} else if (dispPtr->grabFlags & GRAB_GLOBAL) {
	    interp->result = "global";
	} else {
	    interp->result = "local";
	}
    } else {
	Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1],
		"\": must be current, release, set, or status",
		(char *) NULL);
	return TCL_ERROR;
    }







|

|

|







304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
	winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2],
		(Tk_Window) clientData);
	if (winPtr == NULL) {
	    return TCL_ERROR;
	}
	dispPtr = winPtr->dispPtr;
	if (dispPtr->eventualGrabWinPtr != winPtr) {
	    Tcl_SetResult(interp, "none", TCL_STATIC);
	} else if (dispPtr->grabFlags & GRAB_GLOBAL) {
	    Tcl_SetResult(interp, "global", TCL_STATIC);
	} else {
	    Tcl_SetResult(interp, "local", TCL_STATIC);
	}
    } else {
	Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1],
		"\": must be current, release, set, or status",
		(char *) NULL);
	return TCL_ERROR;
    }
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
 *
 *	Grabs the pointer and keyboard, so that mouse-related events are
 *	only reported relative to a given window and its descendants.
 *
 * Results:
 *	A standard Tcl result is returned.  TCL_OK is the normal return
 *	value;  if the grab could not be set then TCL_ERROR is returned
 *	and interp->result will hold an error message.
 *
 * Side effects:
 *	Once this call completes successfully, no window outside the
 *	tree rooted at tkwin will receive pointer- or keyboard-related
 *	events until the next call to Tk_Ungrab.  If a previous grab was
 *	in effect within this application, then it is replaced with a new
 *	one.







|







330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
 *
 *	Grabs the pointer and keyboard, so that mouse-related events are
 *	only reported relative to a given window and its descendants.
 *
 * Results:
 *	A standard Tcl result is returned.  TCL_OK is the normal return
 *	value;  if the grab could not be set then TCL_ERROR is returned
 *	and the interp's result will hold an error message.
 *
 * Side effects:
 *	Once this call completes successfully, no window outside the
 *	tree rooted at tkwin will receive pointer- or keyboard-related
 *	events until the next call to Tk_Ungrab.  If a previous grab was
 *	in effect within this application, then it is replaced with a new
 *	one.
362
363
364
365
366
367
368
369

370
371
372
373
374
375
376
    if (dispPtr->eventualGrabWinPtr != NULL) {
	if ((dispPtr->eventualGrabWinPtr == winPtr)
		&& (grabGlobal == ((dispPtr->grabFlags & GRAB_GLOBAL) != 0))) {
	    return TCL_OK;
	}
	if (dispPtr->eventualGrabWinPtr->mainPtr != winPtr->mainPtr) {
	    alreadyGrabbed:
	    interp->result = "grab failed: another application has grab";

	    return TCL_ERROR;
	}
	Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr);
    }

    Tk_MakeWindowExist(tkwin);
    if (!grabGlobal) {







|
>







367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
    if (dispPtr->eventualGrabWinPtr != NULL) {
	if ((dispPtr->eventualGrabWinPtr == winPtr)
		&& (grabGlobal == ((dispPtr->grabFlags & GRAB_GLOBAL) != 0))) {
	    return TCL_OK;
	}
	if (dispPtr->eventualGrabWinPtr->mainPtr != winPtr->mainPtr) {
	    alreadyGrabbed:
	    Tcl_SetResult(interp, "grab failed: another application has grab",
		    TCL_STATIC);
	    return TCL_ERROR;
	}
	Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr);
    }

    Tk_MakeWindowExist(tkwin);
    if (!grabGlobal) {
428
429
430
431
432
433
434
435

436
437
438

439
440
441

442
443
444
445
446
447
448
449
450
		break;
	    }
	    Tcl_Sleep(100);
	}
	if (grabResult != 0) {
	    grabError:
	    if (grabResult == GrabNotViewable) {
		interp->result = "grab failed: window not viewable";

	    } else if (grabResult == AlreadyGrabbed) {
		goto alreadyGrabbed;
	    } else if (grabResult == GrabFrozen) {

		interp->result = "grab failed: keyboard or pointer frozen";
	    } else if (grabResult == GrabInvalidTime) {
		interp->result = "grab failed: invalid time";

	    } else {
		char msg[100];
	
		sprintf(msg, "grab failed for unknown reason (code %d)",
			grabResult);
		Tcl_AppendResult(interp, msg, (char *) NULL);
	    }
	    return TCL_ERROR;
	}







|
>



>
|

|
>

|







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
		break;
	    }
	    Tcl_Sleep(100);
	}
	if (grabResult != 0) {
	    grabError:
	    if (grabResult == GrabNotViewable) {
		Tcl_SetResult(interp, "grab failed: window not viewable",
			TCL_STATIC);
	    } else if (grabResult == AlreadyGrabbed) {
		goto alreadyGrabbed;
	    } else if (grabResult == GrabFrozen) {
		Tcl_SetResult(interp,
			"grab failed: keyboard or pointer frozen", TCL_STATIC);
	    } else if (grabResult == GrabInvalidTime) {
		Tcl_SetResult(interp, "grab failed: invalid time",
			TCL_STATIC);
	    } else {
		char msg[64 + TCL_INTEGER_SPACE];
	
		sprintf(msg, "grab failed for unknown reason (code %d)",
			grabResult);
		Tcl_AppendResult(interp, msg, (char *) NULL);
	    }
	    return TCL_ERROR;
	}

Changes to generic/tkGrid.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tkGrid.c --
 *
 *	Grid based geometry manager.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkGrid.c 1.39 97/10/10 10:12:03
 */

#include "tkInt.h"

/*
 * Convenience Macros
 */










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tkGrid.c --
 *
 *	Grid based geometry manager.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkGrid.c,v 1.1.4.4 1999/01/29 00:34:31 stanton Exp $
 */

#include "tkInt.h"

/*
 * Convenience Macros
 */
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
 *				then Tk will set its requested size to fit
 *				the needs of its slaves.
 */

#define REQUESTED_RELAYOUT	1
#define DONT_PROPAGATE		2

/*
 * Hash table used to map from Tk_Window tokens to corresponding
 * Grid structures:
 */

static Tcl_HashTable gridHashTable;
static int initialized = 0;

/*
 * Prototypes for procedures used only in this file:
 */

static void	AdjustForSticky _ANSI_ARGS_((Gridder *slavePtr, int *xPtr, 
		    int *yPtr, int *widthPtr, int *heightPtr));
static int	AdjustOffsets _ANSI_ARGS_((int width,







<
<
<
<
<
<
<
<







217
218
219
220
221
222
223








224
225
226
227
228
229
230
 *				then Tk will set its requested size to fit
 *				the needs of its slaves.
 */

#define REQUESTED_RELAYOUT	1
#define DONT_PROPAGATE		2









/*
 * Prototypes for procedures used only in this file:
 */

static void	AdjustForSticky _ANSI_ARGS_((Gridder *slavePtr, int *xPtr, 
		    int *yPtr, int *widthPtr, int *heightPtr));
static int	AdjustOffsets _ANSI_ARGS_((int width,
310
311
312
313
314
315
316

317
318
319
320
321
322
323
    if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
	Tk_Window master;
	int row, column;	/* origin for bounding box */
	int row2, column2;	/* end of bounding box */
	int endX, endY;		/* last column/row in the layout */
	int x=0, y=0;		/* starting pixels for this bounding box */
	int width, height;	/* size of the bounding box */


	if (argc!=3 && argc != 5 && argc != 7) {
	    Tcl_AppendResult(interp, "wrong number of arguments: ",
		    "must be \"",argv[0],
		    " bbox master ?column row ?column row??\"",
		    (char *) NULL);
	    return TCL_ERROR;







>







302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
    if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
	Tk_Window master;
	int row, column;	/* origin for bounding box */
	int row2, column2;	/* end of bounding box */
	int endX, endY;		/* last column/row in the layout */
	int x=0, y=0;		/* starting pixels for this bounding box */
	int width, height;	/* size of the bounding box */
	char buf[TCL_INTEGER_SPACE * 4];

	if (argc!=3 && argc != 5 && argc != 7) {
	    Tcl_AppendResult(interp, "wrong number of arguments: ",
		    "must be \"",argv[0],
		    " bbox master ?column row ?column row??\"",
		    (char *) NULL);
	    return TCL_ERROR;
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
	    if (Tcl_GetInt(interp, argv[6], &row2) != TCL_OK) {
		return TCL_ERROR;
	    }
	}

	gridPtr = masterPtr->masterDataPtr;
	if (gridPtr == NULL) {
	    sprintf(interp->result, "%d %d %d %d",0,0,0,0);
	    return(TCL_OK);
	}

	SetGridSize(masterPtr);
	endX = MAX(gridPtr->columnEnd, gridPtr->columnMax);
	endY = MAX(gridPtr->rowEnd, gridPtr->rowMax);

	if ((endX == 0) || (endY == 0)) {
	    sprintf(interp->result, "%d %d %d %d",0,0,0,0);
	    return(TCL_OK);
	}
	if (argc == 3) {
	    row = column = 0;
	    row2 = endY;
	    column2 = endX;
	}







|








|







340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
	    if (Tcl_GetInt(interp, argv[6], &row2) != TCL_OK) {
		return TCL_ERROR;
	    }
	}

	gridPtr = masterPtr->masterDataPtr;
	if (gridPtr == NULL) {
	    Tcl_SetResult(interp, "0 0 0 0", TCL_STATIC);
	    return(TCL_OK);
	}

	SetGridSize(masterPtr);
	endX = MAX(gridPtr->columnEnd, gridPtr->columnMax);
	endY = MAX(gridPtr->rowEnd, gridPtr->rowMax);

	if ((endX == 0) || (endY == 0)) {
	    Tcl_SetResult(interp, "0 0 0 0", TCL_STATIC);
	    return(TCL_OK);
	}
	if (argc == 3) {
	    row = column = 0;
	    row2 = endY;
	    column2 = endX;
	}
402
403
404
405
406
407
408
409
410

411
412
413
414
415
416
417
	    height = 0;
	} else if (row2 >= endY) {
	    height = gridPtr->rowPtr[endY-1].offset - y;
	} else {
	    height = gridPtr->rowPtr[row2].offset - y;
	} 

	sprintf(interp->result, "%d %d %d %d",
		x + gridPtr->startX, y + gridPtr->startY, width, height);

    } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) {
	if (argv[2][0] != '.') {
	    Tcl_AppendResult(interp, "bad argument \"", argv[2],
		    "\": must be name of window", (char *) NULL);
	    return TCL_ERROR;
	}
	return ConfigureSlaves(interp, tkwin, argc-2, argv+2);







|
|
>







395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
	    height = 0;
	} else if (row2 >= endY) {
	    height = gridPtr->rowPtr[endY-1].offset - y;
	} else {
	    height = gridPtr->rowPtr[row2].offset - y;
	} 

	sprintf(buf, "%d %d %d %d", x + gridPtr->startX, y + gridPtr->startY,
		width, height);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) {
	if (argv[2][0] != '.') {
	    Tcl_AppendResult(interp, "bad argument \"", argv[2],
		    "\": must be name of window", (char *) NULL);
	    return TCL_ERROR;
	}
	return ConfigureSlaves(interp, tkwin, argc-2, argv+2);
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
	    	if (c == 'f') {
		    slavePtr->column = slavePtr->row = -1;
		    slavePtr->numCols = 1;
		    slavePtr->numRows = 1;
		    slavePtr->padX = slavePtr->padY = 0;
		    slavePtr->iPadX = slavePtr->iPadY = 0;
		    slavePtr->doubleBw = 2*Tk_Changes(tkwin)->border_width;



		    slavePtr->flags = 0;
		    slavePtr->sticky = 0;
	    	}
		Tk_ManageGeometry(slave, (Tk_GeomMgr *) NULL,
			(ClientData) NULL);
		if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
		    Tk_UnmaintainGeometry(slavePtr->tkwin,
			    slavePtr->masterPtr->tkwin);
		}
		Unlink(slavePtr);
		Tk_UnmapWindow(slavePtr->tkwin);
	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) {
	register Gridder *slavePtr;
	Tk_Window slave;
	char buffer[70];
    
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " info window\"", (char *) NULL);
	    return TCL_ERROR;
	}
	slave = Tk_NameToWindow(interp, argv[2], tkwin);
	if (slave == NULL) {
	    return TCL_ERROR;
	}
	slavePtr = GetGrid(slave);
	if (slavePtr->masterPtr == NULL) {
	    interp->result[0] = '\0';
	    return TCL_OK;
	}
    
	Tcl_AppendElement(interp, "-in");
	Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin));
	sprintf(buffer, " -column %d -row %d -columnspan %d -rowspan %d",
		slavePtr->column, slavePtr->row,







>
>
>
















|












|







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
	    	if (c == 'f') {
		    slavePtr->column = slavePtr->row = -1;
		    slavePtr->numCols = 1;
		    slavePtr->numRows = 1;
		    slavePtr->padX = slavePtr->padY = 0;
		    slavePtr->iPadX = slavePtr->iPadY = 0;
		    slavePtr->doubleBw = 2*Tk_Changes(tkwin)->border_width;
		    if (slavePtr->flags & REQUESTED_RELAYOUT) {
			Tk_CancelIdleCall(ArrangeGrid, (ClientData) slavePtr);
		    }
		    slavePtr->flags = 0;
		    slavePtr->sticky = 0;
	    	}
		Tk_ManageGeometry(slave, (Tk_GeomMgr *) NULL,
			(ClientData) NULL);
		if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
		    Tk_UnmaintainGeometry(slavePtr->tkwin,
			    slavePtr->masterPtr->tkwin);
		}
		Unlink(slavePtr);
		Tk_UnmapWindow(slavePtr->tkwin);
	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) {
	register Gridder *slavePtr;
	Tk_Window slave;
	char buffer[64 + TCL_INTEGER_SPACE * 4];
    
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " info window\"", (char *) NULL);
	    return TCL_ERROR;
	}
	slave = Tk_NameToWindow(interp, argv[2], tkwin);
	if (slave == NULL) {
	    return TCL_ERROR;
	}
	slavePtr = GetGrid(slave);
	if (slavePtr->masterPtr == NULL) {
	    Tcl_ResetResult(interp);
	    return TCL_OK;
	}
    
	Tcl_AppendElement(interp, "-in");
	Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin));
	sprintf(buffer, " -column %d -row %d -columnspan %d -rowspan %d",
		slavePtr->column, slavePtr->row,
487
488
489
490
491
492
493

494
495
496
497
498
499
500
	Tcl_AppendResult(interp, " -sticky ", buffer, (char *) NULL);
    } else if((c == 'l') && (strncmp(argv[1], "location", length) == 0)) {
	Tk_Window master;
	register SlotInfo *slotPtr;
	int x, y;		/* Offset in pixels, from edge of parent. */
	int i, j;		/* Corresponding column and row indeces. */
	int endX, endY;		/* end of grid */


	if (argc != 5) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " location master x y\"", (char *)NULL);
	    return TCL_ERROR;
	}








>







484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
	Tcl_AppendResult(interp, " -sticky ", buffer, (char *) NULL);
    } else if((c == 'l') && (strncmp(argv[1], "location", length) == 0)) {
	Tk_Window master;
	register SlotInfo *slotPtr;
	int x, y;		/* Offset in pixels, from edge of parent. */
	int i, j;		/* Corresponding column and row indeces. */
	int endX, endY;		/* end of grid */
	char buf[TCL_INTEGER_SPACE * 2];

	if (argc != 5) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " location master x y\"", (char *)NULL);
	    return TCL_ERROR;
	}

508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
	}
	if (Tk_GetPixels(interp, master, argv[4], &y) != TCL_OK) {
	    return TCL_ERROR;
	}

	masterPtr = GetGrid(master);
	if (masterPtr->masterDataPtr == NULL) {
	    sprintf(interp->result, "%d %d", -1, -1);
	    return TCL_OK;
	}
	gridPtr = masterPtr->masterDataPtr;

	/* 
	 * Update any pending requests.  This is not always the
	 * steady state value, as more configure events could be in







|







506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
	}
	if (Tk_GetPixels(interp, master, argv[4], &y) != TCL_OK) {
	    return TCL_ERROR;
	}

	masterPtr = GetGrid(master);
	if (masterPtr->masterDataPtr == NULL) {
	    Tcl_SetResult(interp, "-1 -1", TCL_STATIC);
	    return TCL_OK;
	}
	gridPtr = masterPtr->masterDataPtr;

	/* 
	 * Update any pending requests.  This is not always the
	 * steady state value, as more configure events could be in
547
548
549
550
551
552
553
554

555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570

571

572
573
574
575
576
577
578
	} else {
	    y -= masterPtr->masterDataPtr->startY;
	    for (j=0;slotPtr[j].offset < y && j < endY; j++) {
		/* null body */
	    }
	}

	sprintf(interp->result, "%d %d", i, j);

    } else if ((c == 'p') && (strncmp(argv[1], "propagate", length) == 0)) {
	Tk_Window master;
	int propagate;
    
	if (argc > 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " propagate window ?boolean?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	master = Tk_NameToWindow(interp, argv[2], tkwin);
	if (master == NULL) {
	    return TCL_ERROR;
	}
	masterPtr = GetGrid(master);
	if (argc == 3) {

	    interp->result = (masterPtr->flags & DONT_PROPAGATE) ? "0" : "1";

	    return TCL_OK;
	}
	if (Tcl_GetBoolean(interp, argv[3], &propagate) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((!propagate) ^ (masterPtr->flags&DONT_PROPAGATE)) {
	    masterPtr->flags  ^= DONT_PROPAGATE;







|
>
















>
|
>







545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
	} else {
	    y -= masterPtr->masterDataPtr->startY;
	    for (j=0;slotPtr[j].offset < y && j < endY; j++) {
		/* null body */
	    }
	}

	sprintf(buf, "%d %d", i, j);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'p') && (strncmp(argv[1], "propagate", length) == 0)) {
	Tk_Window master;
	int propagate;
    
	if (argc > 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " propagate window ?boolean?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	master = Tk_NameToWindow(interp, argv[2], tkwin);
	if (master == NULL) {
	    return TCL_ERROR;
	}
	masterPtr = GetGrid(master);
	if (argc == 3) {
	    Tcl_SetResult(interp,
		    ((masterPtr->flags & DONT_PROPAGATE) ? "0" : "1"),
		    TCL_STATIC);
	    return TCL_OK;
	}
	if (Tcl_GetBoolean(interp, argv[3], &propagate) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((!propagate) ^ (masterPtr->flags&DONT_PROPAGATE)) {
	    masterPtr->flags  ^= DONT_PROPAGATE;
602
603
604
605
606
607
608


609
610
611
612
613

614
615
616
617
618
619
620
621
622
	master = Tk_NameToWindow(interp, argv[2], tkwin);
	if (master == NULL) {
	    return TCL_ERROR;
	}
	masterPtr = GetGrid(master);

	if (masterPtr->masterDataPtr != NULL) {


	    SetGridSize(masterPtr);
	    gridPtr = masterPtr->masterDataPtr;
	    sprintf(interp->result, "%d %d",
		MAX(gridPtr->columnEnd, gridPtr->columnMax),
		MAX(gridPtr->rowEnd, gridPtr->rowMax));

	} else {
	    sprintf(interp->result, "%d %d",0, 0);
	}
    } else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0)
	    && (length > 1)) {
	Tk_Window master;
	Gridder *slavePtr;
	int i, value;
	int row = -1, column = -1;







>
>


|
|
|
>

|







603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
	master = Tk_NameToWindow(interp, argv[2], tkwin);
	if (master == NULL) {
	    return TCL_ERROR;
	}
	masterPtr = GetGrid(master);

	if (masterPtr->masterDataPtr != NULL) {
	    char buf[TCL_INTEGER_SPACE * 2];

	    SetGridSize(masterPtr);
	    gridPtr = masterPtr->masterDataPtr;
	    sprintf(buf, "%d %d",
		    MAX(gridPtr->columnEnd, gridPtr->columnMax),
		    MAX(gridPtr->rowEnd, gridPtr->rowMax));
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	} else {
	    Tcl_SetResult(interp, "0 0", TCL_STATIC);
	}
    } else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0)
	    && (length > 1)) {
	Tk_Window master;
	Gridder *slavePtr;
	int i, value;
	int row = -1, column = -1;
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
	     * request is out of range, return all 0's.
	     */

	    if (argc == 4) {
		Tcl_Free((char *)argvPtr);
	    }
	    if ((argc == 4) && (ok == TCL_OK)) {


		sprintf(interp->result,"-minsize %d -pad %d -weight %d",
			slotPtr[slot].minSize,slotPtr[slot].pad,
			slotPtr[slot].weight);

		return (TCL_OK);
	    } else if (argc == 4) {
		sprintf(interp->result,"-minsize %d -pad %d -weight %d", 0,0,0);

		return (TCL_OK);
	    }

	    /*
	     * Loop through each option value pair, setting the values as required.
	     * If only one option is given, with no value, the current value is
	     * returned.
	     */

	    for (i=4; i<argc; i+=2) {
		length = strlen(argv[i]);
		if ((*argv[i] != '-') || length < 2) {
		    Tcl_AppendResult(interp, "invalid arg \"",
			    argv[i], "\" :expecting -minsize, -pad, or -weight.",
			    (char *) NULL);
		    Tcl_Free((char *)argvPtr);
		    return TCL_ERROR;
		}
		if (strncmp(argv[i], "-minsize", length) == 0) {
		    if (argc == 5) {



		    	int value =  ok == TCL_OK ? slotPtr[slot].minSize : 0;
			sprintf(interp->result,"%d",value);

		    } else if (Tk_GetPixels(interp, master, argv[i+1], &size)
			    != TCL_OK) {
			Tcl_Free((char *)argvPtr);
			return TCL_ERROR;
		    } else {
			slotPtr[slot].minSize = size;
		    }
		}
		else if (strncmp(argv[i], "-weight", length) == 0) {
		    int wt;
		    if (argc == 5) {



		    	int value =  ok == TCL_OK ? slotPtr[slot].weight : 0;
			sprintf(interp->result,"%d",value);

		    } else if (Tcl_GetInt(interp, argv[i+1], &wt) != TCL_OK) {
			Tcl_Free((char *)argvPtr);
			return TCL_ERROR;
		    } else if (wt < 0) {
			Tcl_AppendResult(interp, "invalid arg \"", argv[i],
				"\": should be non-negative", (char *) NULL);
			Tcl_Free((char *)argvPtr);
			return TCL_ERROR;
		    } else {
			slotPtr[slot].weight = wt;
		    }
		}
		else if (strncmp(argv[i], "-pad", length) == 0) {
		    if (argc == 5) {

		    	int value =  ok == TCL_OK ? slotPtr[slot].pad : 0;
			sprintf(interp->result,"%d",value);



		    } else if (Tk_GetPixels(interp, master, argv[i+1], &size)
			    != TCL_OK) {
			Tcl_Free((char *)argvPtr);
			return TCL_ERROR;
		    } else if (size < 0) {
			Tcl_AppendResult(interp, "invalid arg \"", argv[i],
				"\": should be non-negative", (char *) NULL);







>
>
|


>


|
>




















>
>
>
|
|
>











>
>
>
|
|
>














>
|
|
>
>
>







754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
	     * request is out of range, return all 0's.
	     */

	    if (argc == 4) {
		Tcl_Free((char *)argvPtr);
	    }
	    if ((argc == 4) && (ok == TCL_OK)) {
		char buf[64 + TCL_INTEGER_SPACE * 3];
		
		sprintf(buf, "-minsize %d -pad %d -weight %d",
			slotPtr[slot].minSize,slotPtr[slot].pad,
			slotPtr[slot].weight);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
		return (TCL_OK);
	    } else if (argc == 4) {
		Tcl_SetResult(interp, "-minsize 0 -pad 0 -weight 0",
			TCL_STATIC);
		return (TCL_OK);
	    }

	    /*
	     * Loop through each option value pair, setting the values as required.
	     * If only one option is given, with no value, the current value is
	     * returned.
	     */

	    for (i=4; i<argc; i+=2) {
		length = strlen(argv[i]);
		if ((*argv[i] != '-') || length < 2) {
		    Tcl_AppendResult(interp, "invalid arg \"",
			    argv[i], "\" :expecting -minsize, -pad, or -weight.",
			    (char *) NULL);
		    Tcl_Free((char *)argvPtr);
		    return TCL_ERROR;
		}
		if (strncmp(argv[i], "-minsize", length) == 0) {
		    if (argc == 5) {
			char buf[TCL_INTEGER_SPACE];
		    	int value;

			value = (ok == TCL_OK) ? slotPtr[slot].minSize : 0;
			sprintf(buf, "%d", value);
			Tcl_SetResult(interp, buf, TCL_VOLATILE);
		    } else if (Tk_GetPixels(interp, master, argv[i+1], &size)
			    != TCL_OK) {
			Tcl_Free((char *)argvPtr);
			return TCL_ERROR;
		    } else {
			slotPtr[slot].minSize = size;
		    }
		}
		else if (strncmp(argv[i], "-weight", length) == 0) {
		    int wt;
		    if (argc == 5) {
			char buf[TCL_INTEGER_SPACE];
		    	int value;

			value = (ok == TCL_OK) ? slotPtr[slot].weight : 0;
			sprintf(buf, "%d", value);
			Tcl_SetResult(interp, buf, TCL_VOLATILE);
		    } else if (Tcl_GetInt(interp, argv[i+1], &wt) != TCL_OK) {
			Tcl_Free((char *)argvPtr);
			return TCL_ERROR;
		    } else if (wt < 0) {
			Tcl_AppendResult(interp, "invalid arg \"", argv[i],
				"\": should be non-negative", (char *) NULL);
			Tcl_Free((char *)argvPtr);
			return TCL_ERROR;
		    } else {
			slotPtr[slot].weight = wt;
		    }
		}
		else if (strncmp(argv[i], "-pad", length) == 0) {
		    if (argc == 5) {
			char buf[TCL_INTEGER_SPACE];
		    	int value;

			value = (ok == TCL_OK) ? slotPtr[slot].pad : 0;
			sprintf(buf, "%d", value);
			Tcl_SetResult(interp, buf, TCL_VOLATILE);
		    } else if (Tk_GetPixels(interp, master, argv[i+1], &size)
			    != TCL_OK) {
			Tcl_Free((char *)argvPtr);
			return TCL_ERROR;
		    } else if (size < 0) {
			Tcl_AppendResult(interp, "invalid arg \"", argv[i],
				"\": should be non-negative", (char *) NULL);
1710
1711
1712
1713
1714
1715
1716

1717
1718
1719
1720

1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
GetGrid(tkwin)
    Tk_Window tkwin;		/* Token for window for which
				 * grid structure is desired. */
{
    register Gridder *gridPtr;
    Tcl_HashEntry *hPtr;
    int new;


    if (!initialized) {
	initialized = 1;
	Tcl_InitHashTable(&gridHashTable, TCL_ONE_WORD_KEYS);

    }

    /*
     * See if there's already grid for this window.  If not,
     * then create a new one.
     */

    hPtr = Tcl_CreateHashEntry(&gridHashTable, (char *) tkwin, &new);
    if (!new) {
	return (Gridder *) Tcl_GetHashValue(hPtr);
    }
    gridPtr = (Gridder *) Tcl_Alloc(sizeof(Gridder));
    gridPtr->tkwin = tkwin;
    gridPtr->masterPtr = NULL;
    gridPtr->masterDataPtr = NULL;







>

|
<
|
>







|







1730
1731
1732
1733
1734
1735
1736
1737
1738
1739

1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
GetGrid(tkwin)
    Tk_Window tkwin;		/* Token for window for which
				 * grid structure is desired. */
{
    register Gridder *gridPtr;
    Tcl_HashEntry *hPtr;
    int new;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    if (!dispPtr->gridInit) {

	Tcl_InitHashTable(&dispPtr->gridHashTable, TCL_ONE_WORD_KEYS);
	dispPtr->gridInit = 1;
    }

    /*
     * See if there's already grid for this window.  If not,
     * then create a new one.
     */

    hPtr = Tcl_CreateHashEntry(&dispPtr->gridHashTable, (char *) tkwin, &new);
    if (!new) {
	return (Gridder *) Tcl_GetHashValue(hPtr);
    }
    gridPtr = (Gridder *) Tcl_Alloc(sizeof(Gridder));
    gridPtr->tkwin = tkwin;
    gridPtr->masterPtr = NULL;
    gridPtr->masterDataPtr = NULL;
2041
2042
2043
2044
2045
2046
2047

2048
2049
2050
2051
2052
2053
2054
static void
GridStructureProc(clientData, eventPtr)
    ClientData clientData;		/* Our information about window
					 * referred to by eventPtr. */
    XEvent *eventPtr;			/* Describes what just happened. */
{
    register Gridder *gridPtr = (Gridder *) clientData;


    if (eventPtr->type == ConfigureNotify) {
	if (!(gridPtr->flags & REQUESTED_RELAYOUT)) {
	    gridPtr->flags |= REQUESTED_RELAYOUT;
	    Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr);
	}
	if (gridPtr->doubleBw != 2*Tk_Changes(gridPtr->tkwin)->border_width) {







>







2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
static void
GridStructureProc(clientData, eventPtr)
    ClientData clientData;		/* Our information about window
					 * referred to by eventPtr. */
    XEvent *eventPtr;			/* Describes what just happened. */
{
    register Gridder *gridPtr = (Gridder *) clientData;
    TkDisplay *dispPtr = ((TkWindow *) gridPtr->tkwin)->dispPtr;

    if (eventPtr->type == ConfigureNotify) {
	if (!(gridPtr->flags & REQUESTED_RELAYOUT)) {
	    gridPtr->flags |= REQUESTED_RELAYOUT;
	    Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr);
	}
	if (gridPtr->doubleBw != 2*Tk_Changes(gridPtr->tkwin)->border_width) {
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
	for (gridPtr2 = gridPtr->slavePtr; gridPtr2 != NULL;
					   gridPtr2 = nextPtr) {
	    Tk_UnmapWindow(gridPtr2->tkwin);
	    gridPtr2->masterPtr = NULL;
	    nextPtr = gridPtr2->nextPtr;
	    gridPtr2->nextPtr = NULL;
	}
	Tcl_DeleteHashEntry(Tcl_FindHashEntry(&gridHashTable,
		(char *) gridPtr->tkwin));
	if (gridPtr->flags & REQUESTED_RELAYOUT) {
	    Tk_CancelIdleCall(ArrangeGrid, (ClientData) gridPtr);
	}
	gridPtr->tkwin = NULL;
	Tk_EventuallyFree((ClientData) gridPtr, DestroyGrid);
    } else if (eventPtr->type == MapNotify) {







|







2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
	for (gridPtr2 = gridPtr->slavePtr; gridPtr2 != NULL;
					   gridPtr2 = nextPtr) {
	    Tk_UnmapWindow(gridPtr2->tkwin);
	    gridPtr2->masterPtr = NULL;
	    nextPtr = gridPtr2->nextPtr;
	    gridPtr2->nextPtr = NULL;
	}
	Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->gridHashTable,
		(char *) gridPtr->tkwin));
	if (gridPtr->flags & REQUESTED_RELAYOUT) {
	    Tk_CancelIdleCall(ArrangeGrid, (ClientData) gridPtr);
	}
	gridPtr->tkwin = NULL;
	Tk_EventuallyFree((ClientData) gridPtr, DestroyGrid);
    } else if (eventPtr->type == MapNotify) {
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
 *	a list of slaves and configuration options, it arranges for the
 *	grid to manage the slaves and sets the specified options.
 *	arguments consist of windows or window shortcuts followed by
 *	"-option value" pairs.
 *
 * Results:
 *	TCL_OK is returned if all went well.  Otherwise, TCL_ERROR is
 *	returned and interp->result is set to contain an error message.
 *
 * Side effects:
 *	Slave windows get taken over by the grid.
 *
 *----------------------------------------------------------------------
 */








|







2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
 *	a list of slaves and configuration options, it arranges for the
 *	grid to manage the slaves and sets the specified options.
 *	arguments consist of windows or window shortcuts followed by
 *	"-option value" pairs.
 *
 * Results:
 *	TCL_OK is returned if all went well.  Otherwise, TCL_ERROR is
 *	returned and the interp's result is set to contain an error message.
 *
 * Side effects:
 *	Slave windows get taken over by the grid.
 *
 *----------------------------------------------------------------------
 */

2277
2278
2279
2280
2281
2282
2283
2284

2285
2286
2287
2288
2289
2290
2291
		slavePtr->numCols = tmp;
	    } else if ((c == 'i') && (strncmp(argv[i], "-in", length) == 0)) {
		other = Tk_NameToWindow(interp, argv[i+1], tkwin);
		if (other == NULL) {
		    return TCL_ERROR;
		}
		if (other == slave) {
		    sprintf(interp->result,"Window can't be managed in itself");

		    return TCL_ERROR;
		}
		masterPtr = GetGrid(other);
		InitMasterData(masterPtr);
	    } else if ((c == 'i')
		    && (strncmp(argv[i], "-ipadx", length) == 0)) {
		if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)







|
>







2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
		slavePtr->numCols = tmp;
	    } else if ((c == 'i') && (strncmp(argv[i], "-in", length) == 0)) {
		other = Tk_NameToWindow(interp, argv[i+1], tkwin);
		if (other == NULL) {
		    return TCL_ERROR;
		}
		if (other == slave) {
		    Tcl_SetResult(interp, "Window can't be managed in itself",
			    TCL_STATIC);
		    return TCL_ERROR;
		}
		masterPtr = GetGrid(other);
		InitMasterData(masterPtr);
	    } else if ((c == 'i')
		    && (strncmp(argv[i], "-ipadx", length) == 0)) {
		if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)

Changes to generic/tkImage.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkImage.c --
 *
 *	This module implements the image protocol, which allows lots
 *	of different kinds of images to be used in lots of different
 *	widgets.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkImage.c 1.15 97/10/09 09:57:50
 */

#include "tkInt.h"
#include "tkPort.h"

/*
 * Each call to Tk_GetImage returns a pointer to one of the following








|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkImage.c --
 *
 *	This module implements the image protocol, which allows lots
 *	of different kinds of images to be used in lots of different
 *	widgets.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkImage.c,v 1.1.4.3 1998/12/13 08:16:07 lfb Exp $
 */

#include "tkInt.h"
#include "tkPort.h"

/*
 * Each call to Tk_GetImage returns a pointer to one of the following
67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82
83
84
85
86
    Tcl_HashEntry *hPtr;	/* Hash entry in mainPtr->imageTable for
				 * this structure (used to delete the hash
				 * entry). */
    Image *instancePtr;		/* Pointer to first in list of instances
				 * derived from this name. */
} ImageMaster;

/*

 * The following variable points to the first in a list of all known
 * image types.
 */

static Tk_ImageType *imageTypeList = NULL;

/*
 * Prototypes for local procedures:
 */

static void		DeleteImage _ANSI_ARGS_((ImageMaster *masterPtr));








<
>
|
|
<
|
|







67
68
69
70
71
72
73

74
75
76

77
78
79
80
81
82
83
84
85
    Tcl_HashEntry *hPtr;	/* Hash entry in mainPtr->imageTable for
				 * this structure (used to delete the hash
				 * entry). */
    Image *instancePtr;		/* Pointer to first in list of instances
				 * derived from this name. */
} ImageMaster;


typedef struct ThreadSpecificData {
    Tk_ImageType *imageTypeList;/* First in a list of all known image 
				 * types. */  

} ThreadSpecificData;           
static Tcl_ThreadDataKey dataKey;

/*
 * Prototypes for local procedures:
 */

static void		DeleteImage _ANSI_ARGS_((ImageMaster *masterPtr));

106
107
108
109
110
111
112



113
114
115
116
117
118
119
120
121
void
Tk_CreateImageType(typePtr)
    Tk_ImageType *typePtr;	/* Structure describing the type.  All of
				 * the fields except "nextPtr" must be filled
				 * in by caller.  Must not have been passed
				 * to Tk_CreateImageType previously. */
{



    typePtr->nextPtr = imageTypeList;
    imageTypeList = typePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_ImageCmd --
 *







>
>
>
|
|







105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
void
Tk_CreateImageType(typePtr)
    Tk_ImageType *typePtr;	/* Structure describing the type.  All of
				 * the fields except "nextPtr" must be filled
				 * in by caller.  Must not have been passed
				 * to Tk_CreateImageType previously. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    typePtr->nextPtr = tsdPtr->imageTypeList;
    tsdPtr->imageTypeList = typePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_ImageCmd --
 *
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
    int c, i, new, firstOption;
    size_t length;
    Tk_ImageType *typePtr;
    ImageMaster *masterPtr;
    Image *imagePtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    char idString[30], *name;
    static int id = 0;



    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?args?\"", (char *) NULL);
	return TCL_ERROR;
    }
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 'c') && (strncmp(argv[1], "create", length) == 0)) {
	if (argc < 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " create type ?name? ?options?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	c = argv[2][0];

	/*
	 * Look up the image type.
	 */

	for (typePtr = imageTypeList; typePtr != NULL;
		typePtr = typePtr->nextPtr) {
	    if ((c == typePtr->name[0])
		    && (strcmp(argv[2], typePtr->name) == 0)) {
		break;
	    }
	}
	if (typePtr == NULL) {
	    Tcl_AppendResult(interp, "image type \"", argv[2],
		    "\" doesn't exist", (char *) NULL);
	    return TCL_ERROR;
	}

	/*
	 * Figure out a name to use for the new image.
	 */

	if ((argc == 3) || (argv[3][0] == '-')) {
	    id++;
	    sprintf(idString, "image%d", id);
	    name = idString;
	    firstOption = 3;
	} else {
	    name = argv[3];
	    firstOption = 4;
	}








|
|
>
>




















|

















|
|







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
    int c, i, new, firstOption;
    size_t length;
    Tk_ImageType *typePtr;
    ImageMaster *masterPtr;
    Image *imagePtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    char idString[16 + TCL_INTEGER_SPACE], *name;
    TkDisplay *dispPtr = winPtr->dispPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?args?\"", (char *) NULL);
	return TCL_ERROR;
    }
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 'c') && (strncmp(argv[1], "create", length) == 0)) {
	if (argc < 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " create type ?name? ?options?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	c = argv[2][0];

	/*
	 * Look up the image type.
	 */

	for (typePtr = tsdPtr->imageTypeList; typePtr != NULL;
		typePtr = typePtr->nextPtr) {
	    if ((c == typePtr->name[0])
		    && (strcmp(argv[2], typePtr->name) == 0)) {
		break;
	    }
	}
	if (typePtr == NULL) {
	    Tcl_AppendResult(interp, "image type \"", argv[2],
		    "\" doesn't exist", (char *) NULL);
	    return TCL_ERROR;
	}

	/*
	 * Figure out a name to use for the new image.
	 */

	if ((argc == 3) || (argv[3][0] == '-')) {
	    dispPtr->imageId++;
	    sprintf(idString, "image%d", dispPtr->imageId);
	    name = idString;
	    firstOption = 3;
	} else {
	    name = argv[3];
	    firstOption = 4;
	}

244
245
246
247
248
249
250

251

252
253
254
255
256
257
258
259
260
261
262
263


264
265
266
267
268
269
270
271
272
273
274
275
276

277
278
279
280
281
282
283
	}
	masterPtr->typePtr = typePtr;
	for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
		imagePtr = imagePtr->nextPtr) {
	   imagePtr->instanceData = (*typePtr->getProc)(
		   imagePtr->tkwin, masterPtr->masterData);
	}

	interp->result = Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr);

    } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
	for (i = 2; i < argc; i++) {
	    hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[i]);
	    if (hPtr == NULL) {
	    Tcl_AppendResult(interp, "image \"", argv[i],
		    "\" doesn't exist", (char *) NULL);
		return TCL_ERROR;
	    }
	    masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
	    DeleteImage(masterPtr);
	}
    } else if ((c == 'h') && (strncmp(argv[1], "height", length) == 0)) {


	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " height name\"", (char *) NULL);
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[2]);
	if (hPtr == NULL) {
	    Tcl_AppendResult(interp, "image \"", argv[2],
		    "\" doesn't exist", (char *) NULL);
	    return TCL_ERROR;
	}
	masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
	sprintf(interp->result, "%d", masterPtr->height);

    } else if ((c == 'n') && (strncmp(argv[1], "names", length) == 0)) {
	if (argc != 2) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " names\"", (char *) NULL);
	    return TCL_ERROR;
	}
	for (hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search);







>
|
>












>
>












|
>







248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
	}
	masterPtr->typePtr = typePtr;
	for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
		imagePtr = imagePtr->nextPtr) {
	   imagePtr->instanceData = (*typePtr->getProc)(
		   imagePtr->tkwin, masterPtr->masterData);
	}
	Tcl_SetResult(interp,
		Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr),
		TCL_STATIC);
    } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
	for (i = 2; i < argc; i++) {
	    hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[i]);
	    if (hPtr == NULL) {
	    Tcl_AppendResult(interp, "image \"", argv[i],
		    "\" doesn't exist", (char *) NULL);
		return TCL_ERROR;
	    }
	    masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
	    DeleteImage(masterPtr);
	}
    } else if ((c == 'h') && (strncmp(argv[1], "height", length) == 0)) {
	char buf[TCL_INTEGER_SPACE];
	
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " height name\"", (char *) NULL);
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[2]);
	if (hPtr == NULL) {
	    Tcl_AppendResult(interp, "image \"", argv[2],
		    "\" doesn't exist", (char *) NULL);
	    return TCL_ERROR;
	}
	masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
	sprintf(buf, "%d", masterPtr->height);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'n') && (strncmp(argv[1], "names", length) == 0)) {
	if (argc != 2) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " names\"", (char *) NULL);
	    return TCL_ERROR;
	}
	for (hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search);
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314


315
316
317
318
319
320
321
322
323
324
325
326
327

328
329
330
331
332
333
334
	if (hPtr == NULL) {
	    Tcl_AppendResult(interp, "image \"", argv[2],
		    "\" doesn't exist", (char *) NULL);
	    return TCL_ERROR;
	}
	masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
	if (masterPtr->typePtr != NULL) {
	    interp->result = masterPtr->typePtr->name;
	}
    } else if ((c == 't') && (strcmp(argv[1], "types") == 0)) {
	if (argc != 2) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " types\"", (char *) NULL);
	    return TCL_ERROR;
	}
	for (typePtr = imageTypeList; typePtr != NULL;
		typePtr = typePtr->nextPtr) {
	    Tcl_AppendElement(interp, typePtr->name);
	}
    } else if ((c == 'w') && (strncmp(argv[1], "width", length) == 0)) {


	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " width name\"", (char *) NULL);
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[2]);
	if (hPtr == NULL) {
	    Tcl_AppendResult(interp, "image \"", argv[2],
		    "\" doesn't exist", (char *) NULL);
	    return TCL_ERROR;
	}
	masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
	sprintf(interp->result, "%d", masterPtr->width);

    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be create, delete, height, names, type, types,",
		" or width", (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;







|







|




>
>












|
>







304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
	if (hPtr == NULL) {
	    Tcl_AppendResult(interp, "image \"", argv[2],
		    "\" doesn't exist", (char *) NULL);
	    return TCL_ERROR;
	}
	masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
	if (masterPtr->typePtr != NULL) {
	    Tcl_SetResult(interp, masterPtr->typePtr->name, TCL_STATIC);
	}
    } else if ((c == 't') && (strcmp(argv[1], "types") == 0)) {
	if (argc != 2) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " types\"", (char *) NULL);
	    return TCL_ERROR;
	}
	for (typePtr = tsdPtr->imageTypeList; typePtr != NULL;
		typePtr = typePtr->nextPtr) {
	    Tcl_AppendElement(interp, typePtr->name);
	}
    } else if ((c == 'w') && (strncmp(argv[1], "width", length) == 0)) {
	char buf[TCL_INTEGER_SPACE];

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " width name\"", (char *) NULL);
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[2]);
	if (hPtr == NULL) {
	    Tcl_AppendResult(interp, "image \"", argv[2],
		    "\" doesn't exist", (char *) NULL);
	    return TCL_ERROR;
	}
	masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
	sprintf(buf, "%d", masterPtr->width);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be create, delete, height, names, type, types,",
		" or width", (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
 *
 *	This procedure is invoked by a widget when it wants to use
 *	a particular image in a particular window.
 *
 * Results:
 *	The return value is a token for the image.  If there is no image
 *	by the given name, then NULL is returned and an error message is
 *	left in interp->result.
 *
 * Side effects:
 *	Tk records the fact that the widget is using the image, and
 *	it will invoke changeProc later if the widget needs redisplay
 *	(i.e. its size changes or some of its pixels change).  The
 *	caller must eventually invoke Tk_FreeImage when it no longer
 *	needs the image.







|







424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
 *
 *	This procedure is invoked by a widget when it wants to use
 *	a particular image in a particular window.
 *
 * Results:
 *	The return value is a token for the image.  If there is no image
 *	by the given name, then NULL is returned and an error message is
 *	left in the interp's result.
 *
 * Side effects:
 *	Tk records the fact that the widget is using the image, and
 *	it will invoke changeProc later if the widget needs redisplay
 *	(i.e. its size changes or some of its pixels change).  The
 *	caller must eventually invoke Tk_FreeImage when it no longer
 *	needs the image.

Changes to generic/tkImgBmap.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkImgBmap.c --
 *
 *	This procedure implements images of type "bitmap" for Tk.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkImgBmap.c 1.33 97/07/31 09:08:22
 */

#include "tkInt.h"
#include "tkPort.h"

/*
 * The following data structure represents the master for a bitmap











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkImgBmap.c --
 *
 *	This procedure implements images of type "bitmap" for Tk.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkImgBmap.c,v 1.1.4.3 1999/02/11 04:13:46 stanton Exp $
 */

#include "tkInt.h"
#include "tkPort.h"

/*
 * The following data structure represents the master for a bitmap
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
 *
 *	This procedure is called when a bitmap image is created or
 *	reconfigured.  It process configuration options and resets
 *	any instances of the image.
 *
 * Results:
 *	A standard Tcl return value.  If TCL_ERROR is returned then
 *	an error message is left in masterPtr->interp->result.
 *
 * Side effects:
 *	Existing instances of the image will be redisplayed to match
 *	the new configuration options.
 *
 *----------------------------------------------------------------------
 */







|







223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
 *
 *	This procedure is called when a bitmap image is created or
 *	reconfigured.  It process configuration options and resets
 *	any instances of the image.
 *
 * Results:
 *	A standard Tcl return value.  If TCL_ERROR is returned then
 *	an error message is left in the masterPtr->interp's result.
 *
 * Side effects:
 *	Existing instances of the image will be redisplayed to match
 *	the new configuration options.
 *
 *----------------------------------------------------------------------
 */
274
275
276
277
278
279
280
281

282
283
284
285
286
287
288
289
290
291
292
293

294
295
296
297
298
299
300
301
    if (masterPtr->maskData != NULL) {
	ckfree(masterPtr->maskData);
	masterPtr->maskData = NULL;
    }
    if ((masterPtr->maskFileString != NULL)
	    || (masterPtr->maskDataString != NULL)) {
	if (masterPtr->data == NULL) {
	    masterPtr->interp->result = "can't have mask without bitmap";

	    return TCL_ERROR;
	}
	masterPtr->maskData = TkGetBitmapData(masterPtr->interp,
		masterPtr->maskDataString, masterPtr->maskFileString,
		&maskWidth, &maskHeight, &dummy1, &dummy2);
	if (masterPtr->maskData == NULL) {
	    return TCL_ERROR;
	}
	if ((maskWidth != masterPtr->width)
		|| (maskHeight != masterPtr->height)) {
	    ckfree(masterPtr->maskData);
	    masterPtr->maskData = NULL;

	    masterPtr->interp->result = "bitmap and mask have different sizes";
	    return TCL_ERROR;
	}
    }

    /*
     * Cycle through all of the instances of this image, regenerating
     * the information for each instance.  Then force the image to be







|
>












>
|







274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
    if (masterPtr->maskData != NULL) {
	ckfree(masterPtr->maskData);
	masterPtr->maskData = NULL;
    }
    if ((masterPtr->maskFileString != NULL)
	    || (masterPtr->maskDataString != NULL)) {
	if (masterPtr->data == NULL) {
	    Tcl_SetResult(masterPtr->interp, "can't have mask without bitmap",
		    TCL_STATIC);
	    return TCL_ERROR;
	}
	masterPtr->maskData = TkGetBitmapData(masterPtr->interp,
		masterPtr->maskDataString, masterPtr->maskFileString,
		&maskWidth, &maskHeight, &dummy1, &dummy2);
	if (masterPtr->maskData == NULL) {
	    return TCL_ERROR;
	}
	if ((maskWidth != masterPtr->width)
		|| (maskHeight != masterPtr->height)) {
	    ckfree(masterPtr->maskData);
	    masterPtr->maskData = NULL;
	    Tcl_SetResult(masterPtr->interp,
		    "bitmap and mask have different sizes", TCL_STATIC);
	    return TCL_ERROR;
	}
    }

    /*
     * Cycle through all of the instances of this image, regenerating
     * the information for each instance.  Then force the image to be
336
337
338
339
340
341
342

343
344
345
346
347
348
349
    BitmapInstance *instancePtr;	/* Instance to reconfigure. */
{
    BitmapMaster *masterPtr = instancePtr->masterPtr;
    XColor *colorPtr;
    XGCValues gcValues;
    GC gc;
    unsigned int mask;


    /*
     * For each of the options in masterPtr, translate the string
     * form into an internal form appropriate for instancePtr.
     */

    if (*masterPtr->bgUid != 0) {







>







338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
    BitmapInstance *instancePtr;	/* Instance to reconfigure. */
{
    BitmapMaster *masterPtr = instancePtr->masterPtr;
    XColor *colorPtr;
    XGCValues gcValues;
    GC gc;
    unsigned int mask;
    Pixmap oldMask;

    /*
     * For each of the options in masterPtr, translate the string
     * form into an internal form appropriate for instancePtr.
     */

    if (*masterPtr->bgUid != 0) {
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
	instancePtr->bitmap = XCreateBitmapFromData(
		Tk_Display(instancePtr->tkwin),
		RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)),
		masterPtr->data, (unsigned) masterPtr->width,
		(unsigned) masterPtr->height);
    }







    if (instancePtr->mask != None) {
	Tk_FreePixmap(Tk_Display(instancePtr->tkwin), instancePtr->mask);
	instancePtr->mask = None;
    }
    if (masterPtr->maskData != NULL) {
	instancePtr->mask = XCreateBitmapFromData(
		Tk_Display(instancePtr->tkwin),
		RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)),
		masterPtr->maskData, (unsigned) masterPtr->width,
		(unsigned) masterPtr->height);
    }




    if (masterPtr->data != NULL) {
	gcValues.foreground = instancePtr->fg->pixel;
	gcValues.graphics_exposures = False;
	mask = GCForeground|GCGraphicsExposures;
	if (instancePtr->bg != NULL) {
	    gcValues.background = instancePtr->bg->pixel;







>
>
>
>
>
>
|
<
|
<







>
>
>







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
	instancePtr->bitmap = XCreateBitmapFromData(
		Tk_Display(instancePtr->tkwin),
		RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)),
		masterPtr->data, (unsigned) masterPtr->width,
		(unsigned) masterPtr->height);
    }

    /*
     * Careful:  We have to allocate a new mask Pixmap before deleting
     * the old one.  Otherwise, The XID allocator will always return
     * the same XID for the new Pixmap as was used for the old Pixmap.
     * And that will prevent the mask from changing in the GC below.
     */
    oldMask = instancePtr->mask;

    instancePtr->mask = None;

    if (masterPtr->maskData != NULL) {
	instancePtr->mask = XCreateBitmapFromData(
		Tk_Display(instancePtr->tkwin),
		RootWindowOfScreen(Tk_Screen(instancePtr->tkwin)),
		masterPtr->maskData, (unsigned) masterPtr->width,
		(unsigned) masterPtr->height);
    }
    if (oldMask != None) {
      Tk_FreePixmap(Tk_Display(instancePtr->tkwin), oldMask);
    }

    if (masterPtr->data != NULL) {
	gcValues.foreground = instancePtr->fg->pixel;
	gcValues.graphics_exposures = False;
	mask = GCForeground|GCGraphicsExposures;
	if (instancePtr->bg != NULL) {
	    gcValues.background = instancePtr->bg->pixel;
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495

496
497
498


499
500
501
502
503
504
505
 * Results:
 *	If the bitmap description was parsed successfully then the
 *	return value is a malloc-ed array containing the bitmap data.
 *	The dimensions of the data are stored in *widthPtr and
 *	*heightPtr.  *hotXPtr and *hotYPtr are set to the bitmap
 *	hotspot if one is defined, otherwise they are set to -1, -1.
 *	If an error occurred, NULL is returned and an error message is
 *	left in interp->result.
 *
 * Side effects:
 *	A bitmap is created.
 *
 *----------------------------------------------------------------------
 */

char *
TkGetBitmapData(interp, string, fileName, widthPtr, heightPtr,
	hotXPtr, hotYPtr)
    Tcl_Interp *interp;			/* For reporting errors. */
    char *string;			/* String describing bitmap.  May
					 * be NULL. */
    char *fileName;			/* Name of file containing bitmap
					 * description.  Used only if string
					 * is NULL.  Must not be NULL if
					 * string is NULL. */
    int *widthPtr, *heightPtr;		/* Dimensions of bitmap get returned
					 * here. */
    int *hotXPtr, *hotYPtr;		/* Position of hot spot or -1,-1. */
{
    int width, height, numBytes, hotX, hotY;
    char *p, *end, *expandedFileName;
    ParseInfo pi;
    char *data = NULL;
    Tcl_DString buffer;

    pi.string = string;
    if (string == NULL) {
        if (Tcl_IsSafe(interp)) {
            Tcl_AppendResult(interp, "can't get bitmap data from a file in a",
                    " safe interpreter", (char *) NULL);
            return NULL;
        }
	expandedFileName = Tcl_TranslateFileName(interp, fileName, &buffer);
	if (expandedFileName == NULL) {
	    return NULL;
	}
	pi.chan = Tcl_OpenFileChannel(interp, expandedFileName, "r", 0);
	Tcl_DStringFree(&buffer);
	if (pi.chan == NULL) {

	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "couldn't read bitmap file \"",
		    fileName, "\": ", Tcl_PosixError(interp), (char *) NULL);


	    return NULL;
	}
    } else {
	pi.chan = NULL;
    }

    /*







|










|


















|











>
|
|
|
>
>







457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
 * Results:
 *	If the bitmap description was parsed successfully then the
 *	return value is a malloc-ed array containing the bitmap data.
 *	The dimensions of the data are stored in *widthPtr and
 *	*heightPtr.  *hotXPtr and *hotYPtr are set to the bitmap
 *	hotspot if one is defined, otherwise they are set to -1, -1.
 *	If an error occurred, NULL is returned and an error message is
 *	left in the interp's result.
 *
 * Side effects:
 *	A bitmap is created.
 *
 *----------------------------------------------------------------------
 */

char *
TkGetBitmapData(interp, string, fileName, widthPtr, heightPtr,
	hotXPtr, hotYPtr)
    Tcl_Interp *interp;			/* For reporting errors, or NULL. */
    char *string;			/* String describing bitmap.  May
					 * be NULL. */
    char *fileName;			/* Name of file containing bitmap
					 * description.  Used only if string
					 * is NULL.  Must not be NULL if
					 * string is NULL. */
    int *widthPtr, *heightPtr;		/* Dimensions of bitmap get returned
					 * here. */
    int *hotXPtr, *hotYPtr;		/* Position of hot spot or -1,-1. */
{
    int width, height, numBytes, hotX, hotY;
    char *p, *end, *expandedFileName;
    ParseInfo pi;
    char *data = NULL;
    Tcl_DString buffer;

    pi.string = string;
    if (string == NULL) {
        if ((interp != NULL) && Tcl_IsSafe(interp)) {
            Tcl_AppendResult(interp, "can't get bitmap data from a file in a",
                    " safe interpreter", (char *) NULL);
            return NULL;
        }
	expandedFileName = Tcl_TranslateFileName(interp, fileName, &buffer);
	if (expandedFileName == NULL) {
	    return NULL;
	}
	pi.chan = Tcl_OpenFileChannel(interp, expandedFileName, "r", 0);
	Tcl_DStringFree(&buffer);
	if (pi.chan == NULL) {
	    if (interp != NULL) {
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "couldn't read bitmap file \"",
			fileName, "\": ", Tcl_PosixError(interp),
			(char *) NULL);
	    }
	    return NULL;
	}
    } else {
	pi.chan = NULL;
    }

    /*
569
570
571
572
573
574
575

576
577
578

579
580
581
582
583
584
585
		    goto error;
		}
		if ((pi.word[0] == '{') && (pi.word[1] == 0)) {
		    goto getData;
		}
	    }
	} else if ((pi.word[0] == '{') && (pi.word[1] == 0)) {

	    Tcl_AppendResult(interp, "format error in bitmap data; ",
		    "looks like it's an obsolete X10 bitmap file",
		    (char *) NULL);

	    goto errorCleanup;
	}
    }

    /*
     * Now we've read everything but the data.  Allocate an array
     * and read in the data.







>
|
|
|
>







582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
		    goto error;
		}
		if ((pi.word[0] == '{') && (pi.word[1] == 0)) {
		    goto getData;
		}
	    }
	} else if ((pi.word[0] == '{') && (pi.word[1] == 0)) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "format error in bitmap data; ",
			"looks like it's an obsolete X10 bitmap file",
			(char *) NULL);
	    }
	    goto errorCleanup;
	}
    }

    /*
     * Now we've read everything but the data.  Allocate an array
     * and read in the data.
611
612
613
614
615
616
617
618

619
620
621
622
623
624
625
    *widthPtr = width;
    *heightPtr = height;
    *hotXPtr = hotX;
    *hotYPtr = hotY;
    return data;

    error:
    interp->result = "format error in bitmap data";

    errorCleanup:
    if (data != NULL) {
	ckfree(data);
    }
    if (pi.chan != NULL) {
	Tcl_Close(NULL, pi.chan);
    }







|
>







626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
    *widthPtr = width;
    *heightPtr = height;
    *hotXPtr = hotX;
    *hotYPtr = hotY;
    return data;

    error:
    Tcl_SetResult(interp, "format error in bitmap data", TCL_STATIC);

    errorCleanup:
    if (data != NULL) {
	ckfree(data);
    }
    if (pi.chan != NULL) {
	Tcl_Close(NULL, pi.chan);
    }
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
    char **argv;		/* Argument strings. */
{
    BitmapMaster *masterPtr = (BitmapMaster *) clientData;
    int c, code;
    size_t length;

    if (argc < 2) {
	sprintf(interp->result,
		"wrong # args: should be \"%.50s option ?arg arg ...?\"",
		argv[0]);
	return TCL_ERROR;
    }
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
	    && (length >= 2)) {
	if (argc != 3) {







|
|
<







737
738
739
740
741
742
743
744
745

746
747
748
749
750
751
752
    char **argv;		/* Argument strings. */
{
    BitmapMaster *masterPtr = (BitmapMaster *) clientData;
    int c, code;
    size_t length;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?arg arg ...?\"", (char *) NULL);

	return TCL_ERROR;
    }
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
	    && (length >= 2)) {
	if (argc != 3) {

Changes to generic/tkImgGIF.c.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 * |   and its documentation for any purpose and without fee is hereby |
 * |   granted, provided that the above copyright notice appear in all |
 * |   copies and that both that copyright notice and this permission  |
 * |   notice appear in supporting documentation.  This software is    |
 * |   provided "as is" without express or implied warranty.           |
 * +-------------------------------------------------------------------+
 *
 * SCCS: @(#) tkImgGIF.c 1.19 97/08/13 15:23:45
 */

/*
 * GIF's are represented as data in base64 format.
 * base64 strings consist of 4 6-bit characters -> 3 8 bit bytes.
 * A-Z, a-z, 0-9, + and / represent the 64 values (in order).
 * '=' is a trailing padding char when the un-encoded data is not a







|







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 * |   and its documentation for any purpose and without fee is hereby |
 * |   granted, provided that the above copyright notice appear in all |
 * |   copies and that both that copyright notice and this permission  |
 * |   notice appear in supporting documentation.  This software is    |
 * |   provided "as is" without express or implied warranty.           |
 * +-------------------------------------------------------------------+
 *
 * RCS: @(#) $Id: tkImgGIF.c,v 1.1.4.3 1998/12/13 08:16:07 lfb Exp $
 */

/*
 * GIF's are represented as data in base64 format.
 * base64 strings consist of 4 6-bit characters -> 3 8 bit bytes.
 * A-Z, a-z, 0-9, + and / represent the 64 values (in order).
 * '=' is a trailing padding char when the un-encoded data is not a
56
57
58
59
60
61
62











63
64
65
66
67
68
69
    int c;			/* bits left over from previous character */
    int state;			/* decoder state (0-4 or GIF_DONE) */
} MFile;

#include "tkInt.h"
#include "tkPort.h"












/*
 * The format record for the GIF file format:
 */

static int      FileMatchGIF _ANSI_ARGS_((Tcl_Channel chan, char *fileName,
		    char *formatString, int *widthPtr, int *heightPtr));
static int      FileReadGIF  _ANSI_ARGS_((Tcl_Interp *interp,







>
>
>
>
>
>
>
>
>
>
>







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
    int c;			/* bits left over from previous character */
    int state;			/* decoder state (0-4 or GIF_DONE) */
} MFile;

#include "tkInt.h"
#include "tkPort.h"

/*
 * 			 HACK ALERT!!  HACK ALERT!!  HACK ALERT!!
 * This code is hard-wired for reading from files.  In order to read
 * from a data stream, we'll trick fread so we can reuse the same code
 */

typedef struct ThreadSpecificData {
    int fromData;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * The format record for the GIF file format:
 */

static int      FileMatchGIF _ANSI_ARGS_((Tcl_Channel chan, char *fileName,
		    char *formatString, int *widthPtr, int *heightPtr));
static int      FileReadGIF  _ANSI_ARGS_((Tcl_Interp *interp,
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
#define CM_GREEN		1
#define CM_BLUE			2
#define CM_ALPHA		3
#define MAX_LWZ_BITS		12
#define LM_to_uint(a,b)         (((b)<<8)|(a))
#define ReadOK(file,buffer,len)	(Fread(buffer, len, 1, file) != 0)

/*
 * 			 HACK ALERT!!  HACK ALERT!!  HACK ALERT!!
 * This code is hard-wired for reading from files.  In order to read
 * from a data stream, we'll trick fread so we can reuse the same code
 */
 
static int fromData=0;

/*
 * Prototypes for local procedures defined in this file:
 */

static int		DoExtension _ANSI_ARGS_((Tcl_Channel chan, int label,
			    int *transparent));
static int		GetCode _ANSI_ARGS_((Tcl_Channel chan, int code_size,







<
<
<
<
<
<
<
<







106
107
108
109
110
111
112








113
114
115
116
117
118
119
#define CM_GREEN		1
#define CM_BLUE			2
#define CM_ALPHA		3
#define MAX_LWZ_BITS		12
#define LM_to_uint(a,b)         (((b)<<8)|(a))
#define ReadOK(file,buffer,len)	(Fread(buffer, len, 1, file) != 0)









/*
 * Prototypes for local procedures defined in this file:
 */

static int		DoExtension _ANSI_ARGS_((Tcl_Channel chan, int label,
			    int *transparent));
static int		GetCode _ANSI_ARGS_((Tcl_Channel chan, int code_size,
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
 *
 *	This procedure is called by the photo image type to read
 *	GIF format data from a file and write it into a given
 *	photo image.
 *
 * Results:
 *	A standard TCL completion code.  If TCL_ERROR is returned
 *	then an error message is left in interp->result.
 *
 * Side effects:
 *	The access position in file f is changed, and new data is
 *	added to the image given by imageHandle.
 *
 *----------------------------------------------------------------------
 */







|







183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
 *
 *	This procedure is called by the photo image type to read
 *	GIF format data from a file and write it into a given
 *	photo image.
 *
 * Results:
 *	A standard TCL completion code.  If TCL_ERROR is returned
 *	then an error message is left in the interp's result.
 *
 * Side effects:
 *	The access position in file f is changed, and new data is
 *	added to the image given by imageHandle.
 *
 *----------------------------------------------------------------------
 */
283
284
285
286
287
288
289
290
291

292
293
294
295

296
297
298
299
300
301
302
303
304
305
306
307
308

309

310
311
312
313
314
315
316

	if (buf[0] == '!') {
	    /*
	     * This is a GIF extension.
	     */

	    if (Fread(buf, 1, 1, chan) != 1) {
		interp->result =
			"error reading extension function code in GIF image";

		goto error;
	    }
	    if (DoExtension(chan, buf[0], &transparent) < 0) {
		interp->result = "error reading extension in GIF image";

		goto error;
	    }
	    continue;
	}

	if (buf[0] != ',') {
	    /*
	     * Not a valid start character; ignore it.
	     */
	    continue;
	}

	if (Fread(buf, 1, 9, chan) != 9) {

	    interp->result = "couldn't read left/top/width/height in GIF image";

	    goto error;
	}

	bitPixel = 1<<((buf[8]&0x07)+1);

	if (BitSet(buf[8], LOCALCOLORMAP)) {
	    if (!ReadColorMap(chan, bitPixel, colorMap)) {







|
|
>



|
>













>
|
>







286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323

	if (buf[0] == '!') {
	    /*
	     * This is a GIF extension.
	     */

	    if (Fread(buf, 1, 1, chan) != 1) {
		Tcl_SetResult(interp,
			"error reading extension function code in GIF image",
			TCL_STATIC);
		goto error;
	    }
	    if (DoExtension(chan, buf[0], &transparent) < 0) {
		Tcl_SetResult(interp, "error reading extension in GIF image",
			TCL_STATIC);
		goto error;
	    }
	    continue;
	}

	if (buf[0] != ',') {
	    /*
	     * Not a valid start character; ignore it.
	     */
	    continue;
	}

	if (Fread(buf, 1, 9, chan) != 9) {
	    Tcl_SetResult(interp,
		    "couldn't read left/top/width/height in GIF image",
		    TCL_STATIC);
	    goto error;
	}

	bitPixel = 1<<((buf[8]&0x07)+1);

	if (BitSet(buf[8], LOCALCOLORMAP)) {
	    if (!ReadColorMap(chan, bitPixel, colorMap)) {
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
 *
 *	This procedure is called by the photo image type to read
 *	GIF format data from a base64 encoded string, and give it to
 *	the photo image.
 *
 * Results:
 *	A standard TCL completion code.  If TCL_ERROR is returned
 *	then an error message is left in interp->result.
 *
 * Side effects:
 *	new data is added to the image given by imageHandle.  This
 *	procedure calls FileReadGif by redefining the operation of
 *	fprintf temporarily.
 *
 *----------------------------------------------------------------------
 */

static int
StringReadGIF(interp,string,formatString,imageHandle,
	destX, destY, width, height, srcX, srcY)
    Tcl_Interp *interp;		/* interpreter for reporting errors in */
    char *string;		/* string containing the image */
    char *formatString;		/* format string if any */
    Tk_PhotoHandle imageHandle;	/* the image to write this data into */
    int destX, destY;		/* The rectangular region of the  */
    int  width, height;		/*   image to copy */
    int srcX, srcY;
{
	int result;
	MFile handle;



	mInit((unsigned char *)string,&handle);
	fromData = 1;
	result = FileReadGIF(interp, (Tcl_Channel) &handle, "inline data",
		formatString, imageHandle, destX, destY, width, height,
		srcX, srcY);
	fromData = 0;
	return(result);
}

/*
 *----------------------------------------------------------------------
 *
 * ReadGIFHeader --
 *







|




















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







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
 *
 *	This procedure is called by the photo image type to read
 *	GIF format data from a base64 encoded string, and give it to
 *	the photo image.
 *
 * Results:
 *	A standard TCL completion code.  If TCL_ERROR is returned
 *	then an error message is left in the interp's result.
 *
 * Side effects:
 *	new data is added to the image given by imageHandle.  This
 *	procedure calls FileReadGif by redefining the operation of
 *	fprintf temporarily.
 *
 *----------------------------------------------------------------------
 */

static int
StringReadGIF(interp,string,formatString,imageHandle,
	destX, destY, width, height, srcX, srcY)
    Tcl_Interp *interp;		/* interpreter for reporting errors in */
    char *string;		/* string containing the image */
    char *formatString;		/* format string if any */
    Tk_PhotoHandle imageHandle;	/* the image to write this data into */
    int destX, destY;		/* The rectangular region of the  */
    int  width, height;		/*   image to copy */
    int srcX, srcY;
{
    int result;
    MFile handle;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    mInit((unsigned char *)string,&handle);
    tsdPtr->fromData = 1;
    result = FileReadGIF(interp, (Tcl_Channel) &handle, "inline data",
            formatString, imageHandle, destX, destY, width, height,
            srcX, srcY);
    tsdPtr->fromData = 0;
    return(result);
}

/*
 *----------------------------------------------------------------------
 *
 * ReadGIFHeader --
 *
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
    if (! ReadOK(chan, &c, 1))  {
	Tcl_AppendResult(interp, "error reading GIF image: ",
		Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
    }

    if (LWZReadByte(chan, 1, c) < 0) {
	interp->result = "format error in GIF image";
	return TCL_ERROR;
    }

    if (transparent!=-1) {
	cmap[transparent][CM_RED] = 0;
	cmap[transparent][CM_GREEN] = 0;
	cmap[transparent][CM_BLUE] = 0;







|







625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
    if (! ReadOK(chan, &c, 1))  {
	Tcl_AppendResult(interp, "error reading GIF image: ",
		Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
    }

    if (LWZReadByte(chan, 1, c) < 0) {
	Tcl_SetResult(interp, "format error in GIF image", TCL_STATIC);
	return TCL_ERROR;
    }

    if (transparent!=-1) {
	cmap[transparent][CM_RED] = 0;
	cmap[transparent][CM_GREEN] = 0;
	cmap[transparent][CM_BLUE] = 0;
1047
1048
1049
1050
1051
1052
1053



1054
1055
1056
1057
1058
1059

static int
Fread(dst, hunk, count, chan)
    unsigned char *dst;		/* where to put the result */
    size_t hunk,count;		/* how many */
    Tcl_Channel chan;
{



    if (fromData) {
	return(Mread(dst, hunk, count, (MFile *) chan));
    } else {
	return Tcl_Read(chan, (char *) dst, (int) (hunk * count));
    }
}







>
>
>
|





1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072

static int
Fread(dst, hunk, count, chan)
    unsigned char *dst;		/* where to put the result */
    size_t hunk,count;		/* how many */
    Tcl_Channel chan;
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (tsdPtr->fromData) {
	return(Mread(dst, hunk, count, (MFile *) chan));
    } else {
	return Tcl_Read(chan, (char *) dst, (int) (hunk * count));
    }
}

Changes to generic/tkImgPPM.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * Author: Paul Mackerras ([email protected]),
 *	   Department of Computer Science,
 *	   Australian National University.
 *
 * SCCS: @(#) tkImgPPM.c 1.16 97/10/28 14:51:46
 */

#include "tkInt.h"
#include "tkPort.h"

/*
 * The maximum amount of memory to allocate for data read from the







|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * Author: Paul Mackerras ([email protected]),
 *	   Department of Computer Science,
 *	   Australian National University.
 *
 * RCS: @(#) $Id: tkImgPPM.c,v 1.1.4.2 1998/09/30 02:17:03 stanton Exp $
 */

#include "tkInt.h"
#include "tkPort.h"

/*
 * The maximum amount of memory to allocate for data read from the
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
 *
 *	This procedure is called by the photo image type to read
 *	PPM format data from a file and write it into a given
 *	photo image.
 *
 * Results:
 *	A standard TCL completion code.  If TCL_ERROR is returned
 *	then an error message is left in interp->result.
 *
 * Side effects:
 *	The access position in file f is changed, and new data is
 *	added to the image given by imageHandle.
 *
 *----------------------------------------------------------------------
 */







|







106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
 *
 *	This procedure is called by the photo image type to read
 *	PPM format data from a file and write it into a given
 *	photo image.
 *
 * Results:
 *	A standard TCL completion code.  If TCL_ERROR is returned
 *	then an error message is left in the interp's result.
 *
 * Side effects:
 *	The access position in file f is changed, and new data is
 *	added to the image given by imageHandle.
 *
 *----------------------------------------------------------------------
 */
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
    }
    if ((fileWidth <= 0) || (fileHeight <= 0)) {
	Tcl_AppendResult(interp, "PPM image file \"", fileName,
		"\" has dimension(s) <= 0", (char *) NULL);
	return TCL_ERROR;
    }
    if ((maxIntensity <= 0) || (maxIntensity >= 256)) {
	char buffer[30];

	sprintf(buffer, "%d", maxIntensity);
	Tcl_AppendResult(interp, "PPM image file \"", fileName,
		"\" has bad maximum intensity value ", buffer,
		(char *) NULL);
	return TCL_ERROR;
    }







|







147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
    }
    if ((fileWidth <= 0) || (fileHeight <= 0)) {
	Tcl_AppendResult(interp, "PPM image file \"", fileName,
		"\" has dimension(s) <= 0", (char *) NULL);
	return TCL_ERROR;
    }
    if ((maxIntensity <= 0) || (maxIntensity >= 256)) {
	char buffer[TCL_INTEGER_SPACE];

	sprintf(buffer, "%d", maxIntensity);
	Tcl_AppendResult(interp, "PPM image file \"", fileName,
		"\" has bad maximum intensity value ", buffer,
		(char *) NULL);
	return TCL_ERROR;
    }
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
 * FileWritePPM --
 *
 *	This procedure is invoked to write image data to a file in PPM
 *	format.
 *
 * Results:
 *	A standard TCL completion code.  If TCL_ERROR is returned
 *	then an error message is left in interp->result.
 *
 * Side effects:
 *	Data is written to the file given by "fileName".
 *
 *----------------------------------------------------------------------
 */

static int
FileWritePPM(interp, fileName, formatString, blockPtr)
    Tcl_Interp *interp;
    char *fileName;
    char *formatString;
    Tk_PhotoImageBlock *blockPtr;
{
    Tcl_Channel chan;
    int w, h;
    int greenOffset, blueOffset, nBytes;
    unsigned char *pixelPtr, *pixLinePtr;
    char header[30];

    chan = Tcl_OpenFileChannel(interp, fileName, "w", 0666);
    if (chan == NULL) {
	return TCL_ERROR;
    }

    sprintf(header, "P6\n%d %d\n255\n", blockPtr->width, blockPtr->height);







|


















|







239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
 * FileWritePPM --
 *
 *	This procedure is invoked to write image data to a file in PPM
 *	format.
 *
 * Results:
 *	A standard TCL completion code.  If TCL_ERROR is returned
 *	then an error message is left in the interp's result.
 *
 * Side effects:
 *	Data is written to the file given by "fileName".
 *
 *----------------------------------------------------------------------
 */

static int
FileWritePPM(interp, fileName, formatString, blockPtr)
    Tcl_Interp *interp;
    char *fileName;
    char *formatString;
    Tk_PhotoImageBlock *blockPtr;
{
    Tcl_Channel chan;
    int w, h;
    int greenOffset, blueOffset, nBytes;
    unsigned char *pixelPtr, *pixLinePtr;
    char header[16 + TCL_INTEGER_SPACE * 2];

    chan = Tcl_OpenFileChannel(interp, fileName, "w", 0666);
    if (chan == NULL) {
	return TCL_ERROR;
    }

    sprintf(header, "P6\n%d %d\n255\n", blockPtr->width, blockPtr->height);

Changes to generic/tkImgPhoto.c.

11
12
13
14
15
16
17
18
19
20
21
22
23
24




25
26
27
28
29
30
31
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * Author: Paul Mackerras ([email protected]),
 *	   Department of Computer Science,
 *	   Australian National University.
 *
 * SCCS: @(#) tkImgPhoto.c 1.60 97/08/08 11:32:46
 */

#include "tkInt.h"
#include "tkPort.h"
#include "tclMath.h"
#include <ctype.h>





/*
 * Declaration for internal Xlib function used here:
 */

extern _XInitImageFuncPtrs _ANSI_ARGS_((XImage *image));








|






>
>
>
>







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
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * Author: Paul Mackerras ([email protected]),
 *	   Department of Computer Science,
 *	   Australian National University.
 *
 * RCS: @(#) $Id: tkImgPhoto.c,v 1.1.4.5 1999/03/10 07:13:40 stanton Exp $
 */

#include "tkInt.h"
#include "tkPort.h"
#include "tclMath.h"
#include <ctype.h>

#ifdef __WIN32__
#include "tkWinInt.h"
#endif

/*
 * Declaration for internal Xlib function used here:
 */

extern _XInitImageFuncPtrs _ANSI_ARGS_((XImage *image));

121
122
123
124
125
126
127



128
129
130
131
132
133
134
 *				allocated.
 * DISPOSE_PENDING:		1 means a call to DisposeColorTable has
 *				been scheduled as an idle handler, but it
 *				hasn't been invoked yet.
 * MAP_COLORS:			1 means pixel values should be mapped
 *				through pixelMap.
 */




#define BLACK_AND_WHITE		1
#define COLOR_WINDOW		2
#define DISPOSE_PENDING		4
#define MAP_COLORS		8

/*







>
>
>







125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
 *				allocated.
 * DISPOSE_PENDING:		1 means a call to DisposeColorTable has
 *				been scheduled as an idle handler, but it
 *				hasn't been invoked yet.
 * MAP_COLORS:			1 means pixel values should be mapped
 *				through pixelMap.
 */
#ifdef COLOR_WINDOW
#undef COLOR_WINDOW
#endif

#define BLACK_AND_WHITE		1
#define COLOR_WINDOW		2
#define DISPOSE_PENDING		4
#define MAP_COLORS		8

/*
286
287
288
289
290
291
292






293
294
295
296
297
298
299
    ImgPhotoGet,		/* getProc */
    ImgPhotoDisplay,		/* displayProc */
    ImgPhotoFree,		/* freeProc */
    ImgPhotoDelete,		/* deleteProc */
    (Tk_ImageType *) NULL	/* nextPtr */
};







/*
 * Default configuration
 */

#define DEF_PHOTO_GAMMA		"1"
#define DEF_PHOTO_HEIGHT	"0"
#define DEF_PHOTO_PALETTE	""







>
>
>
>
>
>







293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
    ImgPhotoGet,		/* getProc */
    ImgPhotoDisplay,		/* displayProc */
    ImgPhotoFree,		/* freeProc */
    ImgPhotoDelete,		/* deleteProc */
    (Tk_ImageType *) NULL	/* nextPtr */
};

typedef struct ThreadSpecificData {
    Tk_PhotoImageFormat *formatList;  /* Pointer to the first in the 
				       * list of known photo image formats.*/
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Default configuration
 */

#define DEF_PHOTO_GAMMA		"1"
#define DEF_PHOTO_HEIGHT	"0"
#define DEF_PHOTO_PALETTE	""
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
 * to ColorTable address.
 */

static Tcl_HashTable imgPhotoColorHash;
static int imgPhotoColorHashInitialized;
#define N_COLOR_HASH	(sizeof(ColorTableId) / sizeof(int))

/*
 * Pointer to the first in the list of known photo image formats.
 */

static Tk_PhotoImageFormat *formatList = NULL;

/*
 * Forward declarations
 */

static int		ImgPhotoCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
static int		ParseSubcommandOptions _ANSI_ARGS_((







<
<
<
<
<
<







339
340
341
342
343
344
345






346
347
348
349
350
351
352
 * to ColorTable address.
 */

static Tcl_HashTable imgPhotoColorHash;
static int imgPhotoColorHashInitialized;
#define N_COLOR_HASH	(sizeof(ColorTableId) / sizeof(int))







/*
 * Forward declarations
 */

static int		ImgPhotoCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
static int		ParseSubcommandOptions _ANSI_ARGS_((
357
358
359
360
361
362
363
364

365
366
367
368
369
370
371
			    int width, int height));
static void		ImgPhotoInstanceSetSize _ANSI_ARGS_((
			    PhotoInstance *instancePtr));
static int		IsValidPalette _ANSI_ARGS_((PhotoInstance *instancePtr,
			    char *palette));
static int		CountBits _ANSI_ARGS_((pixel mask));
static void		GetColorTable _ANSI_ARGS_((PhotoInstance *instancePtr));
static void		FreeColorTable _ANSI_ARGS_((ColorTable *colorPtr));

static void		AllocateColors _ANSI_ARGS_((ColorTable *colorPtr));
static void		DisposeColorTable _ANSI_ARGS_((ClientData clientData));
static void		DisposeInstance _ANSI_ARGS_((ClientData clientData));
static int		ReclaimColors _ANSI_ARGS_((ColorTableId *id,
			    int numColors));
static int		MatchFileFormat _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Channel chan, char *fileName,







|
>







364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
			    int width, int height));
static void		ImgPhotoInstanceSetSize _ANSI_ARGS_((
			    PhotoInstance *instancePtr));
static int		IsValidPalette _ANSI_ARGS_((PhotoInstance *instancePtr,
			    char *palette));
static int		CountBits _ANSI_ARGS_((pixel mask));
static void		GetColorTable _ANSI_ARGS_((PhotoInstance *instancePtr));
static void		FreeColorTable _ANSI_ARGS_((ColorTable *colorPtr,
			    int force));
static void		AllocateColors _ANSI_ARGS_((ColorTable *colorPtr));
static void		DisposeColorTable _ANSI_ARGS_((ClientData clientData));
static void		DisposeInstance _ANSI_ARGS_((ClientData clientData));
static int		ReclaimColors _ANSI_ARGS_((ColorTableId *id,
			    int numColors));
static int		MatchFileFormat _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Channel chan, char *fileName,
411
412
413
414
415
416
417


418
419
420
421
422
423
424
425
426
427
428
429
430
431
    Tk_PhotoImageFormat *formatPtr;
				/* Structure describing the format.  All of
				 * the fields except "nextPtr" must be filled
				 * in by caller.  Must not have been passed
				 * to Tk_CreatePhotoImageFormat previously. */
{
    Tk_PhotoImageFormat *copyPtr;



    copyPtr = (Tk_PhotoImageFormat *) ckalloc(sizeof(Tk_PhotoImageFormat));
    *copyPtr = *formatPtr;
    copyPtr->name = (char *) ckalloc((unsigned) (strlen(formatPtr->name) + 1));
    strcpy(copyPtr->name, formatPtr->name);
    copyPtr->nextPtr = formatList;
    formatList = copyPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ImgPhotoCreate --
 *







>
>





|
|







419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
    Tk_PhotoImageFormat *formatPtr;
				/* Structure describing the format.  All of
				 * the fields except "nextPtr" must be filled
				 * in by caller.  Must not have been passed
				 * to Tk_CreatePhotoImageFormat previously. */
{
    Tk_PhotoImageFormat *copyPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    copyPtr = (Tk_PhotoImageFormat *) ckalloc(sizeof(Tk_PhotoImageFormat));
    *copyPtr = *formatPtr;
    copyPtr->name = (char *) ckalloc((unsigned) (strlen(formatPtr->name) + 1));
    strcpy(copyPtr->name, formatPtr->name);
    copyPtr->nextPtr = tsdPtr->formatList;
    tsdPtr->formatList = copyPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ImgPhotoCreate --
 *
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532


533
534
535
536
537
538
539
    struct SubcommandOptions options;
    int listArgc;
    char **listArgv;
    char **srcArgv;
    unsigned char *pixelPtr;
    Tk_PhotoImageBlock block;
    Tk_Window tkwin;
    char string[16];
    XColor color;
    Tk_PhotoImageFormat *imageFormat;
    int imageWidth, imageHeight;
    int matched;
    Tcl_Channel chan;
    Tk_PhotoHandle srcHandle;
    size_t length;



    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?arg arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    c = argv[1][0];







<







>
>







528
529
530
531
532
533
534

535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
    struct SubcommandOptions options;
    int listArgc;
    char **listArgv;
    char **srcArgv;
    unsigned char *pixelPtr;
    Tk_PhotoImageBlock block;
    Tk_Window tkwin;

    XColor color;
    Tk_PhotoImageFormat *imageFormat;
    int imageWidth, imageHeight;
    int matched;
    Tcl_Channel chan;
    Tk_PhotoHandle srcHandle;
    size_t length;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?arg arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    c = argv[1][0];
673
674
675
676
677
678
679


680
681
682
683
684
685
686
		options.toY2 - options.toY, options.zoomX, options.zoomY,
		options.subsampleX, options.subsampleY);

    } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
	/*
	 * photo get command - first parse and check parameters.
	 */



	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " get x y\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)







>
>







684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
		options.toY2 - options.toY, options.zoomX, options.zoomY,
		options.subsampleX, options.subsampleY);

    } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
	/*
	 * photo get command - first parse and check parameters.
	 */

	char string[TCL_INTEGER_SPACE * 3];

	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " get x y\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984

	/*
	 * Search for an appropriate image file format handler,
	 * and give an error if none is found.
	 */

	matched = 0;
	for (imageFormat = formatList; imageFormat != NULL;
	     imageFormat = imageFormat->nextPtr) {
	    if ((options.format == NULL)
		    || (strncasecmp(options.format, imageFormat->name,
		    strlen(imageFormat->name)) == 0)) {
		matched = 1;
		if (imageFormat->fileWriteProc != NULL) {
		    break;







|







983
984
985
986
987
988
989
990
991
992
993
994
995
996
997

	/*
	 * Search for an appropriate image file format handler,
	 * and give an error if none is found.
	 */

	matched = 0;
	for (imageFormat = tsdPtr->formatList; imageFormat != NULL;
	     imageFormat = imageFormat->nextPtr) {
	    if ((options.format == NULL)
		    || (strncasecmp(options.format, imageFormat->name,
		    strlen(imageFormat->name)) == 0)) {
		matched = 1;
		if (imageFormat->fileWriteProc != NULL) {
		    break;
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
 *
 *	This procedure is called when a photo image is created or
 *	reconfigured.  It processes configuration options and resets
 *	any instances of the image.
 *
 * Results:
 *	A standard Tcl return value.  If TCL_ERROR is returned then
 *	an error message is left in masterPtr->interp->result.
 *
 * Side effects:
 *	Existing instances of the image will be redisplayed to match
 *	the new configuration options.
 *
 *----------------------------------------------------------------------
 */







|







1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
 *
 *	This procedure is called when a photo image is created or
 *	reconfigured.  It processes configuration options and resets
 *	any instances of the image.
 *
 * Results:
 *	A standard Tcl return value.  If TCL_ERROR is returned then
 *	an error message is left in the masterPtr->interp's result.
 *
 * Side effects:
 *	Existing instances of the image will be redisplayed to match
 *	the new configuration options.
 *
 *----------------------------------------------------------------------
 */
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
	    || (instancePtr->gamma != colorTablePtr->id.gamma)) {
	/*
	 * Free up our old color table, and get a new one.
	 */

	if (colorTablePtr != NULL) {
	    colorTablePtr->liveRefCount -= 1;
	    FreeColorTable(colorTablePtr);
	}
	GetColorTable(instancePtr);

	/*
	 * Create a new XImage structure for sending data to
	 * the X server, if necessary.
	 */







|







1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
	    || (instancePtr->gamma != colorTablePtr->id.gamma)) {
	/*
	 * Free up our old color table, and get a new one.
	 */

	if (colorTablePtr != NULL) {
	    colorTablePtr->liveRefCount -= 1;
	    FreeColorTable(colorTablePtr, 0);
	}
	GetColorTable(instancePtr);

	/*
	 * Create a new XImage structure for sending data to
	 * the X server, if necessary.
	 */
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
{
    PhotoMaster *masterPtr = (PhotoMaster *) masterData;
    PhotoInstance *instancePtr;
    Colormap colormap;
    int mono, nRed, nGreen, nBlue;
    XVisualInfo visualInfo, *visInfoPtr;
    XRectangle validBox;
    char buf[16];
    int numVisuals;
    XColor *white, *black;
    XGCValues gcValues;

    /*
     * Table of "best" choices for palette for PseudoColor displays
     * with between 3 and 15 bits/pixel.







|







1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
{
    PhotoMaster *masterPtr = (PhotoMaster *) masterData;
    PhotoInstance *instancePtr;
    Colormap colormap;
    int mono, nRed, nGreen, nBlue;
    XVisualInfo visualInfo, *visInfoPtr;
    XRectangle validBox;
    char buf[TCL_INTEGER_SPACE * 3];
    int numVisuals;
    XColor *white, *black;
    XGCValues gcValues;

    /*
     * Table of "best" choices for palette for PseudoColor displays
     * with between 3 and 15 bits/pixel.
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
	    if (instancePtr->refCount == 0) {
		/*
		 * We are resurrecting this instance.
		 */

		Tcl_CancelIdleCall(DisposeInstance, (ClientData) instancePtr);
		if (instancePtr->colorTablePtr != NULL) {
		    FreeColorTable(instancePtr->colorTablePtr);
		}
		GetColorTable(instancePtr);
	    }
	    instancePtr->refCount++;
	    return (ClientData) instancePtr;
	}
    }







|







1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
	    if (instancePtr->refCount == 0) {
		/*
		 * We are resurrecting this instance.
		 */

		Tcl_CancelIdleCall(DisposeInstance, (ClientData) instancePtr);
		if (instancePtr->colorTablePtr != NULL) {
		    FreeColorTable(instancePtr->colorTablePtr, 0);
		}
		GetColorTable(instancePtr);
	    }
	    instancePtr->refCount++;
	    return (ClientData) instancePtr;
	}
    }
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489

2490
2491
2492
2493
2494

2495





2496
2497
2498
2499
2500
2501
2502
 *	handler is registered to free up the color table and the colors
 *	allocated for it.
 *
 *----------------------------------------------------------------------
 */

static void
FreeColorTable(colorPtr)
    ColorTable *colorPtr;	/* Pointer to the color table which is
				 * no longer required by an instance. */

{
    colorPtr->refCount--;
    if (colorPtr->refCount > 0) {
	return;
    }

    if ((colorPtr->flags & DISPOSE_PENDING) == 0) {





	Tcl_DoWhenIdle(DisposeColorTable, (ClientData) colorPtr);
	colorPtr->flags |= DISPOSE_PENDING;
    }
}

/*
 *----------------------------------------------------------------------







|


>





>
|
>
>
>
>
>







2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
 *	handler is registered to free up the color table and the colors
 *	allocated for it.
 *
 *----------------------------------------------------------------------
 */

static void
FreeColorTable(colorPtr, force)
    ColorTable *colorPtr;	/* Pointer to the color table which is
				 * no longer required by an instance. */
    int force;			/* Force free to happen immediately. */
{
    colorPtr->refCount--;
    if (colorPtr->refCount > 0) {
	return;
    }
    if (force) {
	if ((colorPtr->flags & DISPOSE_PENDING) != 0) {
	    Tcl_CancelIdleCall(DisposeColorTable, (ClientData) colorPtr);
	    colorPtr->flags &= ~DISPOSE_PENDING;
	}
	DisposeColorTable((ClientData) colorPtr);
    } else if ((colorPtr->flags & DISPOSE_PENDING) == 0) {
	Tcl_DoWhenIdle(DisposeColorTable, (ClientData) colorPtr);
	colorPtr->flags |= DISPOSE_PENDING;
    }
}

/*
 *----------------------------------------------------------------------
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
    if (instancePtr->imagePtr != NULL) {
	XFree((char *) instancePtr->imagePtr);
    }
    if (instancePtr->error != NULL) {
	ckfree((char *) instancePtr->error);
    }
    if (instancePtr->colorTablePtr != NULL) {
	FreeColorTable(instancePtr->colorTablePtr);
    }

    if (instancePtr->masterPtr->instancePtr == instancePtr) {
	instancePtr->masterPtr->instancePtr = instancePtr->nextPtr;
    } else {
	for (prevPtr = instancePtr->masterPtr->instancePtr;
		prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) {







|







2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
    if (instancePtr->imagePtr != NULL) {
	XFree((char *) instancePtr->imagePtr);
    }
    if (instancePtr->error != NULL) {
	ckfree((char *) instancePtr->error);
    }
    if (instancePtr->colorTablePtr != NULL) {
	FreeColorTable(instancePtr->colorTablePtr, 1);
    }

    if (instancePtr->masterPtr->instancePtr == instancePtr) {
	instancePtr->masterPtr->instancePtr = instancePtr->nextPtr;
    } else {
	for (prevPtr = instancePtr->masterPtr->instancePtr;
		prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) {
3007
3008
3009
3010
3011
3012
3013


3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
				/* A pointer to the photo image format
				 * record is returned here. */
    int *widthPtr, *heightPtr;	/* The dimensions of the image are
				 * returned here. */
{
    int matched;
    Tk_PhotoImageFormat *formatPtr;



    /*
     * Scan through the table of file format handlers to find
     * one which can handle the image.
     */

    matched = 0;
    for (formatPtr = formatList; formatPtr != NULL;
	 formatPtr = formatPtr->nextPtr) {
	if (formatString != NULL) {
	    if (strncasecmp(formatString, formatPtr->name,
		    strlen(formatPtr->name)) != 0) {
		continue;
	    }
	    matched = 1;







>
>







|







3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
				/* A pointer to the photo image format
				 * record is returned here. */
    int *widthPtr, *heightPtr;	/* The dimensions of the image are
				 * returned here. */
{
    int matched;
    Tk_PhotoImageFormat *formatPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Scan through the table of file format handlers to find
     * one which can handle the image.
     */

    matched = 0;
    for (formatPtr = tsdPtr->formatList; formatPtr != NULL;
	 formatPtr = formatPtr->nextPtr) {
	if (formatString != NULL) {
	    if (strncasecmp(formatString, formatPtr->name,
		    strlen(formatPtr->name)) != 0) {
		continue;
	    }
	    matched = 1;
3097
3098
3099
3100
3101
3102
3103


3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
				/* A pointer to the photo image format
				 * record is returned here. */
    int *widthPtr, *heightPtr;	/* The dimensions of the image are
				 * returned here. */
{
    int matched;
    Tk_PhotoImageFormat *formatPtr;



    /*
     * Scan through the table of file format handlers to find
     * one which can handle the image.
     */

    matched = 0;
    for (formatPtr = formatList; formatPtr != NULL;
	    formatPtr = formatPtr->nextPtr) {
	if (formatString != NULL) {
	    if (strncasecmp(formatString, formatPtr->name,
		    strlen(formatPtr->name)) != 0) {
		continue;
	    }
	    matched = 1;







>
>







|







3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
				/* A pointer to the photo image format
				 * record is returned here. */
    int *widthPtr, *heightPtr;	/* The dimensions of the image are
				 * returned here. */
{
    int matched;
    Tk_PhotoImageFormat *formatPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Scan through the table of file format handlers to find
     * one which can handle the image.
     */

    matched = 0;
    for (formatPtr = tsdPtr->formatList; formatPtr != NULL;
	    formatPtr = formatPtr->nextPtr) {
	if (formatString != NULL) {
	    if (strncasecmp(formatString, formatPtr->name,
		    strlen(formatPtr->name)) != 0) {
		continue;
	    }
	    matched = 1;

Changes to generic/tkImgUtil.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkImgUtil.c --
 *
 *	This file contains image related utility functions.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkImgUtil.c 1.3 96/02/15 18:53:12
 */

#include "tkInt.h"
#include "tkPort.h"
#include "xbytes.h"












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkImgUtil.c --
 *
 *	This file contains image related utility functions.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkImgUtil.c,v 1.1.4.1 1998/09/30 02:17:05 stanton Exp $
 */

#include "tkInt.h"
#include "tkPort.h"
#include "xbytes.h"



Changes to generic/tkInitScript.h.

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
/* 
 * tkInitScript.h --
 *
 *	This file contains Unix & Windows common init script
 *      It is not used on the Mac. (the mac init script is in tkMacInit.c)
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkInitScript.h 1.3 97/08/11 19:12:28
 */



/*
 * The following string is the startup script executed in new
 * interpreters.  It looks in several different directories








 * for a script "tk.tcl" that is compatible with this version
 * of Tk.  The tk.tcl script does all of the real work of







 * initialization.
 * When called from a safe interpreter, it does not use file exists.
 * we don't use pwd either because of safe interpreters.










 */

static char initScript[] =
"proc tkInit {} {\n\
    global tk_library tk_version tk_patchLevel env errorInfo\n\
    rename tkInit {}\n\
    set errors \"\"\n\
    if {![info exists tk_library]} {\n\
	set tk_library .\n\
    }\n\
    set dirs {}\n\
    if {[info exists env(TK_LIBRARY)]} {\n\
	lappend dirs $env(TK_LIBRARY)\n\
    }\n\
    lappend dirs $tk_library\n\
    lappend dirs [file join [file dirname [info library]] tk$tk_version]\n\
    set parentDir [file dirname [file dirname [info nameofexecutable]]]\n\
    lappend dirs [file join $parentDir tk$tk_version]\n\
    lappend dirs [file join $parentDir lib tk$tk_version]\n\
    lappend dirs [file join $parentDir library]\n\
    set parentParentDir [file dirname $parentDir]\n\
    if [string match {*[ab]*} $tk_patchLevel] {\n\
        set dirSuffix $tk_patchLevel\n\
    } else {\n\
        set dirSuffix $tk_version\n\
    }\n\
    lappend dirs [file join $parentParentDir tk$dirSuffix library]\n\
    lappend dirs [file join $parentParentDir library]\n\
    lappend dirs [file join [file dirname \
	[file dirname [info library]]] tk$dirSuffix library]\n\
    foreach i $dirs {\n\
	set tk_library $i\n\
	set tkfile [file join $i tk.tcl]\n\
        if {[interp issafe] || [file exists $tkfile]} {\n\
	    if {![catch {uplevel #0 [list source $tkfile]} msg]} {\n\
		return\n\
	    } else {\n\
		append errors \"$tkfile: $msg\n$errorInfo\n\"\n\
	    }\n\
	}\n\
    }\n\
    set msg \"Can't find a usable tk.tcl in the following directories: \n\"\n\
    append msg \"    $dirs\n\n\"\n\
    append msg \"$errors\n\n\"\n\
    append msg \"This probably means that Tk wasn't installed properly.\n\"\n\
    error $msg\n\
}\n\
tkInit";












|





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


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



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
/* 
 * tkInitScript.h --
 *
 *	This file contains Unix & Windows common init script
 *      It is not used on the Mac. (the mac init script is in tkMacInit.c)
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkInitScript.h,v 1.1.4.2 1998/09/30 02:17:05 stanton Exp $
 */



/*
 * In order to find tk.tcl during initialization, the following script
 * is invoked by Tk_Init().  It looks in several different directories:
 *
 *	$tk_library		- can specify a primary location, if set
 *				  no other locations will be checked
 *
 *	$env(TK_LIBRARY)	- highest priority so user can always override
 *				  the search path unless the application has
 *				  specified an exact directory above
 *
 *	$tcl_library/../tk$tk_version
 *				- look relative to init.tcl in an installed
 *				  lib directory (e.g. /usr/local)
 *
 *	<executable directory>/../lib/tk$tk_version
 *				- look for a lib/tk<ver> in a sibling of
 *				  the bin directory (e.g. /usr/local)
 *
 *	<executable directory>/../library
 *				- look in Tk build directory


 *
 *	<executable directory>/../../tk$tk_patchLevel/library
 *				- look for Tk build directory relative
 *				  to a parallel build directory
 *
 * The first directory on this path that contains a valid tk.tcl script
 * will be set ast the value of tk_library.
 *
 * Note that this entire search mechanism can be bypassed by defining an
 * alternate tkInit procedure before calling Tk_Init().
 */

static char initScript[] = "if {[info proc tkInit]==\"\"} {\n\
  proc tkInit {} {\n\
    global tk_library tk_version tk_patchLevel\n\
      rename tkInit {}\n\
















    tcl_findLibrary tk $tk_version $tk_patchLevel tk.tcl TK_LIBRARY tk_library\n\


  }\n\




















}\n\
tkInit";

Added generic/tkInt.decls.























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
	# tkInt.decls --
#
#	This file contains the declarations for all unsupported
#	functions that are exported by the Tk library.  This file
#	is used to generate the tkIntDecls.h, tkIntPlatDecls.h,
#	tkIntStub.c, and tkPlatStub.c files.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: tkInt.decls,v 1.2.2.5 1999/04/06 02:48:27 redman Exp $

library tk

# Define the unsupported generic interfaces.

interface tkInt

# Declare each of the functions in the unsupported internal Tcl
# interface.  These interfaces are allowed to changed between versions.
# Use at your own risk.  Note that the position of functions should not
# be changed between versions to avoid gratuitous incompatibilities.

declare 0 generic {
    TkWindow * TkAllocWindow (TkDisplay *dispPtr, int screenNum, \
	    TkWindow *parentPtr)
}

declare 1 generic {
    void TkBezierPoints (double control[], int numSteps, double *coordPtr)
}

declare 2 generic {
    void TkBezierScreenPoints (Tk_Canvas canvas, double control[], \
	    int numSteps, XPoint *xPointPtr)
}

declare 3 generic {
    void TkBindDeadWindow (TkWindow *winPtr)
}

declare 4 generic {
    void TkBindEventProc (TkWindow *winPtr, XEvent *eventPtr)
}

declare 5 generic {
    void TkBindFree (TkMainInfo *mainPtr)
}

declare 6 generic {
    void TkBindInit (TkMainInfo *mainPtr)
}

declare 7 generic {
    void TkChangeEventWindow (XEvent *eventPtr, TkWindow *winPtr)
}

declare 8 generic {
    int TkClipInit (Tcl_Interp *interp, TkDisplay *dispPtr)
}

declare 9 generic {
    void TkComputeAnchor (Tk_Anchor anchor, Tk_Window tkwin, \
	    int padX, int padY, int innerWidth, int innerHeight, \
	    int *xPtr, int *yPtr)
}

declare 10 generic {
    int TkCopyAndGlobalEval (Tcl_Interp *interp, char *script)
}

declare 11 generic {
    unsigned long TkCreateBindingProcedure (Tcl_Interp *interp, \
	    Tk_BindingTable bindingTable, \
	    ClientData object, char *eventString, \
	    TkBindEvalProc *evalProc, TkBindFreeProc *freeProc, \
	    ClientData clientData)
}

declare 12 generic {
    TkCursor * TkCreateCursorFromData (Tk_Window tkwin, \
	    char *source, char *mask, int width, int height, \
	    int xHot, int yHot, XColor fg, XColor bg)
}

declare 13 generic {
    int TkCreateFrame (ClientData clientData, \
	    Tcl_Interp *interp, int argc, char **argv, \
	    int toplevel, char *appName)
}

declare 14 generic {
    Tk_Window TkCreateMainWindow (Tcl_Interp *interp, \
	    char *screenName, char *baseName)
}

declare 15 generic {
    Time TkCurrentTime (TkDisplay *dispPtr)
}

declare 16 generic {
    void TkDeleteAllImages (TkMainInfo *mainPtr)
}

declare 17 generic {
    void TkDoConfigureNotify (TkWindow *winPtr)
}

declare 18 generic {
    void TkDrawInsetFocusHighlight (Tk_Window tkwin, GC gc, int width, \
	    Drawable drawable, int padding)
}

declare 19 generic {
    void TkEventDeadWindow (TkWindow *winPtr)
}

declare 20 generic {
    void TkFillPolygon (Tk_Canvas canvas, \
	    double *coordPtr, int numPoints, Display *display, \
	    Drawable drawable, GC gc, GC outlineGC)
}

declare 21 generic {
    int TkFindStateNum (Tcl_Interp *interp, \
	    CONST char *option, CONST TkStateMap *mapPtr, \
	    CONST char *strKey)
}

declare 22 generic {
    char * TkFindStateString (CONST TkStateMap *mapPtr, int numKey)
}

declare 23 generic {
    void TkFocusDeadWindow (TkWindow *winPtr)
}

declare 24 generic {
    int TkFocusFilterEvent (TkWindow *winPtr, XEvent *eventPtr)
}

declare 25 generic {
    TkWindow * TkFocusKeyEvent (TkWindow *winPtr, XEvent *eventPtr)
}

declare 26 generic {
    void TkFontPkgInit (TkMainInfo *mainPtr)
}

declare 27 generic {
    void TkFontPkgFree (TkMainInfo *mainPtr)
}

declare 28 generic {
    void TkFreeBindingTags (TkWindow *winPtr)
}

# Name change only, TkFreeCursor in Tcl 8.0.x now TkpFreeCursor
declare 29 generic {
    void TkpFreeCursor (TkCursor *cursorPtr)
}

declare 30 generic {
    char * TkGetBitmapData (Tcl_Interp *interp, \
	    char *string, char *fileName, int *widthPtr, \
	    int *heightPtr, int *hotXPtr, int *hotYPtr)
}

declare 31 generic {
    void TkGetButtPoints (double p1[], double p2[], \
	    double width, int project, double m1[], double m2[])
}

declare 32 generic {
    TkCursor * TkGetCursorByName (Tcl_Interp *interp, \
	    Tk_Window tkwin, Tk_Uid string)
}

declare 33 generic {
    char * TkGetDefaultScreenName (Tcl_Interp *interp, char *screenName)
}

declare 34 generic {
    TkDisplay * TkGetDisplay (Display *display)
}

declare 35 generic {
    int TkGetDisplayOf (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], \
	    Tk_Window *tkwinPtr)
}

declare 36 generic {
    TkWindow * TkGetFocusWin (TkWindow *winPtr)
}

declare 37 generic {
    int TkGetInterpNames (Tcl_Interp *interp, Tk_Window tkwin)
}

declare 38 generic {
    int TkGetMiterPoints (double p1[], double p2[], double p3[], \
	    double width, double m1[],double m2[])
}

declare 39 generic {
    void TkGetPointerCoords (Tk_Window tkwin, int *xPtr, int *yPtr)
}

declare 40 generic {
    void TkGetServerInfo (Tcl_Interp *interp, Tk_Window tkwin)
}

declare 41 generic {
    void TkGrabDeadWindow (TkWindow *winPtr)
}

declare 42 generic {
    int TkGrabState (TkWindow *winPtr)
}

declare 43 generic {
    void TkIncludePoint (Tk_Item *itemPtr, double *pointPtr)
}

declare 44 generic {
    void TkInOutEvents (XEvent *eventPtr, TkWindow *sourcePtr, \
	    TkWindow *destPtr, int leaveType, int enterType, \
	    Tcl_QueuePosition position)
}

declare 45 generic {
    void TkInstallFrameMenu (Tk_Window tkwin)
}

declare 46 generic {
    char * TkKeysymToString (KeySym keysym)
}

declare 47 generic {
    int TkLineToArea (double end1Ptr[], double end2Ptr[], double rectPtr[])
}

declare 48 generic {
    double TkLineToPoint (double end1Ptr[], \
	    double end2Ptr[], double pointPtr[])
}

declare 49 generic {
    int TkMakeBezierCurve (Tk_Canvas canvas, \
	    double *pointPtr, int numPoints, int numSteps, \
	    XPoint xPoints[], double dblPoints[])
}

declare 50 generic {
    void TkMakeBezierPostscript (Tcl_Interp *interp, \
	    Tk_Canvas canvas, double *pointPtr, int numPoints)
}

declare 51 generic {
    void TkOptionClassChanged (TkWindow *winPtr)
}

declare 52 generic {
    void TkOptionDeadWindow (TkWindow *winPtr)
}

declare 53 generic {
    int TkOvalToArea (double *ovalPtr, double *rectPtr)
}

declare 54 generic {
    double TkOvalToPoint (double ovalPtr[], \
	    double width, int filled, double pointPtr[])
}

declare 55 generic {
    int TkpChangeFocus (TkWindow *winPtr, int force)
}

declare 56 generic {
    void TkpCloseDisplay (TkDisplay *dispPtr)
}

declare 57 generic {
    void TkpClaimFocus (TkWindow *topLevelPtr, int force)
}

declare 58 generic {
    void TkpDisplayWarning (char *msg, char *title)
}

declare 59 generic {
    void TkpGetAppName (Tcl_Interp *interp, Tcl_DString *name)
}

declare 60 generic {
    TkWindow * TkpGetOtherWindow (TkWindow *winPtr)
}

declare 61 generic {
    TkWindow * TkpGetWrapperWindow (TkWindow *winPtr)
}

declare 62 generic {
    int TkpInit (Tcl_Interp *interp)
}

declare 63 generic {
    void TkpInitializeMenuBindings (Tcl_Interp *interp, \
	    Tk_BindingTable bindingTable)
}

declare 64 generic {
    void TkpMakeContainer (Tk_Window tkwin)
}

declare 65 generic {
    void TkpMakeMenuWindow (Tk_Window tkwin, int transient)
}

declare 66 generic {
    Window TkpMakeWindow (TkWindow *winPtr, Window parent)
}

declare 67 generic {
    void TkpMenuNotifyToplevelCreate (Tcl_Interp *interp1, char *menuName)
}

declare 68 generic {
    TkDisplay * TkpOpenDisplay (char *display_name)
}

declare 69 generic {
    int TkPointerEvent (XEvent *eventPtr, TkWindow *winPtr)
}

declare 70 generic {
    int TkPolygonToArea (double *polyPtr, int numPoints, double *rectPtr)
}

declare 71 generic {
    double TkPolygonToPoint (double *polyPtr, int numPoints, double *pointPtr)
}

declare 72 generic {
    int TkPositionInTree (TkWindow *winPtr, TkWindow *treePtr)
}

declare 73 generic {
    void TkpRedirectKeyEvent (TkWindow *winPtr, XEvent *eventPtr)
}

declare 74 generic {
    void TkpSetMainMenubar (Tcl_Interp *interp, \
	    Tk_Window tkwin, char *menuName)
}

declare 75 generic {
    int TkpUseWindow (Tcl_Interp *interp, Tk_Window tkwin, char *string)
}

declare 76 generic {
    int TkpWindowWasRecentlyDeleted (Window win, TkDisplay *dispPtr)
}

declare 77 generic {
    void TkQueueEventForAllChildren (TkWindow *winPtr, XEvent *eventPtr)
}

declare 78 generic {
    int TkReadBitmapFile (Display* display, Drawable d, CONST char* filename, \
	    unsigned int* width_return, unsigned int* height_return, \
	    Pixmap* bitmap_return, int* x_hot_return, int* y_hot_return)
}

declare 79 generic {
    int TkScrollWindow (Tk_Window tkwin, GC gc, \
	    int x, int y, int width, int height, int dx, \
	    int dy, TkRegion damageRgn)
}

declare 80 generic {
    void TkSelDeadWindow (TkWindow *winPtr)
}

declare 81 generic {
    void TkSelEventProc (Tk_Window tkwin, XEvent *eventPtr)
}

declare 82 generic {
    void TkSelInit (Tk_Window tkwin)
}

declare 83 generic {
    void TkSelPropProc (XEvent *eventPtr)
}

declare 84 generic {
    void TkSetClassProcs (Tk_Window tkwin, \
	    TkClassProcs *procs, ClientData instanceData)
}

declare 85 generic {
    void TkSetWindowMenuBar (Tcl_Interp *interp, \
	    Tk_Window tkwin, char *oldMenuName, char *menuName)
}

declare 86 generic {
    KeySym TkStringToKeysym (char *name)
}

declare 87 generic {
    int TkThickPolyLineToArea (double *coordPtr, \
	    int numPoints, double width, int capStyle, \
	    int joinStyle, double *rectPtr)
}

declare 88 generic {
    void TkWmAddToColormapWindows (TkWindow *winPtr)
}

declare 89 generic {
    void TkWmDeadWindow (TkWindow *winPtr)
}

declare 90 generic {
    TkWindow * TkWmFocusToplevel (TkWindow *winPtr)
}

declare 91 generic {
    void TkWmMapWindow (TkWindow *winPtr)
}

declare 92 generic {
    void TkWmNewWindow (TkWindow *winPtr)
}

declare 93 generic {
    void TkWmProtocolEventProc (TkWindow *winPtr, XEvent *evenvPtr)
}

declare 94 generic {
    void TkWmRemoveFromColormapWindows (TkWindow *winPtr)
}

declare 95 generic {
    void TkWmRestackToplevel (TkWindow *winPtr, int aboveBelow, \
	    TkWindow *otherPtr)
}

declare 96 generic {
    void TkWmSetClass (TkWindow *winPtr)
}

declare 97 generic {
    void TkWmUnmapWindow (TkWindow *winPtr)
}

# new for 8.1

declare 98 generic {
    Tcl_Obj * TkDebugBitmap ( Tk_Window tkwin, char *name)
}

declare 99 generic {
    Tcl_Obj * TkDebugBorder ( Tk_Window tkwin, char *name)
}

declare 100 generic {
    Tcl_Obj * TkDebugCursor ( Tk_Window tkwin, char *name)
}

declare 101 generic {
    Tcl_Obj * TkDebugColor ( Tk_Window tkwin, char *name)
}

declare 102 generic {
    Tcl_Obj * TkDebugConfig (Tcl_Interp *interp, Tk_OptionTable table)
}

declare 103 generic {
    Tcl_Obj * TkDebugFont ( Tk_Window tkwin, char *name)
}

declare 104 generic {
    int  TkFindStateNumObj (Tcl_Interp *interp, \
	    Tcl_Obj *optionPtr, CONST TkStateMap *mapPtr, \
	    Tcl_Obj *keyPtr)
}

declare 105 generic {
    Tcl_HashTable *  TkGetBitmapPredefTable (void)
}

declare 106 generic {
    TkDisplay * TkGetDisplayList (void)
}

declare 107 generic {
    TkMainInfo * TkGetMainInfoList (void)
}

declare 108 generic {
    int  TkGetWindowFromObj (Tcl_Interp *interp, \
	    Tk_Window tkwin, Tcl_Obj *objPtr, \
	    Tk_Window *windowPtr)
}

declare 109 generic {
    char *  TkpGetString (TkWindow *winPtr, \
	    XEvent *eventPtr, Tcl_DString *dsPtr)
}

declare 110 generic {
    void  TkpGetSubFonts (Tcl_Interp *interp, Tk_Font tkfont)
}

declare 111 generic {
    Tcl_Obj * TkpGetSystemDefault (Tk_Window tkwin, \
	    char *dbName, char *className)
}

declare 112 generic {
    void TkpMenuThreadInit (void)
}

##############################################################################

# Define the platform specific internal Tcl interface. These functions are
# only available on the designated platform.

interface tkIntPlat

#########################
# Unix specific functions

declare 0 unix {
    void TkCreateXEventSource (void)
}

declare 1 unix {
    void TkFreeWindowId (TkDisplay *dispPtr, Window w)
}

declare 2 unix {
    void TkInitXId (TkDisplay *dispPtr)
}

declare 3 unix {
    int TkpCmapStressed (Tk_Window tkwin, Colormap colormap)}


declare 4 unix {
    void TkpSync (Display *display)
}

declare 5 unix {
    Window TkUnixContainerId (TkWindow *winPtr)
}

declare 6 unix {
    int TkUnixDoOneXEvent (Tcl_Time *timePtr)
}

declare 7 unix {
    void TkUnixSetMenubar (Tk_Window tkwin, Tk_Window menubar)
}
	


############################
# Windows specific functions

declare 0 win {
    char * TkAlignImageData (XImage *image, int alignment, int bitOrder)
}

declare 1 win {
    void TkClipBox (TkRegion rgn, XRectangle* rect_return)
}

declare 2 win {
    TkRegion TkCreateRegion (void)
}

declare 3 win {
    void TkDestroyRegion (TkRegion rgn)
}

declare 4 win {
    void TkGenerateActivateEvents (TkWindow *winPtr, int active)
}

declare 5 win {
    void TkIntersectRegion (TkRegion sra, TkRegion srcb, TkRegion dr_return)
}

declare 6 win {
    unsigned long TkpGetMS (void)
}

declare 7 win {
    void TkPointerDeadWindow (TkWindow *winPtr)
}

declare 8 win {
    void TkpPrintWindowId (char *buf, Window window)
}

declare 9 win {
    int TkpScanWindowId (Tcl_Interp *interp, char *string, int *idPtr)
}

declare 10 win {
    void TkpSetCapture (TkWindow *winPtr)
}

declare 11 win {
    void TkpSetCursor (TkpCursor cursor)
}

declare 12 win {
    void TkpWmSetState (TkWindow *winPtr, int state)
}

declare 13 win {
    int TkRectInRegion (TkRegion rgn, int x, int y, unsigned int width, \
	    unsigned int height)
}

declare 14 win {
    void TkSetPixmapColormap (Pixmap pixmap, Colormap colormap)
}

declare 15 win {
    void TkSetRegion (Display* display, GC gc, TkRegion rgn)
}

declare 16 win {
    void TkUnionRectWithRegion (XRectangle* rect, \
	    TkRegion src, TkRegion dr_return)
}

declare 17 win {
    void  TkWinCancelMouseTimer (void)
}

declare 18 win {
    void  TkWinClipboardRender (TkDisplay *dispPtr, UINT format)
}

declare 19 win {
    LRESULT  TkWinEmbeddedEventProc (HWND hwnd, UINT message, \
	    WPARAM wParam, LPARAM lParam)
}

declare 20 win {
    void  TkWinFillRect (HDC dc, int x, int y, int width, int height, \
	    int pixel)
}

declare 21 win {
    COLORREF  TkWinGetBorderPixels (Tk_Window tkwin, Tk_3DBorder border, \
	    int which)
}

declare 22 win {
    HDC  TkWinGetDrawableDC (Display *display, Drawable d, TkWinDCState* state)
}

declare 23 win {
    int  TkWinGetModifierState (void)
}

declare 24 win {
    HPALETTE  TkWinGetSystemPalette (void)
}

declare 25 win {
    HWND  TkWinGetWrapperWindow (Tk_Window tkwin)
}

declare 26 win {
    int  TkWinHandleMenuEvent (HWND *phwnd, \
	    UINT *pMessage, WPARAM *pwParam, LPARAM *plParam, \
	    LRESULT *plResult)
}

declare 27 win {
    int  TkWinIndexOfColor (XColor *colorPtr)
}

declare 28 win {
    void  TkWinReleaseDrawableDC (Drawable d, HDC hdc, TkWinDCState* state)
}

declare 29 win {
    LRESULT  TkWinResendEvent (WNDPROC wndproc, HWND hwnd, XEvent *eventPtr)
}

declare 30 win {
    HPALETTE  TkWinSelectPalette (HDC dc, Colormap colormap)
}

declare 31 win {
    void  TkWinSetMenu (Tk_Window tkwin, HMENU hMenu)
}

declare 32 win {
    void  TkWinSetWindowPos (HWND hwnd, HWND siblingHwnd, int pos)
}

declare 33 win {
    void  TkWinWmCleanup (HINSTANCE hInstance)
}

declare 34 win {
    void  TkWinXCleanup (HINSTANCE hInstance)
}

declare 35 win {
    void   TkWinXInit (HINSTANCE hInstance)
}

# new for 8.1

declare 36 win {
    void TkWinSetForegroundWindow (TkWindow *winPtr)
}

declare 37 win {
    void TkWinDialogDebug (int debug)
}

declare 38 win {
    Tcl_Obj * TkWinGetMenuSystemDefault (Tk_Window tkwin, \
	    char *dbName, char *className)
}

declare 39 win {
    int TkWinGetPlatformId(void)
}

########################
# Mac specific functions

declare 0 mac {
    void TkClipBox (TkRegion rgn, XRectangle* rect_return)
}

declare 1 mac {
    TkRegion TkCreateRegion (void)
}

declare 2 mac {
    void TkDestroyRegion (TkRegion rgn)
}

declare 3 mac {
    void TkGenerateActivateEvents (TkWindow *winPtr, int active)
}

declare 4 mac {
    void TkIntersectRegion (TkRegion sra, TkRegion srcb, TkRegion dr_return)
}

declare 5 mac {
    Pixmap TkpCreateNativeBitmap (Display *display, char * source)
}

declare 6 mac {
    void TkpDefineNativeBitmaps (void)
}

declare 7 mac {
    unsigned long TkpGetMS (void)
}

declare 8 mac {
    Pixmap TkpGetNativeAppBitmap (Display *display, \
	    char *name, int *width, int *height)
}

declare 9 mac {
    void TkPointerDeadWindow (TkWindow *winPtr)
}

declare 10 mac {
    void TkpSetCapture (TkWindow *winPtr)
}

declare 11 mac {
    void TkpSetCursor (TkpCursor cursor)
}

declare 12 mac {
    void TkpWmSetState (TkWindow *winPtr, int state)
}

declare 13 mac {
    int TkRectInRegion (TkRegion rgn, int x, int y, unsigned int width, \
	    unsigned int height)
}

declare 14 mac {
    void TkSetRegion (Display* display, GC gc, TkRegion rgn)
}

declare 15 mac {
    void TkUnionRectWithRegion (XRectangle* rect, \
	    TkRegion src, TkRegion dr_return)
}

declare 16 mac {
    int  HandleWMEvent (EventRecord *theEvent)
}

declare 17 mac {
    void   TkAboutDlg (void)
}

declare 18 mac {
    void  TkCreateMacEventSource (void)
}

declare 19 mac {
    void   TkFontList (Tcl_Interp *interp, Display *display)
}

declare 20 mac {
    Window  TkGetTransientMaster (TkWindow *winPtr)
}

declare 21 mac {
    int  TkGenerateButtonEvent (int x, int y, \
	    Window window, unsigned int state)
}

declare 22 mac {
    int   TkGetCharPositions (XFontStruct *font_struct, char *string, \
	    int count, short *buffer)
}

declare 23 mac {
    void  TkGenWMDestroyEvent (Tk_Window tkwin)
}

declare 24 mac {
    void  TkGenWMConfigureEvent (Tk_Window tkwin, int x, int y, \
	    int width, int height, int flags)
}

declare 25 mac {
    unsigned int TkMacButtonKeyState (void)
}

declare 26 mac {
    void  TkMacClearMenubarActive (void)
}

declare 27 mac {
    int  TkMacConvertEvent (EventRecord *eventPtr)
}

declare 28 mac {
    int  TkMacDispatchMenuEvent (int menuID, int index)
}

declare 29 mac {
    void  TkMacInstallCursor (int resizeOverride)
}

declare 30 mac {
    int  TkMacConvertTkEvent (EventRecord *eventPtr, Window window)
}

declare 31 mac {
    void  TkMacHandleTearoffMenu (void)
}

declare 32 mac {
    void  tkMacInstallMWConsole (Tcl_Interp *interp)
}

declare 33 mac {
    void  TkMacInvalClipRgns (TkWindow *winPtr)
}

declare 34 mac {
    void  TkMacDoHLEvent (EventRecord *theEvent)
}

declare 35 mac {
    void   TkMacFontInfo (Font fontId, short *family, \
	    short *style, short *size)
}

declare 36 mac {
    Time  TkMacGenerateTime (void)
}

declare 37 mac {
    GWorldPtr  TkMacGetDrawablePort (Drawable drawable)
}

declare 38 mac {
    TkWindow *  TkMacGetScrollbarGrowWindow (TkWindow *winPtr)
}

declare 39 mac {
    Window   TkMacGetXWindow (WindowRef macWinPtr)
}

declare 40 mac {
    int  TkMacGrowToplevel (WindowRef whichWindow, Point start)
}

declare 41 mac {
    void   TkMacHandleMenuSelect (long mResult, int optionKeyPressed)
}

declare 42 mac {
    int  TkMacHaveAppearance (void)
}

declare 43 mac {
    void  TkMacInitAppleEvents (Tcl_Interp *interp)
}

declare 44 mac {
    void   TkMacInitMenus (Tcl_Interp  *interp)
}

declare 45 mac {
    void  TkMacInvalidateWindow (MacDrawable *macWin, int flag)
}

declare 46 mac {
    int  TkMacIsCharacterMissing (Tk_Font tkfont, unsigned int searchChar)
}

declare 47 mac {
    void  TkMacMakeRealWindowExist (TkWindow *winPtr)
}

declare 48 mac {
    BitMapPtr TkMacMakeStippleMap(Drawable d1, Drawable d2)
}

declare 49 mac {
    void  TkMacMenuClick (void)
}

declare 50 mac {
    void  TkMacRegisterOffScreenWindow (Window window, GWorldPtr portPtr)
}

declare 51 mac {
    int  TkMacResizable (TkWindow *winPtr)
}

declare 52 mac {
    void  TkMacSetEmbedRgn (TkWindow *winPtr, RgnHandle rgn)
}

declare 53 mac {
    void  TkMacSetHelpMenuItemCount (void)
}

declare 54 mac {
    void  TkMacSetScrollbarGrow (TkWindow *winPtr, int flag)
}

declare 55 mac {
    void  TkMacSetUpClippingRgn (Drawable drawable)
}

declare 56 mac {
    void  TkMacSetUpGraphicsPort (GC gc)
}

declare 57 mac {
    void   TkMacUpdateClipRgn (TkWindow *winPtr)
}

declare 58 mac {
    void  TkMacUnregisterMacWindow (GWorldPtr portPtr)
}

declare 59 mac {
    int  TkMacUseMenuID (short macID)
}

declare 60 mac {
    RgnHandle  TkMacVisableClipRgn (TkWindow *winPtr)
}

declare 61 mac {
    void  TkMacWinBounds (TkWindow *winPtr, Rect *geometry)
}

declare 62 mac {
    void  TkMacWindowOffset (WindowRef wRef, int *xOffset, int *yOffset)
}

declare 63 mac {
    void  TkResumeClipboard (void)
}

declare 64 mac {
    int   TkSetMacColor (unsigned long pixel, RGBColor *macColor)
}

declare 65 mac {
    void   TkSetWMName (TkWindow *winPtr, Tk_Uid titleUid)
}

declare 66 mac {
    void  TkSuspendClipboard (void)
}

declare 67 mac {
    int  TkWMGrowToplevel (WindowRef whichWindow, Point start)
}

declare 68 mac {
    int  TkMacZoomToplevel (WindowPtr whichWindow, Point where, short zoomPart)
}

declare 69 mac {
    Tk_Window Tk_TopCoordsToWindow (Tk_Window tkwin, \
	    int rootX, int rootY, int *newX, int *newY)
}

declare 70 mac {
    MacDrawable * TkMacContainerId (TkWindow *winPtr)
}

declare 71 mac {
    MacDrawable * TkMacGetHostToplevel  (TkWindow *winPtr)
}


##############################################################################

# Define the platform specific internal Xlib interfaces. These functions are
# only available on the designated platform.

interface tkIntXlib

# X functions for Windows

# This slot is reserved for use by the dash patch:
#  declare 0 win {
#	XSetDashes
#  }
declare 1 win {
    XModifierKeymap* XGetModifierMapping (Display* d)
}

declare 2 win {
    XImage * XCreateImage (Display* d, Visual* v, unsigned int ui1, int i1, \
	    int i2, char* cp, unsigned int ui2, unsigned int ui3, int i3, \
	    int i4)

}

declare 3 win {
    XImage *XGetImage (Display* d, Drawable dr, int i1, int i2, \
	    unsigned int ui1, unsigned int ui2, unsigned long ul, int i3)
}

declare 4 win {
    char *XGetAtomName (Display* d,Atom a)

}

declare 5 win {
    char *XKeysymToString (KeySym k)
}

declare 6 win {
    Colormap XCreateColormap (Display* d, Window w, Visual* v, int i)

}

declare 7 win {
    Cursor XCreatePixmapCursor (Display* d, Pixmap p1, Pixmap p2, \
	    XColor* x1, XColor* x2, \
	    unsigned int ui1, unsigned int ui2)
}

declare 8 win {
    Cursor XCreateGlyphCursor (Display* d, Font f1, Font f2, \
	    unsigned int ui1, unsigned int ui2, XColor* x1, XColor* x2)
}

declare 9 win {
    GContext XGContextFromGC (GC g)
}

declare 10 win {
    XHostAddress *XListHosts (Display* d, int* i, Bool* b)
}

# second parameter was of type KeyCode
declare 11 win {
    KeySym XKeycodeToKeysym (Display* d, unsigned int k, int i)
}

declare 12 win {
    KeySym XStringToKeysym (_Xconst char* c)
}

declare 13 win {
    Window XRootWindow (Display* d, int i)
}

declare 14 win {
    XErrorHandler XSetErrorHandler  (XErrorHandler x)
}

declare 15 win {
    Status XIconifyWindow (Display* d, Window w, int i)
}

declare 16 win {
    Status XWithdrawWindow (Display* d, Window w, int i)
}

declare 17 win {
    Status XGetWMColormapWindows (Display* d, Window w, Window** wpp, int* ip)
}

declare 18 win {
    Status XAllocColor (Display* d, Colormap c, XColor* xp)
}

declare 19 win {
    void XBell (Display* d, int i)
}

declare 20 win {
    void XChangeProperty (Display* d, Window w, Atom a1, Atom a2, int i1, \
	    int i2, _Xconst unsigned char* c, int i3)
}

declare 21 win {
    void XChangeWindowAttributes (Display* d, Window w, unsigned long ul, \
	    XSetWindowAttributes* x)
}

declare 22 win {
    void XClearWindow (Display* d, Window w)
}

declare 23 win {
    void XConfigureWindow (Display* d, Window w, unsigned int i, \
	    XWindowChanges* x)
}

declare 24 win {
    void XCopyArea (Display* d, Drawable dr1, Drawable dr2, GC g, int i1, \
	    int i2, unsigned int ui1, \
	    unsigned int ui2, int i3, int i4)
}

declare 25 win {
    void XCopyPlane (Display* d, Drawable dr1, Drawable dr2, GC g, int i1, \
	    int i2, unsigned int ui1, \
	    unsigned int ui2, int i3, int i4, unsigned long ul)
}

declare 26 win {
    Pixmap XCreateBitmapFromData(Display* display, Drawable d, \
	    _Xconst char* data, unsigned int width,unsigned int height)
}

declare 27 win {
    void XDefineCursor (Display* d, Window w, Cursor c)
}

declare 28 win {
    void XDeleteProperty (Display* d, Window w, Atom a)
}

declare 29 win {
    void XDestroyWindow (Display* d, Window w)
}

declare 30 win {
    void XDrawArc (Display* d, Drawable dr, GC g, int i1, int i2, \
	    unsigned int ui1, unsigned int ui2, int i3, int i4)
}

declare 31 win {
    void XDrawLines (Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2)
}

declare 32 win {
    void XDrawRectangle (Display* d, Drawable dr, GC g, int i1, int i2,\
	    unsigned int ui1, unsigned int ui2)
}

declare 33 win {
    void XFillArc (Display* d, Drawable dr, GC g, int i1, int i2, \
	    unsigned int ui1, unsigned int ui2, int i3, int i4)
}

declare 34 win {
    void XFillPolygon (Display* d, Drawable dr, GC g, XPoint* x, \
	    int i1, int i2, int i3)
}

declare 35 win {
    void XFillRectangles (Display* d, Drawable dr, GC g, XRectangle* x, int i)
}

declare 36 win {
    void XForceScreenSaver (Display* d, int i)
}

declare 37 win {
    void XFreeColormap (Display* d, Colormap c)
}

declare 38 win {
    void XFreeColors (Display* d, Colormap c, \
	    unsigned long* ulp, int i, unsigned long ul)
}

declare 39 win {
    void XFreeCursor (Display* d, Cursor c)
}

declare 40 win {
    void XFreeModifiermap (XModifierKeymap* x)
}

declare 41 win {
    Status XGetGeometry (Display* d, Drawable dr, Window* w, int* i1, \
	    int* i2, unsigned int* ui1, unsigned int* ui2, unsigned int* ui3, \
	    unsigned int* ui4)
}

declare 42 win {
    void XGetInputFocus (Display* d, Window* w, int* i)
}

declare 43 win {
    int XGetWindowProperty (Display* d, Window w, Atom a1, long l1, long l2, \
	    Bool b, Atom a2, Atom* ap, int* ip, unsigned long* ulp1, \
	    unsigned long* ulp2, unsigned char** cpp)
}

declare 44 win {
    Status XGetWindowAttributes (Display* d, Window w, XWindowAttributes* x)
}

declare 45 win {
    int XGrabKeyboard (Display* d, Window w, Bool b, int i1, int i2, Time t)
}

declare 46 win {
    int XGrabPointer (Display* d, Window w1, Bool b, unsigned int ui, \
	    int i1, int i2, Window w2, Cursor c, Time t)
}

declare 47 win {
    KeyCode XKeysymToKeycode (Display* d, KeySym k)
}

declare 48 win {
    Status XLookupColor (Display* d, Colormap c1, _Xconst char* c2, \
	    XColor* x1, XColor* x2)
}

declare 49 win {
    void XMapWindow (Display* d, Window w)
}

declare 50 win {
    void XMoveResizeWindow (Display* d, Window w, int i1, int i2, \
	    unsigned int ui1, unsigned int ui2)
}

declare 51 win {
    void XMoveWindow (Display* d, Window w, int i1, int i2)
}

declare 52 win {
    void XNextEvent (Display* d, XEvent* x)
}

declare 53 win {
    void XPutBackEvent (Display* d, XEvent* x)
}

declare 54 win {
    void XQueryColors (Display* d, Colormap c, XColor* x, int i)
}

declare 55 win {
    Bool XQueryPointer (Display* d, Window w1, Window* w2, Window* w3, \
	    int* i1, int* i2, int* i3, int* i4, unsigned int* ui)
}

declare 56 win {
    Status XQueryTree (Display* d, Window w1, Window* w2, Window* w3, \
	    Window** w4, unsigned int* ui)
}

declare 57 win {
    void XRaiseWindow (Display* d, Window w)
}

declare 58 win {
    void XRefreshKeyboardMapping (XMappingEvent* x)
}

declare 59 win {
    void XResizeWindow (Display* d, Window w, unsigned int ui1, \
	    unsigned int ui2)
}

declare 60 win {
    void XSelectInput (Display* d, Window w, long l)
}

declare 61 win {
    Status XSendEvent (Display* d, Window w, Bool b, long l, XEvent* x)
}

declare 62 win {
    void XSetCommand (Display* d, Window w, char** c, int i)
}

declare 63 win {
    void XSetIconName (Display* d, Window w, _Xconst char* c)
}

declare 64 win {
    void XSetInputFocus (Display* d, Window w, int i, Time t)
}

declare 65 win {
    void XSetSelectionOwner (Display* d, Atom a, Window w, Time t)
}

declare 66 win {
    void XSetWindowBackground (Display* d, Window w, unsigned long ul)
}

declare 67 win {
    void XSetWindowBackgroundPixmap (Display* d, Window w, Pixmap p)
}

declare 68 win {
    void XSetWindowBorder (Display* d, Window w, unsigned long ul)
}

declare 69 win {
    void XSetWindowBorderPixmap (Display* d, Window w, Pixmap p)
}

declare 70 win {
    void XSetWindowBorderWidth (Display* d, Window w, unsigned int ui)
}

declare 71 win {
    void XSetWindowColormap (Display* d, Window w, Colormap c)
}

declare 72 win {
    Bool XTranslateCoordinates (Display* d, Window w1, Window w2, int i1,\
	    int i2, int* i3, int* i4, Window* w3)
}

declare 73 win {
    void XUngrabKeyboard (Display* d, Time t)
}

declare 74 win {
    void XUngrabPointer (Display* d, Time t) 
}

declare 75 win {
    void XUnmapWindow (Display* d, Window w)
}

declare 76 win {
    void XWindowEvent (Display* d, Window w, long l, XEvent* x)
}

declare 77 win {
    void XDestroyIC (XIC x)
}

declare 78 win {
    Bool XFilterEvent (XEvent* x, Window w)
}

declare 79 win {
    int XmbLookupString (XIC xi, XKeyPressedEvent* xk, \
	    char* c, int i, KeySym* k, Status* s)
}

declare 80 win {
    void TkPutImage (unsigned long *colors, \
	    int ncolors, Display* display, Drawable d, \
	    GC gc, XImage* image, int src_x, int src_y, \
	    int dest_x, int dest_y, unsigned int width, \
	    unsigned int height)
}
# This slot is reserved for use by the clipping rectangle patch:
#  declare 81 win {
#      XSetClipRectangles(Display *display, GC gc, int clip_x_origin, \
#  	    int clip_y_origin, XRectangle rectangles[], int n, int ordering)
#  }

declare 82 win {
    Status XParseColor (Display *display, Colormap map, \
          _Xconst char* spec, XColor *colorPtr)
}

declare 83 win {
    GC XCreateGC(Display* display, Drawable d, \
	    unsigned long valuemask, XGCValues* values)
}

declare 84 win {
    void XFreeGC(Display* display, GC gc)
}

declare 85 win {
    Atom XInternAtom(Display* display,_Xconst char* atom_name, \
	    Bool only_if_exists)
}

declare 86 win {
    void XSetBackground(Display* display, GC gc, \
	    unsigned long foreground)
}

declare 87 win {
    void XSetForeground(Display* display, GC gc, \
	    unsigned long foreground)
}

declare 88 win {
    void XSetClipMask(Display* display, GC gc, Pixmap pixmap)
}

declare 89 win {
    void XSetClipOrigin(Display* display, GC gc, \
	    int clip_x_origin, int clip_y_origin)
}

declare 90 win {
    void XSetTSOrigin(Display* display, GC gc, \
	    int ts_x_origin, int ts_y_origin)
}

declare 91 win {
    void XChangeGC(Display * d, GC gc, unsigned long mask, XGCValues *values)
}

declare 92 win {
    void XSetFont(Display *display, GC gc, Font font)
}

declare 93 win {
    void XSetArcMode(Display *display, GC gc, int arc_mode)
}

declare 94 win {
    void XSetStipple(Display *display, GC gc, Pixmap stipple)
}

declare 95 win {
    void XSetFillRule(Display *display, GC gc, int fill_rule)
}

declare 96 win {
    void XSetFillStyle(Display *display, GC gc, int fill_style)
}

declare 97 win {
    void XSetFunction(Display *display, GC gc, int function)
}

declare 98 win {
    void XSetLineAttributes(Display *display, GC gc, \
	    unsigned int line_width, int line_style, \
	    int cap_style, int join_style)
}

declare 99 win {
    int _XInitImageFuncPtrs(XImage *image)
}

declare 100 win {
    XIC XCreateIC(void)
}

declare 101 win {
    XVisualInfo *XGetVisualInfo(Display* display, long vinfo_mask, \
	    XVisualInfo* vinfo_template, int* nitems_return)
}

declare 102 win {
    void XSetWMClientMachine(Display* display, Window w, XTextProperty* text_prop)
}

declare 103 win {
    Status XStringListToTextProperty(char** list, int count, \
	    XTextProperty* text_prop_return)
}

# X functions for Mac

# This slot is reserved for use by the dash patch:
#  declare 0 win {
#	XSetDashes
#  }

declare 1 mac {
    XModifierKeymap* XGetModifierMapping (Display* d)
}

declare 2 mac {
    XImage * XCreateImage (Display* d, Visual* v, unsigned int ui1, int i1, \
	    int i2, char* cp, unsigned int ui2, unsigned int ui3, int i3, \
	    int i4)

}

declare 3 mac {
    XImage *XGetImage (Display* d, Drawable dr, int i1, int i2, \
	    unsigned int ui1, unsigned int ui2, unsigned long ul, int i3)
}

declare 4 mac {
    char *XGetAtomName (Display* d,Atom a)

}

declare 5 mac {
    char *XKeysymToString (KeySym k)
}

declare 6 mac {
    Colormap XCreateColormap (Display* d, Window w, Visual* v, int i)

}

declare 7 mac {
    GContext XGContextFromGC (GC g)
}

declare 8 mac {
    KeySym XKeycodeToKeysym (Display* d, KeyCode k, int i)
}

declare 9 mac {
    KeySym XStringToKeysym (_Xconst char* c)
}

declare 10 mac {
    Window XRootWindow (Display* d, int i)
}

declare 11 mac {
    XErrorHandler XSetErrorHandler  (XErrorHandler x)
}

declare 12 mac {
    Status XAllocColor (Display* d, Colormap c, XColor* xp)
}

declare 13 mac {
    void XBell (Display* d, int i)
}

declare 14 mac {
    void XChangeProperty (Display* d, Window w, Atom a, Atom a, int i1, \
	    int i2, _Xconst unsigned char* c, int i3)
}

declare 15 mac {
    void XChangeWindowAttributes (Display* d, Window w, unsigned long ul, \
	    XSetWindowAttributes* x)
}

declare 16 mac {
    void XConfigureWindow (Display* d, Window w, unsigned int i, \
	    XWindowChanges* x)
}

declare 17 mac {
    void XCopyArea (Display* d, Drawable dr1, Drawable dr2, GC g, int i1, \
	    int i2, unsigned int ui1, \
	    unsigned int ui2, int i3, int i4)
}

declare 18 mac {
    void XCopyPlane (Display* d, Drawable dr1, Drawable dr2, GC g, int i1, \
	    int i2, unsigned int ui1, \
	    unsigned int ui2, int i3, int i4, unsigned long ul)
}

declare 19 mac {
    Pixmap XCreateBitmapFromData(Display* display, Drawable d, \
	    _Xconst char* data, unsigned int width,unsigned int height)
}

declare 20 mac {
    void XDefineCursor (Display* d, Window w, Cursor c)
}

declare 21 mac {
    void XDestroyWindow (Display* d, Window w)
}

declare 22 mac {
    void XDrawArc (Display* d, Drawable dr, GC g, int i1, int i2, \
	    unsigned int ui1, unsigned int ui2, int i3, int i4)
}

declare 23 mac {
    void XDrawLines (Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2)
}

declare 24 mac {
    void XDrawRectangle (Display* d, Drawable dr, GC g, int i1, int i2,\
	    unsigned int ui1, unsigned int ui2)
}

declare 25 mac {
    void XFillArc (Display* d, Drawable dr, GC g, int i1, int i2, \
	    unsigned int ui1, unsigned int ui2, int i3, int i4)
}

declare 26 mac {
    void XFillPolygon (Display* d, Drawable dr, GC g, XPoint* x, \
	    int i1, int i2, int i3)
}

declare 27 mac {
    void XFillRectangles (Display* d, Drawable dr, GC g, XRectangle* x, int i)
}

declare 28 mac {
    void XFreeColormap (Display* d, Colormap c)
}

declare 29 mac {
    void XFreeColors (Display* d, Colormap c, \
	    unsigned long* ulp, int i, unsigned long ul)
}

declare 30 mac {
    void XFreeModifiermap (XModifierKeymap* x)
}

declare 31 mac {
    Status XGetGeometry (Display* d, Drawable dr, Window* w, int* i1, \
	    int* i2, unsigned int* ui1, unsigned int* ui2, unsigned int* ui3, \
	    unsigned int* ui4)
}

declare 32 mac {
    int XGetWindowProperty (Display* d, Window w, Atom a1, long l1, long l2, \
	    Bool b, Atom a2, Atom* ap, int* ip, unsigned long* ulp1, \
	    unsigned long* ulp2, unsigned char** cpp)
}

declare 33 mac {
    int XGrabKeyboard (Display* d, Window w, Bool b, int i1, int i2, Time t)
}

declare 34 mac {
    int XGrabPointer (Display* d, Window w1, Bool b, unsigned int ui, \
	    int i1, int i2, Window w2, Cursor c, Time t)
}

declare 35 mac {
    KeyCode XKeysymToKeycode (Display* d, KeySym k)
}

declare 36 mac {
    void XMapWindow (Display* d, Window w)
}

declare 37 mac {
    void XMoveResizeWindow (Display* d, Window w, int i1, int i2, \
	    unsigned int ui1, unsigned int ui2)
}

declare 38 mac {
    void XMoveWindow (Display* d, Window w, int i1, int i2)
}

declare 39 mac {
    Bool XQueryPointer (Display* d, Window w1, Window* w2, Window* w3, \
	    int* i1, int* i2, int* i3, int* i4, unsigned int* ui)
}

declare 40 mac {
    void XRaiseWindow (Display* d, Window w)
}

declare 41 mac {
    void XRefreshKeyboardMapping (XMappingEvent* x)
}

declare 42 mac {
    void XResizeWindow (Display* d, Window w, unsigned int ui1, \
	    unsigned int ui2)
}

declare 43 mac {
    void XSelectInput (Display* d, Window w, long l)
}

declare 44 mac {
    Status XSendEvent (Display* d, Window w, Bool b, long l, XEvent* x)
}

declare 45 mac {
    void XSetIconName (Display* d, Window w, _Xconst char* c)
}

declare 46 mac {
    void XSetInputFocus (Display* d, Window w, int i, Time t)
}

declare 47 mac {
    void XSetSelectionOwner (Display* d, Atom a, Window w, Time t)
}

declare 48 mac {
    void XSetWindowBackground (Display* d, Window w, unsigned long ul)
}

declare 49 mac {
    void XSetWindowBackgroundPixmap (Display* d, Window w, Pixmap p)
}

declare 50 mac {
    void XSetWindowBorder (Display* d, Window w, unsigned long ul)
}

declare 51 mac {
    void XSetWindowBorderPixmap (Display* d, Window w, Pixmap p)
}

declare 52 mac {
    void XSetWindowBorderWidth (Display* d, Window w, unsigned int ui)
}

declare 53 mac {
    void XSetWindowColormap (Display* d, Window w, Colormap c)
}

declare 54 mac {
    void XUngrabKeyboard (Display* d, Time t)
}

declare 55 mac {
    void XUngrabPointer (Display* d, Time t) 
}

declare 56 mac {
    void XUnmapWindow (Display* d, Window w)
}

declare 57 mac {
    void TkPutImage (unsigned long *colors, \
	    int ncolors, Display* display, Drawable d, \
	    GC gc, XImage* image, int src_x, int src_y, \
	    int dest_x, int dest_y, unsigned int width, \
	    unsigned int height)
} 
declare 58 mac {
    Status XParseColor (Display *display, Colormap map, \
          _Xconst char* spec, XColor *colorPtr)
}

declare 59 mac {
    GC XCreateGC(Display* display, Drawable d, \
	    unsigned long valuemask, XGCValues* values)
}

declare 60 mac {
    void XFreeGC(Display* display, GC gc)
}

declare 61 mac {
    Atom XInternAtom(Display* display,_Xconst char* atom_name, \
	    Bool only_if_exists)
}

declare 62 mac {
    void XSetBackground(Display* display, GC gc, \
	    unsigned long foreground)
}

declare 63 mac {
    void XSetForeground(Display* display, GC gc, \
	    unsigned long foreground)
}

declare 64 mac {
    void XSetClipMask(Display* display, GC gc, Pixmap pixmap)
}

declare 65 mac {
    void XSetClipOrigin(Display* display, GC gc, \
	    int clip_x_origin, int clip_y_origin)
}

declare 66 mac {
    void XSetTSOrigin(Display* display, GC gc, \
	    int ts_x_origin, int ts_y_origin)
}

declare 67 mac {
    void XChangeGC(Display * d, GC gc, unsigned long mask, XGCValues *values)
}

declare 68 mac {
    void XSetFont(Display *display, GC gc, Font font)
}

declare 69 mac {
    void XSetArcMode(Display *display, GC gc, int arc_mode)
}

declare 70 mac {
    void XSetStipple(Display *display, GC gc, Pixmap stipple)
}

declare 71 mac {
    void XSetFillRule(Display *display, GC gc, int fill_rule)
}

declare 72 mac {
    void XSetFillStyle(Display *display, GC gc, int fill_style)
}

declare 73 mac {
    void XSetFunction(Display *display, GC gc, int function)
}

declare 74 mac {
    void XSetLineAttributes(Display *display, GC gc, \
	    unsigned int line_width, int line_style, \
	    int cap_style, int join_style)
}

declare 75 mac {
    int _XInitImageFuncPtrs(XImage *image)
}

declare 76 mac {
    XIC XCreateIC(void)
}

declare 77 mac {
    XVisualInfo *XGetVisualInfo(Display* display, long vinfo_mask, \
	    XVisualInfo* vinfo_template, int* nitems_return)
}

declare 78 mac {
    void XSetWMClientMachine(Display* display, Window w, XTextProperty* text_prop)
}

declare 79 mac {
    Status XStringListToTextProperty(char** list, int count, \
	    XTextProperty* text_prop_return)
}

Changes to generic/tkInt.h.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkInt.h --
 *
 *	Declarations for things used internally by the Tk
 *	procedures but not exported outside the module.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkInt.h 1.204 97/10/31 09:55:20
 */

#ifndef _TKINT
#define _TKINT

#ifndef _TK
#include "tk.h"








>




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tkInt.h --
 *
 *	Declarations for things used internally by the Tk
 *	procedures but not exported outside the module.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: $Id: tkInt.h,v 1.1.4.4 1999/03/10 07:13:41 stanton Exp $ 
 */

#ifndef _TKINT
#define _TKINT

#ifndef _TK
#include "tk.h"
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
 * One of the following structures is maintained for each cursor in
 * use in the system.  This structure is used by tkCursor.c and the
 * various system specific cursor files.
 */

typedef struct TkCursor {
    Tk_Cursor cursor;		/* System specific identifier for cursor. */


    int refCount;		/* Number of active uses of cursor. */











    Tcl_HashTable *otherTable;	/* Second table (other than idTable) used
				 * to index this entry. */
    Tcl_HashEntry *hashPtr;	/* Entry in otherTable for this structure
				 * (needed when deleting). */






} TkCursor;

/*
 * One of the following structures is maintained for each display
 * containing a window managed by Tk:


 */

typedef struct TkDisplay {
    Display *display;		/* Xlib's info about display. */
    struct TkDisplay *nextPtr;	/* Next in list of all displays. */
    char *name;			/* Name of display (with any screen
				 * identifier removed).  Malloc-ed. */
    Time lastEventTime;		/* Time of last event received for this
				 * display. */


















    /*
     * Information used primarily by tkBind.c:
     */

    int bindInfoStale;		/* Non-zero means the variables in this
				 * part of the structure are potentially
				 * incorrect and should be recomputed. */







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




>
>
>
>
>
>




|
>
>










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







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
 * One of the following structures is maintained for each cursor in
 * use in the system.  This structure is used by tkCursor.c and the
 * various system specific cursor files.
 */

typedef struct TkCursor {
    Tk_Cursor cursor;		/* System specific identifier for cursor. */
    Display *display;		/* Display containing cursor. Needed for
				 * disposal and retrieval of cursors. */
    int resourceRefCount;	/* Number of active uses of this cursor (each
				 * active use corresponds to a call to
				 * Tk_AllocPreserveFromObj or Tk_GetPreserve).
				 * If this count is 0, then this structure
				 * is no longer valid and it isn't present
				 * in a hash table: it is being kept around
				 * only because there are objects referring
				 * to it.  The structure is freed when
				 * resourceRefCount and objRefCount are
				 * both 0. */
    int objRefCount;		/* Number of Tcl objects that reference
				 * this structure.. */
    Tcl_HashTable *otherTable;	/* Second table (other than idTable) used
				 * to index this entry. */
    Tcl_HashEntry *hashPtr;	/* Entry in otherTable for this structure
				 * (needed when deleting). */
    Tcl_HashEntry *idHashPtr;	/* Entry in idTable for this structure
				 * (needed when deleting). */
    struct TkCursor *nextPtr;	/* Points to the next TkCursor structure with
				 * the same name.  Cursors with the same
				 * name but different displays are chained
				 * together off a single hash table entry. */
} TkCursor;

/*
 * One of the following structures is maintained for each display
 * containing a window managed by Tk.  In part, the structure is 
 * used to store thread-specific data, since each thread will have 
 * its own TkDisplay structure.
 */

typedef struct TkDisplay {
    Display *display;		/* Xlib's info about display. */
    struct TkDisplay *nextPtr;	/* Next in list of all displays. */
    char *name;			/* Name of display (with any screen
				 * identifier removed).  Malloc-ed. */
    Time lastEventTime;		/* Time of last event received for this
				 * display. */

    /*
     * Information used primarily by tk3d.c:
     */

    int borderInit;             /* 0 means borderTable needs initializing. */
    Tcl_HashTable borderTable;  /* Maps from color name to TkBorder 
				 * structure. */

    /*
     * Information used by tkAtom.c only:
     */

    int atomInit;		/* 0 means stuff below hasn't been
				 * initialized yet. */
    Tcl_HashTable nameTable;	/* Maps from names to Atom's. */
    Tcl_HashTable atomTable;	/* Maps from Atom's back to names. */

    /*
     * Information used primarily by tkBind.c:
     */

    int bindInfoStale;		/* Non-zero means the variables in this
				 * part of the structure are potentially
				 * incorrect and should be recomputed. */
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
    int numModKeyCodes;		/* Number of entries in modKeyCodes array
				 * below. */
    KeyCode *modKeyCodes;	/* Pointer to an array giving keycodes for
				 * all of the keys that have modifiers
				 * associated with them.  Malloc'ed, but
				 * may be NULL. */


























































    /*
     * Information used by tkError.c only:
     */

    struct TkErrorHandler *errorPtr;
				/* First in list of error handlers
				 * for this display.  NULL means
				 * no handlers exist at present. */
    int deleteCount;		/* Counts # of handlers deleted since
				 * last time inactive handlers were
				 * garbage-collected.  When this number
				 * gets big, handlers get cleaned up. */

    /*
     * Information used by tkSend.c only:
     */

    Tk_Window commTkwin;	/* Window used for communication

				 * between interpreters during "send"


				 * commands.  NULL means send info hasn't

				 * been initialized yet. */
    Atom commProperty;		/* X's name for comm property. */
    Atom registryProperty;	/* X's name for property containing
				 * registry of interpreter names. */
    Atom appNameProperty;	/* X's name for property used to hold the
				 * application name on each comm window. */

    /*
     * Information used by tkSelect.c and tkClipboard.c only:
     */



    struct TkSelectionInfo *selectionInfoPtr;
				/* First in list of selection information
				 * records.  Each entry contains information
				 * about the current owner of a particular
				 * selection on this display. */
    Atom multipleAtom;		/* Atom for MULTIPLE.  None means
				 * selection stuff isn't initialized. */
    Atom incrAtom;		/* Atom for INCR. */
    Atom targetsAtom;		/* Atom for TARGETS. */
    Atom timestampAtom;		/* Atom for TIMESTAMP. */
    Atom textAtom;		/* Atom for TEXT. */
    Atom compoundTextAtom;	/* Atom for COMPOUND_TEXT. */
    Atom applicationAtom;	/* Atom for TK_APPLICATION. */

    Atom windowAtom;		/* Atom for TK_WINDOW. */
    Atom clipboardAtom;		/* Atom for CLIPBOARD. */


    Tk_Window clipWindow;	/* Window used for clipboard ownership and to

				 * retrieve selections between processes. NULL



				 * means clipboard info hasn't been
				 * initialized. */
    int clipboardActive;	/* 1 means we currently own the clipboard
				 * selection, 0 means we don't. */
    struct TkMainInfo *clipboardAppPtr;
				/* Last application that owned clipboard. */
    struct TkClipboardTarget *clipTargetPtr;
				/* First in list of clipboard type information
				 * records.  Each entry contains information
				 * about the buffers for a given selection
				 * target. */

    /*
     * Information used by tkAtom.c only:
     */

    int atomInit;		/* 0 means stuff below hasn't been
				 * initialized yet. */
    Tcl_HashTable nameTable;	/* Maps from names to Atom's. */
    Tcl_HashTable atomTable;	/* Maps from Atom's back to names. */




    /*
     * Information used by tkCursor.c only:
     */

    Font cursorFont;		/* Font to use for standard cursors.

				 * None means font not loaded yet. */

    /*
     * Information used by tkGrab.c only:
     */

    struct TkWindow *grabWinPtr;
				/* Window in which the pointer is currently







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














|


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


|


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

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


|


<
<
|
|
>
>
>


|

|
<
>
|







161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249





250
251
252
253
254
255
256
257

258
259
260
261
262
263
264
265
266
267
268
269
270

271
272
273
274
275
276
277
278
279
280









281
282
283
284
285


286
287
288
289
290
291
292
293
294
295

296
297
298
299
300
301
302
303
304
    int numModKeyCodes;		/* Number of entries in modKeyCodes array
				 * below. */
    KeyCode *modKeyCodes;	/* Pointer to an array giving keycodes for
				 * all of the keys that have modifiers
				 * associated with them.  Malloc'ed, but
				 * may be NULL. */

    /*
     * Information used by tkBitmap.c only:
     */
  
    int bitmapInit;             /* 0 means tables above need initializing. */
    int bitmapAutoNumber;       /* Used to number bitmaps. */
    Tcl_HashTable bitmapNameTable;    
                                /* Maps from name of bitmap to the first 
				 * TkBitmap record for that name. */
    Tcl_HashTable bitmapIdTable;/* Maps from bitmap id to the TkBitmap
				 * structure for the bitmap. */
    Tcl_HashTable bitmapDataTable;    
                                /* Used by Tk_GetBitmapFromData to map from
				 * a collection of in-core data about a 
				 * bitmap to a reference giving an auto-
				 * matically-generated name for the bitmap. */

    /*
     * Information used by tkCanvas.c only:
     */

    int numIdSearches;          
    int numSlowSearches;

    /*
     * Used by tkColor.c only:
     */

    int colorInit;              /* 0 means color module needs initializing. */
    TkStressedCmap *stressPtr;	/* First in list of colormaps that have
				 * filled up, so we have to pick an
				 * approximate color. */
    Tcl_HashTable colorNameTable;
                                /* Maps from color name to TkColor structure
				 * for that color. */
    Tcl_HashTable colorValueTable;
                                /* Maps from integer RGB values to TkColor
				 * structures. */

    /*
     * Used by tkCursor.c only:
     */

    int cursorInit;             /* 0 means cursor module need initializing. */
    Tcl_HashTable cursorNameTable;
                                /* Maps from a string name to a cursor to the
				 * TkCursor record for the cursor. */
    Tcl_HashTable cursorDataTable;
                                /* Maps from a collection of in-core data
				 * about a cursor to a TkCursor structure. */
    Tcl_HashTable cursorIdTable;
                                /* Maps from a cursor id to the TkCursor
				 * structure for the cursor. */
    char cursorString[20];      /* Used to store a cursor id string. */
    Font cursorFont;		/* Font to use for standard cursors.
				 * None means font not loaded yet. */

    /*
     * Information used by tkError.c only:
     */

    struct TkErrorHandler *errorPtr;
				/* First in list of error handlers
				 * for this display.  NULL means
				 * no handlers exist at present. */
    int deleteCount;		/* Counts # of handlers deleted since
				 * last time inactive handlers were
				 * garbage-collected.  When this number
				 * gets big, handlers get cleaned up. */

    /*
     * Used by tkEvent.c only:
     */

    struct TkWindowEvent *delayedMotionPtr;
				/* Points to a malloc-ed motion event
				 * whose processing has been delayed in
				 * the hopes that another motion event
				 * will come along right away and we can
				 * merge the two of them together.  NULL
				 * means that there is no delayed motion
				 * event. */






    /*
     * Information used by tkFocus.c only:
     */

    int focusDebug;             /* 1 means collect focus debugging 
				 * statistics. */
    struct TkWindow *implicitWinPtr;

				/* If the focus arrived at a toplevel window
				 * implicitly via an Enter event (rather
				 * than via a FocusIn event), this points
				 * to the toplevel window.  Otherwise it is
				 * NULL. */
    struct TkWindow *focusPtr;	/* Points to the window on this display that
				 * should be receiving keyboard events.  When
				 * multiple applications on the display have
				 * the focus, this will refer to the
				 * innermost window in the innermost
				 * application.  This information isn't used
				 * under Unix or Windows, but it's needed on
				 * the Macintosh. */


    /*
     * Information used by tkGC.c only:
     */
    
    Tcl_HashTable gcValueTable; /* Maps from a GC's values to a TkGC structure
				 * describing a GC with those values. */
    Tcl_HashTable gcIdTable;    /* Maps from a GC to a TkGC. */ 
    int gcInit;                 /* 0 means the tables below need 
				 * initializing. */










    /*
     * Information used by tkGeometry.c only:
     */



    Tcl_HashTable maintainHashTable;
                                /* Hash table that maps from a master's 
				 * Tk_Window token to a list of slaves
				 * managed by that master. */
    int geomInit;    

    /*
     * Information used by tkGet.c only:
     */
  

    Tcl_HashTable uidTable;     /* Stores all Tk_Uids used in a thread. */
    int uidInit;                /* 0 means uidTable needs initializing. */

    /*
     * Information used by tkGrab.c only:
     */

    struct TkWindow *grabWinPtr;
				/* Window in which the pointer is currently
234
235
236
237
238
239
240






























































































241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258













259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
				 * events. */
    TkGrabEvent *lastGrabEventPtr;
				/* Last in list of synthesized events, or NULL
				 * if list is empty. */
    int grabFlags;		/* Miscellaneous flag values.  See definitions
				 * in tkGrab.c. */































































































    /*
     * Information used by tkXId.c only:
     */

    struct TkIdStack *idStackPtr;
				/* First in list of chunks of free resource
				 * identifiers, or NULL if there are no free
				 * resources. */
    XID (*defaultAllocProc) _ANSI_ARGS_((Display *display));
				/* Default resource allocator for display. */
    struct TkIdStack *windowStackPtr;
				/* First in list of chunks of window
				 * identifers that can't be reused right
				 * now. */
    int idCleanupScheduled;	/* 1 means a call to WindowIdCleanup has
				 * already been scheduled, 0 means it
				 * hasn't. */














    /*
     * Information maintained by tkWindow.c for use later on by tkXId.c:
     */


    int destroyCount;		/* Number of Tk_DestroyWindow operations
				 * in progress. */
    unsigned long lastDestroyRequest;
				/* Id of most recent XDestroyWindow request;
				 * can re-use ids in windowStackPtr when
				 * server has seen this request and event
				 * queue is empty. */

    /*
     * Information used by tkVisual.c only:
     */

    TkColormap *cmapPtr;	/* First in list of all non-default colormaps
				 * allocated for this display. */

    /*
     * Information used by tkFocus.c only:
     */

    struct TkWindow *implicitWinPtr;
				/* If the focus arrived at a toplevel window
				 * implicitly via an Enter event (rather
				 * than via a FocusIn event), this points
				 * to the toplevel window.  Otherwise it is
				 * NULL. */
    struct TkWindow *focusPtr;	/* Points to the window on this display that
				 * should be receiving keyboard events.  When
				 * multiple applications on the display have
				 * the focus, this will refer to the
				 * innermost window in the innermost
				 * application.  This information isn't used
				 * under Unix or Windows, but it's needed on
				 * the Macintosh. */

    /*
     * Used by tkColor.c only:
     */

    TkStressedCmap *stressPtr;	/* First in list of colormaps that have
				 * filled up, so we have to pick an
				 * approximate color. */

    /*
     * Used by tkEvent.c only:
     */

    struct TkWindowEvent *delayedMotionPtr;
				/* Points to a malloc-ed motion event
				 * whose processing has been delayed in
				 * the hopes that another motion event
				 * will come along right away and we can
				 * merge the two of them together.  NULL
				 * means that there is no delayed motion
				 * event. */

    /*
     * Miscellaneous information:
     */

#ifdef TK_USE_INPUT_METHODS
    XIM inputMethod;		/* Input method for this display */
#endif /* TK_USE_INPUT_METHODS */







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


















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




















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







327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478








































479
480
481
482
483
484
485
				 * events. */
    TkGrabEvent *lastGrabEventPtr;
				/* Last in list of synthesized events, or NULL
				 * if list is empty. */
    int grabFlags;		/* Miscellaneous flag values.  See definitions
				 * in tkGrab.c. */

    /*
     * Information used by tkGrid.c only:
     */

    int gridInit;               /* 0 means table below needs initializing. */
    Tcl_HashTable gridHashTable;/* Maps from Tk_Window tokens to 
				 * corresponding Grid structures. */

    /*
     * Information used by tkImage.c only:
     */

    int imageId;                /* Value used to number image ids. */

    /*
     * Information used by tkMacWinMenu.c only:
     */

    int postCommandGeneration;  

    /*
     * Information used by tkOption.c only.
     */



    /*
     * Information used by tkPack.c only.
     */

    int packInit;              /* 0 means table below needs initializing. */
    Tcl_HashTable packerHashTable;
                               /* Maps from Tk_Window tokens to 
				* corresponding Packer structures. */
    

    /*
     * Information used by tkPlace.c only.
     */

    int placeInit;              /* 0 means tables below need initializing. */
    Tcl_HashTable masterTable;  /* Maps from Tk_Window toke to the Master
				 * structure for the window, if it exists. */
    Tcl_HashTable slaveTable;   /* Maps from Tk_Window toke to the Slave
				 * structure for the window, if it exists. */

    /*
     * Information used by tkSelect.c and tkClipboard.c only:
     */

    struct TkSelectionInfo *selectionInfoPtr;
				/* First in list of selection information
				 * records.  Each entry contains information
				 * about the current owner of a particular
				 * selection on this display. */
    Atom multipleAtom;		/* Atom for MULTIPLE.  None means
				 * selection stuff isn't initialized. */
    Atom incrAtom;		/* Atom for INCR. */
    Atom targetsAtom;		/* Atom for TARGETS. */
    Atom timestampAtom;		/* Atom for TIMESTAMP. */
    Atom textAtom;		/* Atom for TEXT. */
    Atom compoundTextAtom;	/* Atom for COMPOUND_TEXT. */
    Atom applicationAtom;	/* Atom for TK_APPLICATION. */
    Atom windowAtom;		/* Atom for TK_WINDOW. */
    Atom clipboardAtom;		/* Atom for CLIPBOARD. */

    Tk_Window clipWindow;	/* Window used for clipboard ownership and to
				 * retrieve selections between processes. NULL
				 * means clipboard info hasn't been
				 * initialized. */
    int clipboardActive;	/* 1 means we currently own the clipboard
				 * selection, 0 means we don't. */
    struct TkMainInfo *clipboardAppPtr;
				/* Last application that owned clipboard. */
    struct TkClipboardTarget *clipTargetPtr;
				/* First in list of clipboard type information
				 * records.  Each entry contains information
				 * about the buffers for a given selection
				 * target. */

    /*
     * Information used by tkSend.c only:
     */

    Tk_Window commTkwin;	/* Window used for communication
				 * between interpreters during "send"
				 * commands.  NULL means send info hasn't
				 * been initialized yet. */
    Atom commProperty;		/* X's name for comm property. */
    Atom registryProperty;	/* X's name for property containing
				 * registry of interpreter names. */
    Atom appNameProperty;	/* X's name for property used to hold the
				 * application name on each comm window. */

    /*
     * Information used by tkXId.c only:
     */

    struct TkIdStack *idStackPtr;
				/* First in list of chunks of free resource
				 * identifiers, or NULL if there are no free
				 * resources. */
    XID (*defaultAllocProc) _ANSI_ARGS_((Display *display));
				/* Default resource allocator for display. */
    struct TkIdStack *windowStackPtr;
				/* First in list of chunks of window
				 * identifers that can't be reused right
				 * now. */
    int idCleanupScheduled;	/* 1 means a call to WindowIdCleanup has
				 * already been scheduled, 0 means it
				 * hasn't. */

    /*
     * Information used by tkUnixWm.c and tkWinWm.c only:
     */

    int wmTracing;              /* Used to enable or disable tracing in 
				 * this module.  If tracing is enabled, 
				 * then information is printed on
				 * standard output about interesting 
				 * interactions with the window manager. */
    struct TkWmInfo *firstWmPtr;  /* Points to first top-level window. */
    struct TkWmInfo *foregroundWmPtr;    
                                /* Points to the foreground window. */

    /*
     * Information maintained by tkWindow.c for use later on by tkXId.c:
     */


    int destroyCount;		/* Number of Tk_DestroyWindow operations
				 * in progress. */
    unsigned long lastDestroyRequest;
				/* Id of most recent XDestroyWindow request;
				 * can re-use ids in windowStackPtr when
				 * server has seen this request and event
				 * queue is empty. */

    /*
     * Information used by tkVisual.c only:
     */

    TkColormap *cmapPtr;	/* First in list of all non-default colormaps
				 * allocated for this display. */









































    /*
     * Miscellaneous information:
     */

#ifdef TK_USE_INPUT_METHODS
    XIM inputMethod;		/* Input method for this display */
#endif /* TK_USE_INPUT_METHODS */
362
363
364
365
366
367
368



369
370
371
372
373
374
375
    ClientData clientData;	/* Arbitrary value to pass to
				 * errorProc. */
    struct TkErrorHandler *nextPtr;
				/* Pointer to next older handler for
				 * this display, or NULL for end of
				 * list. */
} TkErrorHandler;




/*
 * One of the following structures exists for each event handler
 * created by calling Tk_CreateEventHandler.  This information
 * is used by tkEvent.c only.
 */








>
>
>







522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
    ClientData clientData;	/* Arbitrary value to pass to
				 * errorProc. */
    struct TkErrorHandler *nextPtr;
				/* Pointer to next older handler for
				 * this display, or NULL for end of
				 * list. */
} TkErrorHandler;




/*
 * One of the following structures exists for each event handler
 * created by calling Tk_CreateEventHandler.  This information
 * is used by tkEvent.c only.
 */

405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
    Tcl_HashTable nameTable;	/* Hash table mapping path names to TkWindow
				 * structs for all windows related to this
				 * main window.  Managed by tkWindow.c. */
    Tk_BindingTable bindingTable;
				/* Used in conjunction with "bind" command
				 * to bind events to Tcl commands. */
    TkBindInfo bindInfo;	/* Information used by tkBind.c on a per
				 * interpreter basis. */
    struct TkFontInfo *fontInfoPtr;
				/* Hold named font tables.  Used only by
				 * tkFont.c. */

    /*
     * Information used only by tkFocus.c and tk*Embed.c:
     */

    struct TkToplevelFocusInfo *tlFocusPtr;
				/* First in list of records containing focus







|

|
|







568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
    Tcl_HashTable nameTable;	/* Hash table mapping path names to TkWindow
				 * structs for all windows related to this
				 * main window.  Managed by tkWindow.c. */
    Tk_BindingTable bindingTable;
				/* Used in conjunction with "bind" command
				 * to bind events to Tcl commands. */
    TkBindInfo bindInfo;	/* Information used by tkBind.c on a per
				 * application basis. */
    struct TkFontInfo *fontInfoPtr;
				/* Information used by tkFont.c on a per
				 * application basis. */

    /*
     * Information used only by tkFocus.c and tk*Embed.c:
     */

    struct TkToplevelFocusInfo *tlFocusPtr;
				/* First in list of records containing focus
692
693
694
695
696
697
698







699
700
701
702
703


704
705

706
707
708


709

710


711

712
713







714



715


716
717

718

719

720

721
722
723

724
725

726












727
728
729

730

731


732


733
734






735
736
737
738

739
740


741
742
743












744










745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989



990
extern Tk_PhotoImageFormat	tkImgFmtPPM;
extern TkMainInfo		*tkMainWindowList;
extern Tk_Uid			tkNormalUid;
extern Tk_ImageType		tkPhotoImageType;
extern Tcl_HashTable		tkPredefBitmapTable;
extern int			tkSendSerial;








/*
 * Internal procedures shared among Tk modules but not exported
 * to the outside world:
 */



EXTERN char *		TkAlignImageData _ANSI_ARGS_((XImage *image,
			    int alignment, int bitOrder));

EXTERN TkWindow *	TkAllocWindow _ANSI_ARGS_((TkDisplay *dispPtr,
			    int screenNum, TkWindow *parentPtr));
EXTERN int		TkAreaToPolygon _ANSI_ARGS_((double *polyPtr,


			    int numPoints, double *rectPtr));

EXTERN void		TkBezierPoints _ANSI_ARGS_((double control[],


			    int numSteps, double *coordPtr));

EXTERN void		TkBezierScreenPoints _ANSI_ARGS_((Tk_Canvas canvas,
			    double control[], int numSteps,







			    XPoint *xPointPtr));



EXTERN void		TkBindDeadWindow _ANSI_ARGS_((TkWindow *winPtr));


EXTERN void		TkBindEventProc _ANSI_ARGS_((TkWindow *winPtr,
			    XEvent *eventPtr));

EXTERN void		TkBindFree _ANSI_ARGS_((TkMainInfo *mainPtr));

EXTERN void		TkBindInit _ANSI_ARGS_((TkMainInfo *mainPtr));

EXTERN void		TkChangeEventWindow _ANSI_ARGS_((XEvent *eventPtr,

			    TkWindow *winPtr));
#ifndef TkClipBox
EXTERN void		TkClipBox _ANSI_ARGS_((TkRegion rgn,

			    XRectangle* rect_return));
#endif

EXTERN int		TkClipInit _ANSI_ARGS_((Tcl_Interp *interp,












			    TkDisplay *dispPtr));
EXTERN void		TkComputeAnchor _ANSI_ARGS_((Tk_Anchor anchor,
			    Tk_Window tkwin, int padX, int padY,

			    int innerWidth, int innerHeight, int *xPtr,

			    int *yPtr));


EXTERN int		TkCopyAndGlobalEval _ANSI_ARGS_((Tcl_Interp *interp,


			    char *script));
EXTERN unsigned long	TkCreateBindingProcedure _ANSI_ARGS_((






			    Tcl_Interp *interp, Tk_BindingTable bindingTable,
			    ClientData object, char *eventString,
			    TkBindEvalProc *evalProc, TkBindFreeProc *freeProc,
			    ClientData clientData));

EXTERN TkCursor *	TkCreateCursorFromData _ANSI_ARGS_((Tk_Window tkwin,
			    char *source, char *mask, int width, int height,


			    int xHot, int yHot, XColor fg, XColor bg));
EXTERN int		TkCreateFrame _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv,












			    int toplevel, char *appName));










EXTERN Tk_Window	TkCreateMainWindow _ANSI_ARGS_((Tcl_Interp *interp,
			    char *screenName, char *baseName));
#ifndef TkCreateRegion
EXTERN TkRegion		TkCreateRegion _ANSI_ARGS_((void));
#endif
EXTERN Time		TkCurrentTime _ANSI_ARGS_((TkDisplay *dispPtr));
EXTERN int		TkDeadAppCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN void		TkDeleteAllImages _ANSI_ARGS_((TkMainInfo *mainPtr));
#ifndef TkDestroyRegion
EXTERN void		TkDestroyRegion _ANSI_ARGS_((TkRegion rgn));
#endif
EXTERN void		TkDoConfigureNotify _ANSI_ARGS_((TkWindow *winPtr));
EXTERN void		TkDrawInsetFocusHighlight _ANSI_ARGS_((
			    Tk_Window tkwin, GC gc, int width,
			    Drawable drawable, int padding));
EXTERN void		TkEventCleanupProc _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp));
EXTERN void		TkEventDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
EXTERN void		TkFillPolygon _ANSI_ARGS_((Tk_Canvas canvas,
			    double *coordPtr, int numPoints, Display *display,
			    Drawable drawable, GC gc, GC outlineGC));
EXTERN int		TkFindStateNum _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *option, CONST TkStateMap *mapPtr,
			    CONST char *strKey));
EXTERN char *		TkFindStateString _ANSI_ARGS_((
			    CONST TkStateMap *mapPtr, int numKey));
EXTERN void		TkFocusDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
EXTERN int		TkFocusFilterEvent _ANSI_ARGS_((TkWindow *winPtr,
			    XEvent *eventPtr));
EXTERN TkWindow *	TkFocusKeyEvent _ANSI_ARGS_((TkWindow *winPtr,
			    XEvent *eventPtr));
EXTERN void		TkFontPkgInit _ANSI_ARGS_((TkMainInfo *mainPtr));
EXTERN void		TkFontPkgFree _ANSI_ARGS_((TkMainInfo *mainPtr));
EXTERN void		TkFreeBindingTags _ANSI_ARGS_((TkWindow *winPtr));
EXTERN void		TkFreeCursor _ANSI_ARGS_((TkCursor *cursorPtr));
EXTERN void		TkFreeWindowId _ANSI_ARGS_((TkDisplay *dispPtr,
			    Window w));
EXTERN void		TkGenerateActivateEvents _ANSI_ARGS_((
			    TkWindow *winPtr, int active));
EXTERN char *		TkGetBitmapData _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, char *fileName, int *widthPtr,
			    int *heightPtr, int *hotXPtr, int *hotYPtr));
EXTERN void		TkGetButtPoints _ANSI_ARGS_((double p1[], double p2[],
			    double width, int project, double m1[],
			    double m2[]));
EXTERN TkCursor *	TkGetCursorByName _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Tk_Uid string));
EXTERN char *		TkGetDefaultScreenName _ANSI_ARGS_((Tcl_Interp *interp,
			    char *screenName));
EXTERN TkDisplay *	TkGetDisplay _ANSI_ARGS_((Display *display));
EXTERN int		TkGetDisplayOf _ANSI_ARGS_((Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[],
			    Tk_Window *tkwinPtr));
EXTERN TkWindow *	TkGetFocusWin _ANSI_ARGS_((TkWindow *winPtr));
EXTERN int		TkGetInterpNames _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin));
EXTERN int		TkGetMiterPoints _ANSI_ARGS_((double p1[], double p2[],
			    double p3[], double width, double m1[],
			    double m2[]));
#ifndef TkGetNativeProlog
EXTERN int		TkGetNativeProlog _ANSI_ARGS_((Tcl_Interp *interp));
#endif
EXTERN void		TkGetPointerCoords _ANSI_ARGS_((Tk_Window tkwin,
			    int *xPtr, int *yPtr));
EXTERN int		TkGetProlog _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN void		TkGetServerInfo _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin));
EXTERN void		TkGrabDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
EXTERN int		TkGrabState _ANSI_ARGS_((TkWindow *winPtr));
EXTERN TkWindow *      	TkIDToWindow _ANSI_ARGS_((Window window, 
			    TkDisplay *display));
EXTERN void		TkIncludePoint _ANSI_ARGS_((Tk_Item *itemPtr,
			    double *pointPtr));
EXTERN void		TkInitXId _ANSI_ARGS_((TkDisplay *dispPtr));
EXTERN void		TkInOutEvents _ANSI_ARGS_((XEvent *eventPtr,
			    TkWindow *sourcePtr, TkWindow *destPtr,
			    int leaveType, int enterType,
			    Tcl_QueuePosition position));
EXTERN void		TkInstallFrameMenu _ANSI_ARGS_((Tk_Window tkwin));
#ifndef TkIntersectRegion
EXTERN void		TkIntersectRegion _ANSI_ARGS_((TkRegion sra,
			    TkRegion srcb, TkRegion dr_return));
#endif
EXTERN char *		TkKeysymToString _ANSI_ARGS_((KeySym keysym));
EXTERN int		TkLineToArea _ANSI_ARGS_((double end1Ptr[2],
			    double end2Ptr[2], double rectPtr[4]));
EXTERN double		TkLineToPoint _ANSI_ARGS_((double end1Ptr[2],
			    double end2Ptr[2], double pointPtr[2]));
EXTERN int		TkListAppend _ANSI_ARGS_((void **headPtrPtr,
			    void *itemPtr, size_t size));
EXTERN int		TkListDelete _ANSI_ARGS_((void **headPtrPtr,
			    void *itemPtr, size_t size));
EXTERN void *		TkListFind _ANSI_ARGS_((void *headPtr, void *itemPtr,
			    size_t size));
EXTERN int		TkMakeBezierCurve _ANSI_ARGS_((Tk_Canvas canvas,
			    double *pointPtr, int numPoints, int numSteps,
			    XPoint xPoints[], double dblPoints[]));
EXTERN void		TkMakeBezierPostscript _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Canvas canvas, double *pointPtr,
			    int numPoints));
EXTERN void		TkOptionClassChanged _ANSI_ARGS_((TkWindow *winPtr));
EXTERN void		TkOptionDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
EXTERN int		TkOvalToArea _ANSI_ARGS_((double *ovalPtr,
			    double *rectPtr));
EXTERN double		TkOvalToPoint _ANSI_ARGS_((double ovalPtr[4],
			    double width, int filled, double pointPtr[2]));
EXTERN int		TkpChangeFocus _ANSI_ARGS_((TkWindow *winPtr,
			    int force));
EXTERN void		TkpCloseDisplay _ANSI_ARGS_((TkDisplay *dispPtr));
EXTERN void		TkpClaimFocus _ANSI_ARGS_((TkWindow *topLevelPtr,
			    int force));
#ifndef TkpCmapStressed
EXTERN int		TkpCmapStressed _ANSI_ARGS_((Tk_Window tkwin,
			    Colormap colormap));
#endif
#ifndef TkpCreateNativeBitmap
EXTERN Pixmap		TkpCreateNativeBitmap _ANSI_ARGS_((Display *display,
			    char * source));
#endif
#ifndef TkpDefineNativeBitmaps
EXTERN void		TkpDefineNativeBitmaps _ANSI_ARGS_((void));
#endif
EXTERN void		TkpDisplayWarning _ANSI_ARGS_((char *msg,
			    char *title));
EXTERN void		TkpGetAppName _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_DString *name));
EXTERN unsigned long	TkpGetMS _ANSI_ARGS_((void));
#ifndef TkpGetNativeAppBitmap
EXTERN Pixmap		TkpGetNativeAppBitmap _ANSI_ARGS_((Display *display,
			    char *name, int *width, int *height));
#endif
EXTERN TkWindow *	TkpGetOtherWindow _ANSI_ARGS_((TkWindow *winPtr));
EXTERN TkWindow *	TkpGetWrapperWindow _ANSI_ARGS_((TkWindow *winPtr));
EXTERN int		TkpInit _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN void		TkpInitializeMenuBindings _ANSI_ARGS_((
			    Tcl_Interp *interp, Tk_BindingTable bindingTable));
EXTERN void		TkpMakeContainer _ANSI_ARGS_((Tk_Window tkwin));
EXTERN void		TkpMakeMenuWindow _ANSI_ARGS_((Tk_Window tkwin,
			    int transient));
EXTERN Window		TkpMakeWindow _ANSI_ARGS_((TkWindow *winPtr,
			    Window parent));
EXTERN void		TkpMenuNotifyToplevelCreate _ANSI_ARGS_((
			    Tcl_Interp *, char *menuName));
EXTERN TkDisplay *	TkpOpenDisplay _ANSI_ARGS_((char *display_name));
EXTERN void		TkPointerDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
EXTERN int		TkPointerEvent _ANSI_ARGS_((XEvent *eventPtr,
			    TkWindow *winPtr));
EXTERN int		TkPolygonToArea _ANSI_ARGS_((double *polyPtr,
			    int numPoints, double *rectPtr));
EXTERN double		TkPolygonToPoint _ANSI_ARGS_((double *polyPtr,
			    int numPoints, double *pointPtr));
EXTERN int		TkPositionInTree _ANSI_ARGS_((TkWindow *winPtr,
			    TkWindow *treePtr));
#ifndef TkpPrintWindowId
EXTERN void		TkpPrintWindowId _ANSI_ARGS_((char *buf,
			    Window window));
#endif
EXTERN void		TkpRedirectKeyEvent _ANSI_ARGS_((TkWindow *winPtr,
			    XEvent *eventPtr));
#ifndef TkpScanWindowId
EXTERN int		TkpScanWindowId _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, int *idPtr));
#endif
EXTERN void		TkpSetCapture _ANSI_ARGS_((TkWindow *winPtr));
EXTERN void		TkpSetCursor _ANSI_ARGS_((TkpCursor cursor));
EXTERN void		TkpSetMainMenubar _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *menuName));
#ifndef TkpSync
EXTERN void		TkpSync _ANSI_ARGS_((Display *display));
#endif
EXTERN int		TkpTestembedCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		TkpUseWindow _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *string));
#ifndef TkPutImage
EXTERN void		TkPutImage _ANSI_ARGS_((unsigned long *colors,
			    int ncolors, Display* display, Drawable d,
			    GC gc, XImage* image, int src_x, int src_y,
			    int dest_x, int dest_y, unsigned int width,
			    unsigned int height));
#endif
EXTERN int		TkpWindowWasRecentlyDeleted _ANSI_ARGS_((Window win,
			    TkDisplay *dispPtr));
EXTERN void		TkpWmSetState _ANSI_ARGS_((TkWindow *winPtr,
			    int state));
EXTERN void		TkQueueEventForAllChildren _ANSI_ARGS_((
			    TkWindow *winPtr, XEvent *eventPtr));
#ifndef TkRectInRegion
EXTERN int		TkRectInRegion _ANSI_ARGS_((TkRegion rgn,
			    int x, int y, unsigned int width,
			    unsigned int height));
#endif
EXTERN int		TkScrollWindow _ANSI_ARGS_((Tk_Window tkwin, GC gc,
			    int x, int y, int width, int height, int dx,
			    int dy, TkRegion damageRgn));
EXTERN void		TkSelDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
EXTERN void		TkSelEventProc _ANSI_ARGS_((Tk_Window tkwin,
			    XEvent *eventPtr));
EXTERN void		TkSelInit _ANSI_ARGS_((Tk_Window tkwin));
EXTERN void		TkSelPropProc _ANSI_ARGS_((XEvent *eventPtr));
EXTERN void		TkSetClassProcs _ANSI_ARGS_((Tk_Window tkwin,
			    TkClassProcs *procs, ClientData instanceData));
#ifndef TkSetPixmapColormap
EXTERN void		TkSetPixmapColormap _ANSI_ARGS_((Pixmap pixmap,
			    Colormap colormap));
#endif
#ifndef TkSetRegion
EXTERN void		TkSetRegion _ANSI_ARGS_((Display* display, GC gc,
			    TkRegion rgn));
#endif
EXTERN void		TkSetWindowMenuBar _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *oldMenuName, 
			    char *menuName));
EXTERN KeySym		TkStringToKeysym _ANSI_ARGS_((char *name));
EXTERN int		TkThickPolyLineToArea _ANSI_ARGS_((double *coordPtr,
			    int numPoints, double width, int capStyle,
			    int joinStyle, double *rectPtr));
#ifndef TkUnionRectWithRegion
EXTERN void		TkUnionRectWithRegion _ANSI_ARGS_((XRectangle* rect,
			    TkRegion src, TkRegion dr_return));
#endif
EXTERN void		TkWmAddToColormapWindows _ANSI_ARGS_((
			    TkWindow *winPtr));
EXTERN void		TkWmDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
EXTERN TkWindow *	TkWmFocusToplevel _ANSI_ARGS_((TkWindow *winPtr));
EXTERN void		TkWmMapWindow _ANSI_ARGS_((TkWindow *winPtr));
EXTERN void		TkWmNewWindow _ANSI_ARGS_((TkWindow *winPtr));
EXTERN void		TkWmProtocolEventProc _ANSI_ARGS_((TkWindow *winPtr,
			    XEvent *evenvPtr));
EXTERN void		TkWmRemoveFromColormapWindows _ANSI_ARGS_((
			    TkWindow *winPtr));
EXTERN void		TkWmRestackToplevel _ANSI_ARGS_((TkWindow *winPtr,
			    int aboveBelow, TkWindow *otherPtr));
EXTERN void		TkWmSetClass _ANSI_ARGS_((TkWindow *winPtr));
EXTERN void		TkWmUnmapWindow _ANSI_ARGS_((TkWindow *winPtr));
EXTERN int		TkXFileProc _ANSI_ARGS_((ClientData clientData,
			    int mask, int flags));

/* 
 * Unsupported commands.
 */
EXTERN int		TkUnsupported1Cmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));




#endif  /* _TKINT */







>
>
>
>
>
>
>





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


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


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







>
>
>

855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916

917
918
919

920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955

956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996


































































































































































997
998

































































999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
extern Tk_PhotoImageFormat	tkImgFmtPPM;
extern TkMainInfo		*tkMainWindowList;
extern Tk_Uid			tkNormalUid;
extern Tk_ImageType		tkPhotoImageType;
extern Tcl_HashTable		tkPredefBitmapTable;
extern int			tkSendSerial;

#include "tkIntDecls.h"

#ifdef BUILD_tk
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * Internal procedures shared among Tk modules but not exported
 * to the outside world:
 */

EXTERN int		Tk_AfterCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_BellObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
EXTERN int		Tk_BindCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_BindtagsCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_ButtonObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
EXTERN int		Tk_CanvasCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_CheckbuttonObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
EXTERN int		Tk_ClipboardCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int              Tk_ChooseColorObjCmd _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[]));
EXTERN int              Tk_ChooseDirectoryObjCmd _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[]));
EXTERN int              Tk_ChooseFontObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
EXTERN int		Tk_DestroyCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_EntryObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
                            Tcl_Obj *CONST objv[]));
EXTERN int		Tk_EventObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
EXTERN int		Tk_FileeventCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_FrameCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_FocusObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));

EXTERN int		Tk_FontObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));

EXTERN int              Tk_GetOpenFileObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
EXTERN int              Tk_GetSaveFileObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
EXTERN int		Tk_GrabCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_GridCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_ImageCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_LabelObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
EXTERN int		Tk_ListboxCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_LowerCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_MenubuttonObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
EXTERN int              Tk_MessageBoxObjCmd _ANSI_ARGS_((ClientData clientData,
                            Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
EXTERN int		Tk_MessageCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_OptionCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_PackCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_PlaceCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_RadiobuttonObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));

EXTERN int		Tk_RaiseCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_ScaleObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
                            Tcl_Obj *CONST objv[]));
EXTERN int		Tk_ScrollbarCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_SelectionCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_SendCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_SendObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
EXTERN int		Tk_TextCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_TkObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
EXTERN int		Tk_TkwaitCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_ToplevelCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Tk_UpdateObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
EXTERN int		Tk_WinfoObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
EXTERN int		Tk_WmCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
int	TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
void	TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
			    int devId, char *buffer, long size));

EXTERN void		TkEventInit _ANSI_ARGS_((void));

EXTERN int		TkCreateMenuCmd _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int		TkDeadAppCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));



































































































































































EXTERN int		TkpTestembedCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));


































































/* 
 * Unsupported commands.
 */
EXTERN int		TkUnsupported1Cmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));

# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT

#endif  /* _TKINT */

Added generic/tkIntDecls.h.





































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
/*
 * tkIntDecls.h --
 *
 *	This file contains the declarations for all unsupported
 *	functions that are exported by the Tk library.  These
 *	interfaces are not guaranteed to remain the same between
 *	versions.  Use at your own risk.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkIntDecls.h,v 1.2.2.2 1999/03/30 02:08:00 redman Exp $
 */

#ifndef _TKINTDECLS
#define _TKINTDECLS

#ifdef BUILD_tk
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
 * script.  Any modifications to the function declarations below should be made
 * in the generic/tkInt.decls script.
 */

/* !BEGIN!: Do not edit below this line. */

/*
 * Exported function declarations:
 */

/* 0 */
EXTERN TkWindow *	TkAllocWindow _ANSI_ARGS_((TkDisplay * dispPtr, 
				int screenNum, TkWindow * parentPtr));
/* 1 */
EXTERN void		TkBezierPoints _ANSI_ARGS_((double control[], 
				int numSteps, double * coordPtr));
/* 2 */
EXTERN void		TkBezierScreenPoints _ANSI_ARGS_((Tk_Canvas canvas, 
				double control[], int numSteps, 
				XPoint * xPointPtr));
/* 3 */
EXTERN void		TkBindDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
/* 4 */
EXTERN void		TkBindEventProc _ANSI_ARGS_((TkWindow * winPtr, 
				XEvent * eventPtr));
/* 5 */
EXTERN void		TkBindFree _ANSI_ARGS_((TkMainInfo * mainPtr));
/* 6 */
EXTERN void		TkBindInit _ANSI_ARGS_((TkMainInfo * mainPtr));
/* 7 */
EXTERN void		TkChangeEventWindow _ANSI_ARGS_((XEvent * eventPtr, 
				TkWindow * winPtr));
/* 8 */
EXTERN int		TkClipInit _ANSI_ARGS_((Tcl_Interp * interp, 
				TkDisplay * dispPtr));
/* 9 */
EXTERN void		TkComputeAnchor _ANSI_ARGS_((Tk_Anchor anchor, 
				Tk_Window tkwin, int padX, int padY, 
				int innerWidth, int innerHeight, int * xPtr, 
				int * yPtr));
/* 10 */
EXTERN int		TkCopyAndGlobalEval _ANSI_ARGS_((Tcl_Interp * interp, 
				char * script));
/* 11 */
EXTERN unsigned long	TkCreateBindingProcedure _ANSI_ARGS_((
				Tcl_Interp * interp, 
				Tk_BindingTable bindingTable, 
				ClientData object, char * eventString, 
				TkBindEvalProc * evalProc, 
				TkBindFreeProc * freeProc, 
				ClientData clientData));
/* 12 */
EXTERN TkCursor *	TkCreateCursorFromData _ANSI_ARGS_((Tk_Window tkwin, 
				char * source, char * mask, int width, 
				int height, int xHot, int yHot, XColor fg, 
				XColor bg));
/* 13 */
EXTERN int		TkCreateFrame _ANSI_ARGS_((ClientData clientData, 
				Tcl_Interp * interp, int argc, char ** argv, 
				int toplevel, char * appName));
/* 14 */
EXTERN Tk_Window	TkCreateMainWindow _ANSI_ARGS_((Tcl_Interp * interp, 
				char * screenName, char * baseName));
/* 15 */
EXTERN Time		TkCurrentTime _ANSI_ARGS_((TkDisplay * dispPtr));
/* 16 */
EXTERN void		TkDeleteAllImages _ANSI_ARGS_((TkMainInfo * mainPtr));
/* 17 */
EXTERN void		TkDoConfigureNotify _ANSI_ARGS_((TkWindow * winPtr));
/* 18 */
EXTERN void		TkDrawInsetFocusHighlight _ANSI_ARGS_((
				Tk_Window tkwin, GC gc, int width, 
				Drawable drawable, int padding));
/* 19 */
EXTERN void		TkEventDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
/* 20 */
EXTERN void		TkFillPolygon _ANSI_ARGS_((Tk_Canvas canvas, 
				double * coordPtr, int numPoints, 
				Display * display, Drawable drawable, GC gc, 
				GC outlineGC));
/* 21 */
EXTERN int		TkFindStateNum _ANSI_ARGS_((Tcl_Interp * interp, 
				CONST char * option, 
				CONST TkStateMap * mapPtr, 
				CONST char * strKey));
/* 22 */
EXTERN char *		TkFindStateString _ANSI_ARGS_((
				CONST TkStateMap * mapPtr, int numKey));
/* 23 */
EXTERN void		TkFocusDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
/* 24 */
EXTERN int		TkFocusFilterEvent _ANSI_ARGS_((TkWindow * winPtr, 
				XEvent * eventPtr));
/* 25 */
EXTERN TkWindow *	TkFocusKeyEvent _ANSI_ARGS_((TkWindow * winPtr, 
				XEvent * eventPtr));
/* 26 */
EXTERN void		TkFontPkgInit _ANSI_ARGS_((TkMainInfo * mainPtr));
/* 27 */
EXTERN void		TkFontPkgFree _ANSI_ARGS_((TkMainInfo * mainPtr));
/* 28 */
EXTERN void		TkFreeBindingTags _ANSI_ARGS_((TkWindow * winPtr));
/* 29 */
EXTERN void		TkpFreeCursor _ANSI_ARGS_((TkCursor * cursorPtr));
/* 30 */
EXTERN char *		TkGetBitmapData _ANSI_ARGS_((Tcl_Interp * interp, 
				char * string, char * fileName, 
				int * widthPtr, int * heightPtr, 
				int * hotXPtr, int * hotYPtr));
/* 31 */
EXTERN void		TkGetButtPoints _ANSI_ARGS_((double p1[], 
				double p2[], double width, int project, 
				double m1[], double m2[]));
/* 32 */
EXTERN TkCursor *	TkGetCursorByName _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, Tk_Uid string));
/* 33 */
EXTERN char *		TkGetDefaultScreenName _ANSI_ARGS_((
				Tcl_Interp * interp, char * screenName));
/* 34 */
EXTERN TkDisplay *	TkGetDisplay _ANSI_ARGS_((Display * display));
/* 35 */
EXTERN int		TkGetDisplayOf _ANSI_ARGS_((Tcl_Interp * interp, 
				int objc, Tcl_Obj *CONST objv[], 
				Tk_Window * tkwinPtr));
/* 36 */
EXTERN TkWindow *	TkGetFocusWin _ANSI_ARGS_((TkWindow * winPtr));
/* 37 */
EXTERN int		TkGetInterpNames _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin));
/* 38 */
EXTERN int		TkGetMiterPoints _ANSI_ARGS_((double p1[], 
				double p2[], double p3[], double width, 
				double m1[], double m2[]));
/* 39 */
EXTERN void		TkGetPointerCoords _ANSI_ARGS_((Tk_Window tkwin, 
				int * xPtr, int * yPtr));
/* 40 */
EXTERN void		TkGetServerInfo _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin));
/* 41 */
EXTERN void		TkGrabDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
/* 42 */
EXTERN int		TkGrabState _ANSI_ARGS_((TkWindow * winPtr));
/* 43 */
EXTERN void		TkIncludePoint _ANSI_ARGS_((Tk_Item * itemPtr, 
				double * pointPtr));
/* 44 */
EXTERN void		TkInOutEvents _ANSI_ARGS_((XEvent * eventPtr, 
				TkWindow * sourcePtr, TkWindow * destPtr, 
				int leaveType, int enterType, 
				Tcl_QueuePosition position));
/* 45 */
EXTERN void		TkInstallFrameMenu _ANSI_ARGS_((Tk_Window tkwin));
/* 46 */
EXTERN char *		TkKeysymToString _ANSI_ARGS_((KeySym keysym));
/* 47 */
EXTERN int		TkLineToArea _ANSI_ARGS_((double end1Ptr[], 
				double end2Ptr[], double rectPtr[]));
/* 48 */
EXTERN double		TkLineToPoint _ANSI_ARGS_((double end1Ptr[], 
				double end2Ptr[], double pointPtr[]));
/* 49 */
EXTERN int		TkMakeBezierCurve _ANSI_ARGS_((Tk_Canvas canvas, 
				double * pointPtr, int numPoints, 
				int numSteps, XPoint xPoints[], 
				double dblPoints[]));
/* 50 */
EXTERN void		TkMakeBezierPostscript _ANSI_ARGS_((
				Tcl_Interp * interp, Tk_Canvas canvas, 
				double * pointPtr, int numPoints));
/* 51 */
EXTERN void		TkOptionClassChanged _ANSI_ARGS_((TkWindow * winPtr));
/* 52 */
EXTERN void		TkOptionDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
/* 53 */
EXTERN int		TkOvalToArea _ANSI_ARGS_((double * ovalPtr, 
				double * rectPtr));
/* 54 */
EXTERN double		TkOvalToPoint _ANSI_ARGS_((double ovalPtr[], 
				double width, int filled, double pointPtr[]));
/* 55 */
EXTERN int		TkpChangeFocus _ANSI_ARGS_((TkWindow * winPtr, 
				int force));
/* 56 */
EXTERN void		TkpCloseDisplay _ANSI_ARGS_((TkDisplay * dispPtr));
/* 57 */
EXTERN void		TkpClaimFocus _ANSI_ARGS_((TkWindow * topLevelPtr, 
				int force));
/* 58 */
EXTERN void		TkpDisplayWarning _ANSI_ARGS_((char * msg, 
				char * title));
/* 59 */
EXTERN void		TkpGetAppName _ANSI_ARGS_((Tcl_Interp * interp, 
				Tcl_DString * name));
/* 60 */
EXTERN TkWindow *	TkpGetOtherWindow _ANSI_ARGS_((TkWindow * winPtr));
/* 61 */
EXTERN TkWindow *	TkpGetWrapperWindow _ANSI_ARGS_((TkWindow * winPtr));
/* 62 */
EXTERN int		TkpInit _ANSI_ARGS_((Tcl_Interp * interp));
/* 63 */
EXTERN void		TkpInitializeMenuBindings _ANSI_ARGS_((
				Tcl_Interp * interp, 
				Tk_BindingTable bindingTable));
/* 64 */
EXTERN void		TkpMakeContainer _ANSI_ARGS_((Tk_Window tkwin));
/* 65 */
EXTERN void		TkpMakeMenuWindow _ANSI_ARGS_((Tk_Window tkwin, 
				int transient));
/* 66 */
EXTERN Window		TkpMakeWindow _ANSI_ARGS_((TkWindow * winPtr, 
				Window parent));
/* 67 */
EXTERN void		TkpMenuNotifyToplevelCreate _ANSI_ARGS_((
				Tcl_Interp * interp1, char * menuName));
/* 68 */
EXTERN TkDisplay *	TkpOpenDisplay _ANSI_ARGS_((char * display_name));
/* 69 */
EXTERN int		TkPointerEvent _ANSI_ARGS_((XEvent * eventPtr, 
				TkWindow * winPtr));
/* 70 */
EXTERN int		TkPolygonToArea _ANSI_ARGS_((double * polyPtr, 
				int numPoints, double * rectPtr));
/* 71 */
EXTERN double		TkPolygonToPoint _ANSI_ARGS_((double * polyPtr, 
				int numPoints, double * pointPtr));
/* 72 */
EXTERN int		TkPositionInTree _ANSI_ARGS_((TkWindow * winPtr, 
				TkWindow * treePtr));
/* 73 */
EXTERN void		TkpRedirectKeyEvent _ANSI_ARGS_((TkWindow * winPtr, 
				XEvent * eventPtr));
/* 74 */
EXTERN void		TkpSetMainMenubar _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, char * menuName));
/* 75 */
EXTERN int		TkpUseWindow _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, char * string));
/* 76 */
EXTERN int		TkpWindowWasRecentlyDeleted _ANSI_ARGS_((Window win, 
				TkDisplay * dispPtr));
/* 77 */
EXTERN void		TkQueueEventForAllChildren _ANSI_ARGS_((
				TkWindow * winPtr, XEvent * eventPtr));
/* 78 */
EXTERN int		TkReadBitmapFile _ANSI_ARGS_((Display* display, 
				Drawable d, CONST char* filename, 
				unsigned int* width_return, 
				unsigned int* height_return, 
				Pixmap* bitmap_return, int* x_hot_return, 
				int* y_hot_return));
/* 79 */
EXTERN int		TkScrollWindow _ANSI_ARGS_((Tk_Window tkwin, GC gc, 
				int x, int y, int width, int height, int dx, 
				int dy, TkRegion damageRgn));
/* 80 */
EXTERN void		TkSelDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
/* 81 */
EXTERN void		TkSelEventProc _ANSI_ARGS_((Tk_Window tkwin, 
				XEvent * eventPtr));
/* 82 */
EXTERN void		TkSelInit _ANSI_ARGS_((Tk_Window tkwin));
/* 83 */
EXTERN void		TkSelPropProc _ANSI_ARGS_((XEvent * eventPtr));
/* 84 */
EXTERN void		TkSetClassProcs _ANSI_ARGS_((Tk_Window tkwin, 
				TkClassProcs * procs, 
				ClientData instanceData));
/* 85 */
EXTERN void		TkSetWindowMenuBar _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, char * oldMenuName, 
				char * menuName));
/* 86 */
EXTERN KeySym		TkStringToKeysym _ANSI_ARGS_((char * name));
/* 87 */
EXTERN int		TkThickPolyLineToArea _ANSI_ARGS_((double * coordPtr, 
				int numPoints, double width, int capStyle, 
				int joinStyle, double * rectPtr));
/* 88 */
EXTERN void		TkWmAddToColormapWindows _ANSI_ARGS_((
				TkWindow * winPtr));
/* 89 */
EXTERN void		TkWmDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
/* 90 */
EXTERN TkWindow *	TkWmFocusToplevel _ANSI_ARGS_((TkWindow * winPtr));
/* 91 */
EXTERN void		TkWmMapWindow _ANSI_ARGS_((TkWindow * winPtr));
/* 92 */
EXTERN void		TkWmNewWindow _ANSI_ARGS_((TkWindow * winPtr));
/* 93 */
EXTERN void		TkWmProtocolEventProc _ANSI_ARGS_((TkWindow * winPtr, 
				XEvent * evenvPtr));
/* 94 */
EXTERN void		TkWmRemoveFromColormapWindows _ANSI_ARGS_((
				TkWindow * winPtr));
/* 95 */
EXTERN void		TkWmRestackToplevel _ANSI_ARGS_((TkWindow * winPtr, 
				int aboveBelow, TkWindow * otherPtr));
/* 96 */
EXTERN void		TkWmSetClass _ANSI_ARGS_((TkWindow * winPtr));
/* 97 */
EXTERN void		TkWmUnmapWindow _ANSI_ARGS_((TkWindow * winPtr));
/* 98 */
EXTERN Tcl_Obj *	TkDebugBitmap _ANSI_ARGS_((Tk_Window tkwin, 
				char * name));
/* 99 */
EXTERN Tcl_Obj *	TkDebugBorder _ANSI_ARGS_((Tk_Window tkwin, 
				char * name));
/* 100 */
EXTERN Tcl_Obj *	TkDebugCursor _ANSI_ARGS_((Tk_Window tkwin, 
				char * name));
/* 101 */
EXTERN Tcl_Obj *	TkDebugColor _ANSI_ARGS_((Tk_Window tkwin, 
				char * name));
/* 102 */
EXTERN Tcl_Obj *	TkDebugConfig _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_OptionTable table));
/* 103 */
EXTERN Tcl_Obj *	TkDebugFont _ANSI_ARGS_((Tk_Window tkwin, 
				char * name));
/* 104 */
EXTERN int		TkFindStateNumObj _ANSI_ARGS_((Tcl_Interp * interp, 
				Tcl_Obj * optionPtr, 
				CONST TkStateMap * mapPtr, Tcl_Obj * keyPtr));
/* 105 */
EXTERN Tcl_HashTable *	TkGetBitmapPredefTable _ANSI_ARGS_((void));
/* 106 */
EXTERN TkDisplay *	TkGetDisplayList _ANSI_ARGS_((void));
/* 107 */
EXTERN TkMainInfo *	TkGetMainInfoList _ANSI_ARGS_((void));
/* 108 */
EXTERN int		TkGetWindowFromObj _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Window tkwin, Tcl_Obj * objPtr, 
				Tk_Window * windowPtr));
/* 109 */
EXTERN char *		TkpGetString _ANSI_ARGS_((TkWindow * winPtr, 
				XEvent * eventPtr, Tcl_DString * dsPtr));
/* 110 */
EXTERN void		TkpGetSubFonts _ANSI_ARGS_((Tcl_Interp * interp, 
				Tk_Font tkfont));
/* 111 */
EXTERN Tcl_Obj *	TkpGetSystemDefault _ANSI_ARGS_((Tk_Window tkwin, 
				char * dbName, char * className));
/* 112 */
EXTERN void		TkpMenuThreadInit _ANSI_ARGS_((void));

typedef struct TkIntStubs {
    int magic;
    struct TkIntStubHooks *hooks;

    TkWindow * (*tkAllocWindow) _ANSI_ARGS_((TkDisplay * dispPtr, int screenNum, TkWindow * parentPtr)); /* 0 */
    void (*tkBezierPoints) _ANSI_ARGS_((double control[], int numSteps, double * coordPtr)); /* 1 */
    void (*tkBezierScreenPoints) _ANSI_ARGS_((Tk_Canvas canvas, double control[], int numSteps, XPoint * xPointPtr)); /* 2 */
    void (*tkBindDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 3 */
    void (*tkBindEventProc) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 4 */
    void (*tkBindFree) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 5 */
    void (*tkBindInit) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 6 */
    void (*tkChangeEventWindow) _ANSI_ARGS_((XEvent * eventPtr, TkWindow * winPtr)); /* 7 */
    int (*tkClipInit) _ANSI_ARGS_((Tcl_Interp * interp, TkDisplay * dispPtr)); /* 8 */
    void (*tkComputeAnchor) _ANSI_ARGS_((Tk_Anchor anchor, Tk_Window tkwin, int padX, int padY, int innerWidth, int innerHeight, int * xPtr, int * yPtr)); /* 9 */
    int (*tkCopyAndGlobalEval) _ANSI_ARGS_((Tcl_Interp * interp, char * script)); /* 10 */
    unsigned long (*tkCreateBindingProcedure) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventString, TkBindEvalProc * evalProc, TkBindFreeProc * freeProc, ClientData clientData)); /* 11 */
    TkCursor * (*tkCreateCursorFromData) _ANSI_ARGS_((Tk_Window tkwin, char * source, char * mask, int width, int height, int xHot, int yHot, XColor fg, XColor bg)); /* 12 */
    int (*tkCreateFrame) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv, int toplevel, char * appName)); /* 13 */
    Tk_Window (*tkCreateMainWindow) _ANSI_ARGS_((Tcl_Interp * interp, char * screenName, char * baseName)); /* 14 */
    Time (*tkCurrentTime) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 15 */
    void (*tkDeleteAllImages) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 16 */
    void (*tkDoConfigureNotify) _ANSI_ARGS_((TkWindow * winPtr)); /* 17 */
    void (*tkDrawInsetFocusHighlight) _ANSI_ARGS_((Tk_Window tkwin, GC gc, int width, Drawable drawable, int padding)); /* 18 */
    void (*tkEventDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 19 */
    void (*tkFillPolygon) _ANSI_ARGS_((Tk_Canvas canvas, double * coordPtr, int numPoints, Display * display, Drawable drawable, GC gc, GC outlineGC)); /* 20 */
    int (*tkFindStateNum) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * option, CONST TkStateMap * mapPtr, CONST char * strKey)); /* 21 */
    char * (*tkFindStateString) _ANSI_ARGS_((CONST TkStateMap * mapPtr, int numKey)); /* 22 */
    void (*tkFocusDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 23 */
    int (*tkFocusFilterEvent) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 24 */
    TkWindow * (*tkFocusKeyEvent) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 25 */
    void (*tkFontPkgInit) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 26 */
    void (*tkFontPkgFree) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 27 */
    void (*tkFreeBindingTags) _ANSI_ARGS_((TkWindow * winPtr)); /* 28 */
    void (*tkpFreeCursor) _ANSI_ARGS_((TkCursor * cursorPtr)); /* 29 */
    char * (*tkGetBitmapData) _ANSI_ARGS_((Tcl_Interp * interp, char * string, char * fileName, int * widthPtr, int * heightPtr, int * hotXPtr, int * hotYPtr)); /* 30 */
    void (*tkGetButtPoints) _ANSI_ARGS_((double p1[], double p2[], double width, int project, double m1[], double m2[])); /* 31 */
    TkCursor * (*tkGetCursorByName) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid string)); /* 32 */
    char * (*tkGetDefaultScreenName) _ANSI_ARGS_((Tcl_Interp * interp, char * screenName)); /* 33 */
    TkDisplay * (*tkGetDisplay) _ANSI_ARGS_((Display * display)); /* 34 */
    int (*tkGetDisplayOf) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], Tk_Window * tkwinPtr)); /* 35 */
    TkWindow * (*tkGetFocusWin) _ANSI_ARGS_((TkWindow * winPtr)); /* 36 */
    int (*tkGetInterpNames) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin)); /* 37 */
    int (*tkGetMiterPoints) _ANSI_ARGS_((double p1[], double p2[], double p3[], double width, double m1[], double m2[])); /* 38 */
    void (*tkGetPointerCoords) _ANSI_ARGS_((Tk_Window tkwin, int * xPtr, int * yPtr)); /* 39 */
    void (*tkGetServerInfo) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin)); /* 40 */
    void (*tkGrabDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 41 */
    int (*tkGrabState) _ANSI_ARGS_((TkWindow * winPtr)); /* 42 */
    void (*tkIncludePoint) _ANSI_ARGS_((Tk_Item * itemPtr, double * pointPtr)); /* 43 */
    void (*tkInOutEvents) _ANSI_ARGS_((XEvent * eventPtr, TkWindow * sourcePtr, TkWindow * destPtr, int leaveType, int enterType, Tcl_QueuePosition position)); /* 44 */
    void (*tkInstallFrameMenu) _ANSI_ARGS_((Tk_Window tkwin)); /* 45 */
    char * (*tkKeysymToString) _ANSI_ARGS_((KeySym keysym)); /* 46 */
    int (*tkLineToArea) _ANSI_ARGS_((double end1Ptr[], double end2Ptr[], double rectPtr[])); /* 47 */
    double (*tkLineToPoint) _ANSI_ARGS_((double end1Ptr[], double end2Ptr[], double pointPtr[])); /* 48 */
    int (*tkMakeBezierCurve) _ANSI_ARGS_((Tk_Canvas canvas, double * pointPtr, int numPoints, int numSteps, XPoint xPoints[], double dblPoints[])); /* 49 */
    void (*tkMakeBezierPostscript) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, double * pointPtr, int numPoints)); /* 50 */
    void (*tkOptionClassChanged) _ANSI_ARGS_((TkWindow * winPtr)); /* 51 */
    void (*tkOptionDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 52 */
    int (*tkOvalToArea) _ANSI_ARGS_((double * ovalPtr, double * rectPtr)); /* 53 */
    double (*tkOvalToPoint) _ANSI_ARGS_((double ovalPtr[], double width, int filled, double pointPtr[])); /* 54 */
    int (*tkpChangeFocus) _ANSI_ARGS_((TkWindow * winPtr, int force)); /* 55 */
    void (*tkpCloseDisplay) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 56 */
    void (*tkpClaimFocus) _ANSI_ARGS_((TkWindow * topLevelPtr, int force)); /* 57 */
    void (*tkpDisplayWarning) _ANSI_ARGS_((char * msg, char * title)); /* 58 */
    void (*tkpGetAppName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * name)); /* 59 */
    TkWindow * (*tkpGetOtherWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 60 */
    TkWindow * (*tkpGetWrapperWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 61 */
    int (*tkpInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 62 */
    void (*tkpInitializeMenuBindings) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable)); /* 63 */
    void (*tkpMakeContainer) _ANSI_ARGS_((Tk_Window tkwin)); /* 64 */
    void (*tkpMakeMenuWindow) _ANSI_ARGS_((Tk_Window tkwin, int transient)); /* 65 */
    Window (*tkpMakeWindow) _ANSI_ARGS_((TkWindow * winPtr, Window parent)); /* 66 */
    void (*tkpMenuNotifyToplevelCreate) _ANSI_ARGS_((Tcl_Interp * interp1, char * menuName)); /* 67 */
    TkDisplay * (*tkpOpenDisplay) _ANSI_ARGS_((char * display_name)); /* 68 */
    int (*tkPointerEvent) _ANSI_ARGS_((XEvent * eventPtr, TkWindow * winPtr)); /* 69 */
    int (*tkPolygonToArea) _ANSI_ARGS_((double * polyPtr, int numPoints, double * rectPtr)); /* 70 */
    double (*tkPolygonToPoint) _ANSI_ARGS_((double * polyPtr, int numPoints, double * pointPtr)); /* 71 */
    int (*tkPositionInTree) _ANSI_ARGS_((TkWindow * winPtr, TkWindow * treePtr)); /* 72 */
    void (*tkpRedirectKeyEvent) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 73 */
    void (*tkpSetMainMenubar) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * menuName)); /* 74 */
    int (*tkpUseWindow) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * string)); /* 75 */
    int (*tkpWindowWasRecentlyDeleted) _ANSI_ARGS_((Window win, TkDisplay * dispPtr)); /* 76 */
    void (*tkQueueEventForAllChildren) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 77 */
    int (*tkReadBitmapFile) _ANSI_ARGS_((Display* display, Drawable d, CONST char* filename, unsigned int* width_return, unsigned int* height_return, Pixmap* bitmap_return, int* x_hot_return, int* y_hot_return)); /* 78 */
    int (*tkScrollWindow) _ANSI_ARGS_((Tk_Window tkwin, GC gc, int x, int y, int width, int height, int dx, int dy, TkRegion damageRgn)); /* 79 */
    void (*tkSelDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 80 */
    void (*tkSelEventProc) _ANSI_ARGS_((Tk_Window tkwin, XEvent * eventPtr)); /* 81 */
    void (*tkSelInit) _ANSI_ARGS_((Tk_Window tkwin)); /* 82 */
    void (*tkSelPropProc) _ANSI_ARGS_((XEvent * eventPtr)); /* 83 */
    void (*tkSetClassProcs) _ANSI_ARGS_((Tk_Window tkwin, TkClassProcs * procs, ClientData instanceData)); /* 84 */
    void (*tkSetWindowMenuBar) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * oldMenuName, char * menuName)); /* 85 */
    KeySym (*tkStringToKeysym) _ANSI_ARGS_((char * name)); /* 86 */
    int (*tkThickPolyLineToArea) _ANSI_ARGS_((double * coordPtr, int numPoints, double width, int capStyle, int joinStyle, double * rectPtr)); /* 87 */
    void (*tkWmAddToColormapWindows) _ANSI_ARGS_((TkWindow * winPtr)); /* 88 */
    void (*tkWmDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 89 */
    TkWindow * (*tkWmFocusToplevel) _ANSI_ARGS_((TkWindow * winPtr)); /* 90 */
    void (*tkWmMapWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 91 */
    void (*tkWmNewWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 92 */
    void (*tkWmProtocolEventProc) _ANSI_ARGS_((TkWindow * winPtr, XEvent * evenvPtr)); /* 93 */
    void (*tkWmRemoveFromColormapWindows) _ANSI_ARGS_((TkWindow * winPtr)); /* 94 */
    void (*tkWmRestackToplevel) _ANSI_ARGS_((TkWindow * winPtr, int aboveBelow, TkWindow * otherPtr)); /* 95 */
    void (*tkWmSetClass) _ANSI_ARGS_((TkWindow * winPtr)); /* 96 */
    void (*tkWmUnmapWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 97 */
    Tcl_Obj * (*tkDebugBitmap) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 98 */
    Tcl_Obj * (*tkDebugBorder) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 99 */
    Tcl_Obj * (*tkDebugCursor) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 100 */
    Tcl_Obj * (*tkDebugColor) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 101 */
    Tcl_Obj * (*tkDebugConfig) _ANSI_ARGS_((Tcl_Interp * interp, Tk_OptionTable table)); /* 102 */
    Tcl_Obj * (*tkDebugFont) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 103 */
    int (*tkFindStateNumObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * optionPtr, CONST TkStateMap * mapPtr, Tcl_Obj * keyPtr)); /* 104 */
    Tcl_HashTable * (*tkGetBitmapPredefTable) _ANSI_ARGS_((void)); /* 105 */
    TkDisplay * (*tkGetDisplayList) _ANSI_ARGS_((void)); /* 106 */
    TkMainInfo * (*tkGetMainInfoList) _ANSI_ARGS_((void)); /* 107 */
    int (*tkGetWindowFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr, Tk_Window * windowPtr)); /* 108 */
    char * (*tkpGetString) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr, Tcl_DString * dsPtr)); /* 109 */
    void (*tkpGetSubFonts) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Font tkfont)); /* 110 */
    Tcl_Obj * (*tkpGetSystemDefault) _ANSI_ARGS_((Tk_Window tkwin, char * dbName, char * className)); /* 111 */
    void (*tkpMenuThreadInit) _ANSI_ARGS_((void)); /* 112 */
} TkIntStubs;

extern TkIntStubs *tkIntStubsPtr;

#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS)

/*
 * Inline function declarations:
 */

#ifndef TkAllocWindow
#define TkAllocWindow \
	(tkIntStubsPtr->tkAllocWindow) /* 0 */
#endif
#ifndef TkBezierPoints
#define TkBezierPoints \
	(tkIntStubsPtr->tkBezierPoints) /* 1 */
#endif
#ifndef TkBezierScreenPoints
#define TkBezierScreenPoints \
	(tkIntStubsPtr->tkBezierScreenPoints) /* 2 */
#endif
#ifndef TkBindDeadWindow
#define TkBindDeadWindow \
	(tkIntStubsPtr->tkBindDeadWindow) /* 3 */
#endif
#ifndef TkBindEventProc
#define TkBindEventProc \
	(tkIntStubsPtr->tkBindEventProc) /* 4 */
#endif
#ifndef TkBindFree
#define TkBindFree \
	(tkIntStubsPtr->tkBindFree) /* 5 */
#endif
#ifndef TkBindInit
#define TkBindInit \
	(tkIntStubsPtr->tkBindInit) /* 6 */
#endif
#ifndef TkChangeEventWindow
#define TkChangeEventWindow \
	(tkIntStubsPtr->tkChangeEventWindow) /* 7 */
#endif
#ifndef TkClipInit
#define TkClipInit \
	(tkIntStubsPtr->tkClipInit) /* 8 */
#endif
#ifndef TkComputeAnchor
#define TkComputeAnchor \
	(tkIntStubsPtr->tkComputeAnchor) /* 9 */
#endif
#ifndef TkCopyAndGlobalEval
#define TkCopyAndGlobalEval \
	(tkIntStubsPtr->tkCopyAndGlobalEval) /* 10 */
#endif
#ifndef TkCreateBindingProcedure
#define TkCreateBindingProcedure \
	(tkIntStubsPtr->tkCreateBindingProcedure) /* 11 */
#endif
#ifndef TkCreateCursorFromData
#define TkCreateCursorFromData \
	(tkIntStubsPtr->tkCreateCursorFromData) /* 12 */
#endif
#ifndef TkCreateFrame
#define TkCreateFrame \
	(tkIntStubsPtr->tkCreateFrame) /* 13 */
#endif
#ifndef TkCreateMainWindow
#define TkCreateMainWindow \
	(tkIntStubsPtr->tkCreateMainWindow) /* 14 */
#endif
#ifndef TkCurrentTime
#define TkCurrentTime \
	(tkIntStubsPtr->tkCurrentTime) /* 15 */
#endif
#ifndef TkDeleteAllImages
#define TkDeleteAllImages \
	(tkIntStubsPtr->tkDeleteAllImages) /* 16 */
#endif
#ifndef TkDoConfigureNotify
#define TkDoConfigureNotify \
	(tkIntStubsPtr->tkDoConfigureNotify) /* 17 */
#endif
#ifndef TkDrawInsetFocusHighlight
#define TkDrawInsetFocusHighlight \
	(tkIntStubsPtr->tkDrawInsetFocusHighlight) /* 18 */
#endif
#ifndef TkEventDeadWindow
#define TkEventDeadWindow \
	(tkIntStubsPtr->tkEventDeadWindow) /* 19 */
#endif
#ifndef TkFillPolygon
#define TkFillPolygon \
	(tkIntStubsPtr->tkFillPolygon) /* 20 */
#endif
#ifndef TkFindStateNum
#define TkFindStateNum \
	(tkIntStubsPtr->tkFindStateNum) /* 21 */
#endif
#ifndef TkFindStateString
#define TkFindStateString \
	(tkIntStubsPtr->tkFindStateString) /* 22 */
#endif
#ifndef TkFocusDeadWindow
#define TkFocusDeadWindow \
	(tkIntStubsPtr->tkFocusDeadWindow) /* 23 */
#endif
#ifndef TkFocusFilterEvent
#define TkFocusFilterEvent \
	(tkIntStubsPtr->tkFocusFilterEvent) /* 24 */
#endif
#ifndef TkFocusKeyEvent
#define TkFocusKeyEvent \
	(tkIntStubsPtr->tkFocusKeyEvent) /* 25 */
#endif
#ifndef TkFontPkgInit
#define TkFontPkgInit \
	(tkIntStubsPtr->tkFontPkgInit) /* 26 */
#endif
#ifndef TkFontPkgFree
#define TkFontPkgFree \
	(tkIntStubsPtr->tkFontPkgFree) /* 27 */
#endif
#ifndef TkFreeBindingTags
#define TkFreeBindingTags \
	(tkIntStubsPtr->tkFreeBindingTags) /* 28 */
#endif
#ifndef TkpFreeCursor
#define TkpFreeCursor \
	(tkIntStubsPtr->tkpFreeCursor) /* 29 */
#endif
#ifndef TkGetBitmapData
#define TkGetBitmapData \
	(tkIntStubsPtr->tkGetBitmapData) /* 30 */
#endif
#ifndef TkGetButtPoints
#define TkGetButtPoints \
	(tkIntStubsPtr->tkGetButtPoints) /* 31 */
#endif
#ifndef TkGetCursorByName
#define TkGetCursorByName \
	(tkIntStubsPtr->tkGetCursorByName) /* 32 */
#endif
#ifndef TkGetDefaultScreenName
#define TkGetDefaultScreenName \
	(tkIntStubsPtr->tkGetDefaultScreenName) /* 33 */
#endif
#ifndef TkGetDisplay
#define TkGetDisplay \
	(tkIntStubsPtr->tkGetDisplay) /* 34 */
#endif
#ifndef TkGetDisplayOf
#define TkGetDisplayOf \
	(tkIntStubsPtr->tkGetDisplayOf) /* 35 */
#endif
#ifndef TkGetFocusWin
#define TkGetFocusWin \
	(tkIntStubsPtr->tkGetFocusWin) /* 36 */
#endif
#ifndef TkGetInterpNames
#define TkGetInterpNames \
	(tkIntStubsPtr->tkGetInterpNames) /* 37 */
#endif
#ifndef TkGetMiterPoints
#define TkGetMiterPoints \
	(tkIntStubsPtr->tkGetMiterPoints) /* 38 */
#endif
#ifndef TkGetPointerCoords
#define TkGetPointerCoords \
	(tkIntStubsPtr->tkGetPointerCoords) /* 39 */
#endif
#ifndef TkGetServerInfo
#define TkGetServerInfo \
	(tkIntStubsPtr->tkGetServerInfo) /* 40 */
#endif
#ifndef TkGrabDeadWindow
#define TkGrabDeadWindow \
	(tkIntStubsPtr->tkGrabDeadWindow) /* 41 */
#endif
#ifndef TkGrabState
#define TkGrabState \
	(tkIntStubsPtr->tkGrabState) /* 42 */
#endif
#ifndef TkIncludePoint
#define TkIncludePoint \
	(tkIntStubsPtr->tkIncludePoint) /* 43 */
#endif
#ifndef TkInOutEvents
#define TkInOutEvents \
	(tkIntStubsPtr->tkInOutEvents) /* 44 */
#endif
#ifndef TkInstallFrameMenu
#define TkInstallFrameMenu \
	(tkIntStubsPtr->tkInstallFrameMenu) /* 45 */
#endif
#ifndef TkKeysymToString
#define TkKeysymToString \
	(tkIntStubsPtr->tkKeysymToString) /* 46 */
#endif
#ifndef TkLineToArea
#define TkLineToArea \
	(tkIntStubsPtr->tkLineToArea) /* 47 */
#endif
#ifndef TkLineToPoint
#define TkLineToPoint \
	(tkIntStubsPtr->tkLineToPoint) /* 48 */
#endif
#ifndef TkMakeBezierCurve
#define TkMakeBezierCurve \
	(tkIntStubsPtr->tkMakeBezierCurve) /* 49 */
#endif
#ifndef TkMakeBezierPostscript
#define TkMakeBezierPostscript \
	(tkIntStubsPtr->tkMakeBezierPostscript) /* 50 */
#endif
#ifndef TkOptionClassChanged
#define TkOptionClassChanged \
	(tkIntStubsPtr->tkOptionClassChanged) /* 51 */
#endif
#ifndef TkOptionDeadWindow
#define TkOptionDeadWindow \
	(tkIntStubsPtr->tkOptionDeadWindow) /* 52 */
#endif
#ifndef TkOvalToArea
#define TkOvalToArea \
	(tkIntStubsPtr->tkOvalToArea) /* 53 */
#endif
#ifndef TkOvalToPoint
#define TkOvalToPoint \
	(tkIntStubsPtr->tkOvalToPoint) /* 54 */
#endif
#ifndef TkpChangeFocus
#define TkpChangeFocus \
	(tkIntStubsPtr->tkpChangeFocus) /* 55 */
#endif
#ifndef TkpCloseDisplay
#define TkpCloseDisplay \
	(tkIntStubsPtr->tkpCloseDisplay) /* 56 */
#endif
#ifndef TkpClaimFocus
#define TkpClaimFocus \
	(tkIntStubsPtr->tkpClaimFocus) /* 57 */
#endif
#ifndef TkpDisplayWarning
#define TkpDisplayWarning \
	(tkIntStubsPtr->tkpDisplayWarning) /* 58 */
#endif
#ifndef TkpGetAppName
#define TkpGetAppName \
	(tkIntStubsPtr->tkpGetAppName) /* 59 */
#endif
#ifndef TkpGetOtherWindow
#define TkpGetOtherWindow \
	(tkIntStubsPtr->tkpGetOtherWindow) /* 60 */
#endif
#ifndef TkpGetWrapperWindow
#define TkpGetWrapperWindow \
	(tkIntStubsPtr->tkpGetWrapperWindow) /* 61 */
#endif
#ifndef TkpInit
#define TkpInit \
	(tkIntStubsPtr->tkpInit) /* 62 */
#endif
#ifndef TkpInitializeMenuBindings
#define TkpInitializeMenuBindings \
	(tkIntStubsPtr->tkpInitializeMenuBindings) /* 63 */
#endif
#ifndef TkpMakeContainer
#define TkpMakeContainer \
	(tkIntStubsPtr->tkpMakeContainer) /* 64 */
#endif
#ifndef TkpMakeMenuWindow
#define TkpMakeMenuWindow \
	(tkIntStubsPtr->tkpMakeMenuWindow) /* 65 */
#endif
#ifndef TkpMakeWindow
#define TkpMakeWindow \
	(tkIntStubsPtr->tkpMakeWindow) /* 66 */
#endif
#ifndef TkpMenuNotifyToplevelCreate
#define TkpMenuNotifyToplevelCreate \
	(tkIntStubsPtr->tkpMenuNotifyToplevelCreate) /* 67 */
#endif
#ifndef TkpOpenDisplay
#define TkpOpenDisplay \
	(tkIntStubsPtr->tkpOpenDisplay) /* 68 */
#endif
#ifndef TkPointerEvent
#define TkPointerEvent \
	(tkIntStubsPtr->tkPointerEvent) /* 69 */
#endif
#ifndef TkPolygonToArea
#define TkPolygonToArea \
	(tkIntStubsPtr->tkPolygonToArea) /* 70 */
#endif
#ifndef TkPolygonToPoint
#define TkPolygonToPoint \
	(tkIntStubsPtr->tkPolygonToPoint) /* 71 */
#endif
#ifndef TkPositionInTree
#define TkPositionInTree \
	(tkIntStubsPtr->tkPositionInTree) /* 72 */
#endif
#ifndef TkpRedirectKeyEvent
#define TkpRedirectKeyEvent \
	(tkIntStubsPtr->tkpRedirectKeyEvent) /* 73 */
#endif
#ifndef TkpSetMainMenubar
#define TkpSetMainMenubar \
	(tkIntStubsPtr->tkpSetMainMenubar) /* 74 */
#endif
#ifndef TkpUseWindow
#define TkpUseWindow \
	(tkIntStubsPtr->tkpUseWindow) /* 75 */
#endif
#ifndef TkpWindowWasRecentlyDeleted
#define TkpWindowWasRecentlyDeleted \
	(tkIntStubsPtr->tkpWindowWasRecentlyDeleted) /* 76 */
#endif
#ifndef TkQueueEventForAllChildren
#define TkQueueEventForAllChildren \
	(tkIntStubsPtr->tkQueueEventForAllChildren) /* 77 */
#endif
#ifndef TkReadBitmapFile
#define TkReadBitmapFile \
	(tkIntStubsPtr->tkReadBitmapFile) /* 78 */
#endif
#ifndef TkScrollWindow
#define TkScrollWindow \
	(tkIntStubsPtr->tkScrollWindow) /* 79 */
#endif
#ifndef TkSelDeadWindow
#define TkSelDeadWindow \
	(tkIntStubsPtr->tkSelDeadWindow) /* 80 */
#endif
#ifndef TkSelEventProc
#define TkSelEventProc \
	(tkIntStubsPtr->tkSelEventProc) /* 81 */
#endif
#ifndef TkSelInit
#define TkSelInit \
	(tkIntStubsPtr->tkSelInit) /* 82 */
#endif
#ifndef TkSelPropProc
#define TkSelPropProc \
	(tkIntStubsPtr->tkSelPropProc) /* 83 */
#endif
#ifndef TkSetClassProcs
#define TkSetClassProcs \
	(tkIntStubsPtr->tkSetClassProcs) /* 84 */
#endif
#ifndef TkSetWindowMenuBar
#define TkSetWindowMenuBar \
	(tkIntStubsPtr->tkSetWindowMenuBar) /* 85 */
#endif
#ifndef TkStringToKeysym
#define TkStringToKeysym \
	(tkIntStubsPtr->tkStringToKeysym) /* 86 */
#endif
#ifndef TkThickPolyLineToArea
#define TkThickPolyLineToArea \
	(tkIntStubsPtr->tkThickPolyLineToArea) /* 87 */
#endif
#ifndef TkWmAddToColormapWindows
#define TkWmAddToColormapWindows \
	(tkIntStubsPtr->tkWmAddToColormapWindows) /* 88 */
#endif
#ifndef TkWmDeadWindow
#define TkWmDeadWindow \
	(tkIntStubsPtr->tkWmDeadWindow) /* 89 */
#endif
#ifndef TkWmFocusToplevel
#define TkWmFocusToplevel \
	(tkIntStubsPtr->tkWmFocusToplevel) /* 90 */
#endif
#ifndef TkWmMapWindow
#define TkWmMapWindow \
	(tkIntStubsPtr->tkWmMapWindow) /* 91 */
#endif
#ifndef TkWmNewWindow
#define TkWmNewWindow \
	(tkIntStubsPtr->tkWmNewWindow) /* 92 */
#endif
#ifndef TkWmProtocolEventProc
#define TkWmProtocolEventProc \
	(tkIntStubsPtr->tkWmProtocolEventProc) /* 93 */
#endif
#ifndef TkWmRemoveFromColormapWindows
#define TkWmRemoveFromColormapWindows \
	(tkIntStubsPtr->tkWmRemoveFromColormapWindows) /* 94 */
#endif
#ifndef TkWmRestackToplevel
#define TkWmRestackToplevel \
	(tkIntStubsPtr->tkWmRestackToplevel) /* 95 */
#endif
#ifndef TkWmSetClass
#define TkWmSetClass \
	(tkIntStubsPtr->tkWmSetClass) /* 96 */
#endif
#ifndef TkWmUnmapWindow
#define TkWmUnmapWindow \
	(tkIntStubsPtr->tkWmUnmapWindow) /* 97 */
#endif
#ifndef TkDebugBitmap
#define TkDebugBitmap \
	(tkIntStubsPtr->tkDebugBitmap) /* 98 */
#endif
#ifndef TkDebugBorder
#define TkDebugBorder \
	(tkIntStubsPtr->tkDebugBorder) /* 99 */
#endif
#ifndef TkDebugCursor
#define TkDebugCursor \
	(tkIntStubsPtr->tkDebugCursor) /* 100 */
#endif
#ifndef TkDebugColor
#define TkDebugColor \
	(tkIntStubsPtr->tkDebugColor) /* 101 */
#endif
#ifndef TkDebugConfig
#define TkDebugConfig \
	(tkIntStubsPtr->tkDebugConfig) /* 102 */
#endif
#ifndef TkDebugFont
#define TkDebugFont \
	(tkIntStubsPtr->tkDebugFont) /* 103 */
#endif
#ifndef TkFindStateNumObj
#define TkFindStateNumObj \
	(tkIntStubsPtr->tkFindStateNumObj) /* 104 */
#endif
#ifndef TkGetBitmapPredefTable
#define TkGetBitmapPredefTable \
	(tkIntStubsPtr->tkGetBitmapPredefTable) /* 105 */
#endif
#ifndef TkGetDisplayList
#define TkGetDisplayList \
	(tkIntStubsPtr->tkGetDisplayList) /* 106 */
#endif
#ifndef TkGetMainInfoList
#define TkGetMainInfoList \
	(tkIntStubsPtr->tkGetMainInfoList) /* 107 */
#endif
#ifndef TkGetWindowFromObj
#define TkGetWindowFromObj \
	(tkIntStubsPtr->tkGetWindowFromObj) /* 108 */
#endif
#ifndef TkpGetString
#define TkpGetString \
	(tkIntStubsPtr->tkpGetString) /* 109 */
#endif
#ifndef TkpGetSubFonts
#define TkpGetSubFonts \
	(tkIntStubsPtr->tkpGetSubFonts) /* 110 */
#endif
#ifndef TkpGetSystemDefault
#define TkpGetSystemDefault \
	(tkIntStubsPtr->tkpGetSystemDefault) /* 111 */
#endif
#ifndef TkpMenuThreadInit
#define TkpMenuThreadInit \
	(tkIntStubsPtr->tkpMenuThreadInit) /* 112 */
#endif

#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TKINTDECLS */

Added generic/tkIntPlatDecls.h.





















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
/*
 * tkIntPlatDecls.h --
 *
 *	This file contains the declarations for all platform dependent
 *	unsupported functions that are exported by the Tk library.  These
 *	interfaces are not guaranteed to remain the same between
 *	versions.  Use at your own risk.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * All rights reserved.
 *
 * RCS: @(#) $Id: tkIntPlatDecls.h,v 1.2.2.2 1999/03/30 02:08:00 redman Exp $
 */

#ifndef _TKINTPLATDECLS
#define _TKINTPLATDECLS

#ifdef BUILD_tk
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
 * script.  Any modifications to the function declarations below should be made
 * in the generic/tkInt.decls script.
 */

/* !BEGIN!: Do not edit below this line. */

/*
 * Exported function declarations:
 */

#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
/* 0 */
EXTERN void		TkCreateXEventSource _ANSI_ARGS_((void));
/* 1 */
EXTERN void		TkFreeWindowId _ANSI_ARGS_((TkDisplay * dispPtr, 
				Window w));
/* 2 */
EXTERN void		TkInitXId _ANSI_ARGS_((TkDisplay * dispPtr));
/* 3 */
EXTERN int		TkpCmapStressed _ANSI_ARGS_((Tk_Window tkwin, 
				Colormap colormap));
/* 4 */
EXTERN void		TkpSync _ANSI_ARGS_((Display * display));
/* 5 */
EXTERN Window		TkUnixContainerId _ANSI_ARGS_((TkWindow * winPtr));
/* 6 */
EXTERN int		TkUnixDoOneXEvent _ANSI_ARGS_((Tcl_Time * timePtr));
/* 7 */
EXTERN void		TkUnixSetMenubar _ANSI_ARGS_((Tk_Window tkwin, 
				Tk_Window menubar));
#endif /* UNIX */
#ifdef __WIN32__
/* 0 */
EXTERN char *		TkAlignImageData _ANSI_ARGS_((XImage * image, 
				int alignment, int bitOrder));
/* 1 */
EXTERN void		TkClipBox _ANSI_ARGS_((TkRegion rgn, 
				XRectangle* rect_return));
/* 2 */
EXTERN TkRegion		TkCreateRegion _ANSI_ARGS_((void));
/* 3 */
EXTERN void		TkDestroyRegion _ANSI_ARGS_((TkRegion rgn));
/* 4 */
EXTERN void		TkGenerateActivateEvents _ANSI_ARGS_((
				TkWindow * winPtr, int active));
/* 5 */
EXTERN void		TkIntersectRegion _ANSI_ARGS_((TkRegion sra, 
				TkRegion srcb, TkRegion dr_return));
/* 6 */
EXTERN unsigned long	TkpGetMS _ANSI_ARGS_((void));
/* 7 */
EXTERN void		TkPointerDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
/* 8 */
EXTERN void		TkpPrintWindowId _ANSI_ARGS_((char * buf, 
				Window window));
/* 9 */
EXTERN int		TkpScanWindowId _ANSI_ARGS_((Tcl_Interp * interp, 
				char * string, int * idPtr));
/* 10 */
EXTERN void		TkpSetCapture _ANSI_ARGS_((TkWindow * winPtr));
/* 11 */
EXTERN void		TkpSetCursor _ANSI_ARGS_((TkpCursor cursor));
/* 12 */
EXTERN void		TkpWmSetState _ANSI_ARGS_((TkWindow * winPtr, 
				int state));
/* 13 */
EXTERN int		TkRectInRegion _ANSI_ARGS_((TkRegion rgn, int x, 
				int y, unsigned int width, 
				unsigned int height));
/* 14 */
EXTERN void		TkSetPixmapColormap _ANSI_ARGS_((Pixmap pixmap, 
				Colormap colormap));
/* 15 */
EXTERN void		TkSetRegion _ANSI_ARGS_((Display* display, GC gc, 
				TkRegion rgn));
/* 16 */
EXTERN void		TkUnionRectWithRegion _ANSI_ARGS_((XRectangle* rect, 
				TkRegion src, TkRegion dr_return));
/* 17 */
EXTERN void		TkWinCancelMouseTimer _ANSI_ARGS_((void));
/* 18 */
EXTERN void		TkWinClipboardRender _ANSI_ARGS_((
				TkDisplay * dispPtr, UINT format));
/* 19 */
EXTERN LRESULT		TkWinEmbeddedEventProc _ANSI_ARGS_((HWND hwnd, 
				UINT message, WPARAM wParam, LPARAM lParam));
/* 20 */
EXTERN void		TkWinFillRect _ANSI_ARGS_((HDC dc, int x, int y, 
				int width, int height, int pixel));
/* 21 */
EXTERN COLORREF		TkWinGetBorderPixels _ANSI_ARGS_((Tk_Window tkwin, 
				Tk_3DBorder border, int which));
/* 22 */
EXTERN HDC		TkWinGetDrawableDC _ANSI_ARGS_((Display * display, 
				Drawable d, TkWinDCState* state));
/* 23 */
EXTERN int		TkWinGetModifierState _ANSI_ARGS_((void));
/* 24 */
EXTERN HPALETTE		TkWinGetSystemPalette _ANSI_ARGS_((void));
/* 25 */
EXTERN HWND		TkWinGetWrapperWindow _ANSI_ARGS_((Tk_Window tkwin));
/* 26 */
EXTERN int		TkWinHandleMenuEvent _ANSI_ARGS_((HWND * phwnd, 
				UINT * pMessage, WPARAM * pwParam, 
				LPARAM * plParam, LRESULT * plResult));
/* 27 */
EXTERN int		TkWinIndexOfColor _ANSI_ARGS_((XColor * colorPtr));
/* 28 */
EXTERN void		TkWinReleaseDrawableDC _ANSI_ARGS_((Drawable d, 
				HDC hdc, TkWinDCState* state));
/* 29 */
EXTERN LRESULT		TkWinResendEvent _ANSI_ARGS_((WNDPROC wndproc, 
				HWND hwnd, XEvent * eventPtr));
/* 30 */
EXTERN HPALETTE		TkWinSelectPalette _ANSI_ARGS_((HDC dc, 
				Colormap colormap));
/* 31 */
EXTERN void		TkWinSetMenu _ANSI_ARGS_((Tk_Window tkwin, 
				HMENU hMenu));
/* 32 */
EXTERN void		TkWinSetWindowPos _ANSI_ARGS_((HWND hwnd, 
				HWND siblingHwnd, int pos));
/* 33 */
EXTERN void		TkWinWmCleanup _ANSI_ARGS_((HINSTANCE hInstance));
/* 34 */
EXTERN void		TkWinXCleanup _ANSI_ARGS_((HINSTANCE hInstance));
/* 35 */
EXTERN void		TkWinXInit _ANSI_ARGS_((HINSTANCE hInstance));
/* 36 */
EXTERN void		TkWinSetForegroundWindow _ANSI_ARGS_((
				TkWindow * winPtr));
/* 37 */
EXTERN void		TkWinDialogDebug _ANSI_ARGS_((int debug));
/* 38 */
EXTERN Tcl_Obj *	TkWinGetMenuSystemDefault _ANSI_ARGS_((
				Tk_Window tkwin, char * dbName, 
				char * className));
/* 39 */
EXTERN int		TkWinGetPlatformId _ANSI_ARGS_((void));
#endif /* __WIN32__ */
#ifdef MAC_TCL
/* 0 */
EXTERN void		TkClipBox _ANSI_ARGS_((TkRegion rgn, 
				XRectangle* rect_return));
/* 1 */
EXTERN TkRegion		TkCreateRegion _ANSI_ARGS_((void));
/* 2 */
EXTERN void		TkDestroyRegion _ANSI_ARGS_((TkRegion rgn));
/* 3 */
EXTERN void		TkGenerateActivateEvents _ANSI_ARGS_((
				TkWindow * winPtr, int active));
/* 4 */
EXTERN void		TkIntersectRegion _ANSI_ARGS_((TkRegion sra, 
				TkRegion srcb, TkRegion dr_return));
/* 5 */
EXTERN Pixmap		TkpCreateNativeBitmap _ANSI_ARGS_((Display * display, 
				char * source));
/* 6 */
EXTERN void		TkpDefineNativeBitmaps _ANSI_ARGS_((void));
/* 7 */
EXTERN unsigned long	TkpGetMS _ANSI_ARGS_((void));
/* 8 */
EXTERN Pixmap		TkpGetNativeAppBitmap _ANSI_ARGS_((Display * display, 
				char * name, int * width, int * height));
/* 9 */
EXTERN void		TkPointerDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
/* 10 */
EXTERN void		TkpSetCapture _ANSI_ARGS_((TkWindow * winPtr));
/* 11 */
EXTERN void		TkpSetCursor _ANSI_ARGS_((TkpCursor cursor));
/* 12 */
EXTERN void		TkpWmSetState _ANSI_ARGS_((TkWindow * winPtr, 
				int state));
/* 13 */
EXTERN int		TkRectInRegion _ANSI_ARGS_((TkRegion rgn, int x, 
				int y, unsigned int width, 
				unsigned int height));
/* 14 */
EXTERN void		TkSetRegion _ANSI_ARGS_((Display* display, GC gc, 
				TkRegion rgn));
/* 15 */
EXTERN void		TkUnionRectWithRegion _ANSI_ARGS_((XRectangle* rect, 
				TkRegion src, TkRegion dr_return));
/* 16 */
EXTERN int		HandleWMEvent _ANSI_ARGS_((EventRecord * theEvent));
/* 17 */
EXTERN void		TkAboutDlg _ANSI_ARGS_((void));
/* 18 */
EXTERN void		TkCreateMacEventSource _ANSI_ARGS_((void));
/* 19 */
EXTERN void		TkFontList _ANSI_ARGS_((Tcl_Interp * interp, 
				Display * display));
/* 20 */
EXTERN Window		TkGetTransientMaster _ANSI_ARGS_((TkWindow * winPtr));
/* 21 */
EXTERN int		TkGenerateButtonEvent _ANSI_ARGS_((int x, int y, 
				Window window, unsigned int state));
/* 22 */
EXTERN int		TkGetCharPositions _ANSI_ARGS_((
				XFontStruct * font_struct, char * string, 
				int count, short * buffer));
/* 23 */
EXTERN void		TkGenWMDestroyEvent _ANSI_ARGS_((Tk_Window tkwin));
/* 24 */
EXTERN void		TkGenWMConfigureEvent _ANSI_ARGS_((Tk_Window tkwin, 
				int x, int y, int width, int height, 
				int flags));
/* 25 */
EXTERN unsigned int	TkMacButtonKeyState _ANSI_ARGS_((void));
/* 26 */
EXTERN void		TkMacClearMenubarActive _ANSI_ARGS_((void));
/* 27 */
EXTERN int		TkMacConvertEvent _ANSI_ARGS_((
				EventRecord * eventPtr));
/* 28 */
EXTERN int		TkMacDispatchMenuEvent _ANSI_ARGS_((int menuID, 
				int index));
/* 29 */
EXTERN void		TkMacInstallCursor _ANSI_ARGS_((int resizeOverride));
/* 30 */
EXTERN int		TkMacConvertTkEvent _ANSI_ARGS_((
				EventRecord * eventPtr, Window window));
/* 31 */
EXTERN void		TkMacHandleTearoffMenu _ANSI_ARGS_((void));
/* 32 */
EXTERN void		tkMacInstallMWConsole _ANSI_ARGS_((
				Tcl_Interp * interp));
/* 33 */
EXTERN void		TkMacInvalClipRgns _ANSI_ARGS_((TkWindow * winPtr));
/* 34 */
EXTERN void		TkMacDoHLEvent _ANSI_ARGS_((EventRecord * theEvent));
/* 35 */
EXTERN void		TkMacFontInfo _ANSI_ARGS_((Font fontId, 
				short * family, short * style, short * size));
/* 36 */
EXTERN Time		TkMacGenerateTime _ANSI_ARGS_((void));
/* 37 */
EXTERN GWorldPtr	TkMacGetDrawablePort _ANSI_ARGS_((Drawable drawable));
/* 38 */
EXTERN TkWindow *	TkMacGetScrollbarGrowWindow _ANSI_ARGS_((
				TkWindow * winPtr));
/* 39 */
EXTERN Window		TkMacGetXWindow _ANSI_ARGS_((WindowRef macWinPtr));
/* 40 */
EXTERN int		TkMacGrowToplevel _ANSI_ARGS_((WindowRef whichWindow, 
				Point start));
/* 41 */
EXTERN void		TkMacHandleMenuSelect _ANSI_ARGS_((long mResult, 
				int optionKeyPressed));
/* 42 */
EXTERN int		TkMacHaveAppearance _ANSI_ARGS_((void));
/* 43 */
EXTERN void		TkMacInitAppleEvents _ANSI_ARGS_((
				Tcl_Interp * interp));
/* 44 */
EXTERN void		TkMacInitMenus _ANSI_ARGS_((Tcl_Interp * interp));
/* 45 */
EXTERN void		TkMacInvalidateWindow _ANSI_ARGS_((
				MacDrawable * macWin, int flag));
/* 46 */
EXTERN int		TkMacIsCharacterMissing _ANSI_ARGS_((Tk_Font tkfont, 
				unsigned int searchChar));
/* 47 */
EXTERN void		TkMacMakeRealWindowExist _ANSI_ARGS_((
				TkWindow * winPtr));
/* 48 */
EXTERN BitMapPtr	TkMacMakeStippleMap _ANSI_ARGS_((Drawable d1, 
				Drawable d2));
/* 49 */
EXTERN void		TkMacMenuClick _ANSI_ARGS_((void));
/* 50 */
EXTERN void		TkMacRegisterOffScreenWindow _ANSI_ARGS_((
				Window window, GWorldPtr portPtr));
/* 51 */
EXTERN int		TkMacResizable _ANSI_ARGS_((TkWindow * winPtr));
/* 52 */
EXTERN void		TkMacSetEmbedRgn _ANSI_ARGS_((TkWindow * winPtr, 
				RgnHandle rgn));
/* 53 */
EXTERN void		TkMacSetHelpMenuItemCount _ANSI_ARGS_((void));
/* 54 */
EXTERN void		TkMacSetScrollbarGrow _ANSI_ARGS_((TkWindow * winPtr, 
				int flag));
/* 55 */
EXTERN void		TkMacSetUpClippingRgn _ANSI_ARGS_((Drawable drawable));
/* 56 */
EXTERN void		TkMacSetUpGraphicsPort _ANSI_ARGS_((GC gc));
/* 57 */
EXTERN void		TkMacUpdateClipRgn _ANSI_ARGS_((TkWindow * winPtr));
/* 58 */
EXTERN void		TkMacUnregisterMacWindow _ANSI_ARGS_((
				GWorldPtr portPtr));
/* 59 */
EXTERN int		TkMacUseMenuID _ANSI_ARGS_((short macID));
/* 60 */
EXTERN RgnHandle	TkMacVisableClipRgn _ANSI_ARGS_((TkWindow * winPtr));
/* 61 */
EXTERN void		TkMacWinBounds _ANSI_ARGS_((TkWindow * winPtr, 
				Rect * geometry));
/* 62 */
EXTERN void		TkMacWindowOffset _ANSI_ARGS_((WindowRef wRef, 
				int * xOffset, int * yOffset));
/* 63 */
EXTERN void		TkResumeClipboard _ANSI_ARGS_((void));
/* 64 */
EXTERN int		TkSetMacColor _ANSI_ARGS_((unsigned long pixel, 
				RGBColor * macColor));
/* 65 */
EXTERN void		TkSetWMName _ANSI_ARGS_((TkWindow * winPtr, 
				Tk_Uid titleUid));
/* 66 */
EXTERN void		TkSuspendClipboard _ANSI_ARGS_((void));
/* 67 */
EXTERN int		TkWMGrowToplevel _ANSI_ARGS_((WindowRef whichWindow, 
				Point start));
/* 68 */
EXTERN int		TkMacZoomToplevel _ANSI_ARGS_((WindowPtr whichWindow, 
				Point where, short zoomPart));
/* 69 */
EXTERN Tk_Window	Tk_TopCoordsToWindow _ANSI_ARGS_((Tk_Window tkwin, 
				int rootX, int rootY, int * newX, int * newY));
/* 70 */
EXTERN MacDrawable *	TkMacContainerId _ANSI_ARGS_((TkWindow * winPtr));
/* 71 */
EXTERN MacDrawable *	TkMacGetHostToplevel _ANSI_ARGS_((TkWindow * winPtr));
#endif /* MAC_TCL */

typedef struct TkIntPlatStubs {
    int magic;
    struct TkIntPlatStubHooks *hooks;

#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
    void (*tkCreateXEventSource) _ANSI_ARGS_((void)); /* 0 */
    void (*tkFreeWindowId) _ANSI_ARGS_((TkDisplay * dispPtr, Window w)); /* 1 */
    void (*tkInitXId) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 2 */
    int (*tkpCmapStressed) _ANSI_ARGS_((Tk_Window tkwin, Colormap colormap)); /* 3 */
    void (*tkpSync) _ANSI_ARGS_((Display * display)); /* 4 */
    Window (*tkUnixContainerId) _ANSI_ARGS_((TkWindow * winPtr)); /* 5 */
    int (*tkUnixDoOneXEvent) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 6 */
    void (*tkUnixSetMenubar) _ANSI_ARGS_((Tk_Window tkwin, Tk_Window menubar)); /* 7 */
#endif /* UNIX */
#ifdef __WIN32__
    char * (*tkAlignImageData) _ANSI_ARGS_((XImage * image, int alignment, int bitOrder)); /* 0 */
    void (*tkClipBox) _ANSI_ARGS_((TkRegion rgn, XRectangle* rect_return)); /* 1 */
    TkRegion (*tkCreateRegion) _ANSI_ARGS_((void)); /* 2 */
    void (*tkDestroyRegion) _ANSI_ARGS_((TkRegion rgn)); /* 3 */
    void (*tkGenerateActivateEvents) _ANSI_ARGS_((TkWindow * winPtr, int active)); /* 4 */
    void (*tkIntersectRegion) _ANSI_ARGS_((TkRegion sra, TkRegion srcb, TkRegion dr_return)); /* 5 */
    unsigned long (*tkpGetMS) _ANSI_ARGS_((void)); /* 6 */
    void (*tkPointerDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 7 */
    void (*tkpPrintWindowId) _ANSI_ARGS_((char * buf, Window window)); /* 8 */
    int (*tkpScanWindowId) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int * idPtr)); /* 9 */
    void (*tkpSetCapture) _ANSI_ARGS_((TkWindow * winPtr)); /* 10 */
    void (*tkpSetCursor) _ANSI_ARGS_((TkpCursor cursor)); /* 11 */
    void (*tkpWmSetState) _ANSI_ARGS_((TkWindow * winPtr, int state)); /* 12 */
    int (*tkRectInRegion) _ANSI_ARGS_((TkRegion rgn, int x, int y, unsigned int width, unsigned int height)); /* 13 */
    void (*tkSetPixmapColormap) _ANSI_ARGS_((Pixmap pixmap, Colormap colormap)); /* 14 */
    void (*tkSetRegion) _ANSI_ARGS_((Display* display, GC gc, TkRegion rgn)); /* 15 */
    void (*tkUnionRectWithRegion) _ANSI_ARGS_((XRectangle* rect, TkRegion src, TkRegion dr_return)); /* 16 */
    void (*tkWinCancelMouseTimer) _ANSI_ARGS_((void)); /* 17 */
    void (*tkWinClipboardRender) _ANSI_ARGS_((TkDisplay * dispPtr, UINT format)); /* 18 */
    LRESULT (*tkWinEmbeddedEventProc) _ANSI_ARGS_((HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)); /* 19 */
    void (*tkWinFillRect) _ANSI_ARGS_((HDC dc, int x, int y, int width, int height, int pixel)); /* 20 */
    COLORREF (*tkWinGetBorderPixels) _ANSI_ARGS_((Tk_Window tkwin, Tk_3DBorder border, int which)); /* 21 */
    HDC (*tkWinGetDrawableDC) _ANSI_ARGS_((Display * display, Drawable d, TkWinDCState* state)); /* 22 */
    int (*tkWinGetModifierState) _ANSI_ARGS_((void)); /* 23 */
    HPALETTE (*tkWinGetSystemPalette) _ANSI_ARGS_((void)); /* 24 */
    HWND (*tkWinGetWrapperWindow) _ANSI_ARGS_((Tk_Window tkwin)); /* 25 */
    int (*tkWinHandleMenuEvent) _ANSI_ARGS_((HWND * phwnd, UINT * pMessage, WPARAM * pwParam, LPARAM * plParam, LRESULT * plResult)); /* 26 */
    int (*tkWinIndexOfColor) _ANSI_ARGS_((XColor * colorPtr)); /* 27 */
    void (*tkWinReleaseDrawableDC) _ANSI_ARGS_((Drawable d, HDC hdc, TkWinDCState* state)); /* 28 */
    LRESULT (*tkWinResendEvent) _ANSI_ARGS_((WNDPROC wndproc, HWND hwnd, XEvent * eventPtr)); /* 29 */
    HPALETTE (*tkWinSelectPalette) _ANSI_ARGS_((HDC dc, Colormap colormap)); /* 30 */
    void (*tkWinSetMenu) _ANSI_ARGS_((Tk_Window tkwin, HMENU hMenu)); /* 31 */
    void (*tkWinSetWindowPos) _ANSI_ARGS_((HWND hwnd, HWND siblingHwnd, int pos)); /* 32 */
    void (*tkWinWmCleanup) _ANSI_ARGS_((HINSTANCE hInstance)); /* 33 */
    void (*tkWinXCleanup) _ANSI_ARGS_((HINSTANCE hInstance)); /* 34 */
    void (*tkWinXInit) _ANSI_ARGS_((HINSTANCE hInstance)); /* 35 */
    void (*tkWinSetForegroundWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 36 */
    void (*tkWinDialogDebug) _ANSI_ARGS_((int debug)); /* 37 */
    Tcl_Obj * (*tkWinGetMenuSystemDefault) _ANSI_ARGS_((Tk_Window tkwin, char * dbName, char * className)); /* 38 */
    int (*tkWinGetPlatformId) _ANSI_ARGS_((void)); /* 39 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    void (*tkClipBox) _ANSI_ARGS_((TkRegion rgn, XRectangle* rect_return)); /* 0 */
    TkRegion (*tkCreateRegion) _ANSI_ARGS_((void)); /* 1 */
    void (*tkDestroyRegion) _ANSI_ARGS_((TkRegion rgn)); /* 2 */
    void (*tkGenerateActivateEvents) _ANSI_ARGS_((TkWindow * winPtr, int active)); /* 3 */
    void (*tkIntersectRegion) _ANSI_ARGS_((TkRegion sra, TkRegion srcb, TkRegion dr_return)); /* 4 */
    Pixmap (*tkpCreateNativeBitmap) _ANSI_ARGS_((Display * display, char * source)); /* 5 */
    void (*tkpDefineNativeBitmaps) _ANSI_ARGS_((void)); /* 6 */
    unsigned long (*tkpGetMS) _ANSI_ARGS_((void)); /* 7 */
    Pixmap (*tkpGetNativeAppBitmap) _ANSI_ARGS_((Display * display, char * name, int * width, int * height)); /* 8 */
    void (*tkPointerDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 9 */
    void (*tkpSetCapture) _ANSI_ARGS_((TkWindow * winPtr)); /* 10 */
    void (*tkpSetCursor) _ANSI_ARGS_((TkpCursor cursor)); /* 11 */
    void (*tkpWmSetState) _ANSI_ARGS_((TkWindow * winPtr, int state)); /* 12 */
    int (*tkRectInRegion) _ANSI_ARGS_((TkRegion rgn, int x, int y, unsigned int width, unsigned int height)); /* 13 */
    void (*tkSetRegion) _ANSI_ARGS_((Display* display, GC gc, TkRegion rgn)); /* 14 */
    void (*tkUnionRectWithRegion) _ANSI_ARGS_((XRectangle* rect, TkRegion src, TkRegion dr_return)); /* 15 */
    int (*handleWMEvent) _ANSI_ARGS_((EventRecord * theEvent)); /* 16 */
    void (*tkAboutDlg) _ANSI_ARGS_((void)); /* 17 */
    void (*tkCreateMacEventSource) _ANSI_ARGS_((void)); /* 18 */
    void (*tkFontList) _ANSI_ARGS_((Tcl_Interp * interp, Display * display)); /* 19 */
    Window (*tkGetTransientMaster) _ANSI_ARGS_((TkWindow * winPtr)); /* 20 */
    int (*tkGenerateButtonEvent) _ANSI_ARGS_((int x, int y, Window window, unsigned int state)); /* 21 */
    int (*tkGetCharPositions) _ANSI_ARGS_((XFontStruct * font_struct, char * string, int count, short * buffer)); /* 22 */
    void (*tkGenWMDestroyEvent) _ANSI_ARGS_((Tk_Window tkwin)); /* 23 */
    void (*tkGenWMConfigureEvent) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int width, int height, int flags)); /* 24 */
    unsigned int (*tkMacButtonKeyState) _ANSI_ARGS_((void)); /* 25 */
    void (*tkMacClearMenubarActive) _ANSI_ARGS_((void)); /* 26 */
    int (*tkMacConvertEvent) _ANSI_ARGS_((EventRecord * eventPtr)); /* 27 */
    int (*tkMacDispatchMenuEvent) _ANSI_ARGS_((int menuID, int index)); /* 28 */
    void (*tkMacInstallCursor) _ANSI_ARGS_((int resizeOverride)); /* 29 */
    int (*tkMacConvertTkEvent) _ANSI_ARGS_((EventRecord * eventPtr, Window window)); /* 30 */
    void (*tkMacHandleTearoffMenu) _ANSI_ARGS_((void)); /* 31 */
    void (*tkMacInstallMWConsole) _ANSI_ARGS_((Tcl_Interp * interp)); /* 32 */
    void (*tkMacInvalClipRgns) _ANSI_ARGS_((TkWindow * winPtr)); /* 33 */
    void (*tkMacDoHLEvent) _ANSI_ARGS_((EventRecord * theEvent)); /* 34 */
    void (*tkMacFontInfo) _ANSI_ARGS_((Font fontId, short * family, short * style, short * size)); /* 35 */
    Time (*tkMacGenerateTime) _ANSI_ARGS_((void)); /* 36 */
    GWorldPtr (*tkMacGetDrawablePort) _ANSI_ARGS_((Drawable drawable)); /* 37 */
    TkWindow * (*tkMacGetScrollbarGrowWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 38 */
    Window (*tkMacGetXWindow) _ANSI_ARGS_((WindowRef macWinPtr)); /* 39 */
    int (*tkMacGrowToplevel) _ANSI_ARGS_((WindowRef whichWindow, Point start)); /* 40 */
    void (*tkMacHandleMenuSelect) _ANSI_ARGS_((long mResult, int optionKeyPressed)); /* 41 */
    int (*tkMacHaveAppearance) _ANSI_ARGS_((void)); /* 42 */
    void (*tkMacInitAppleEvents) _ANSI_ARGS_((Tcl_Interp * interp)); /* 43 */
    void (*tkMacInitMenus) _ANSI_ARGS_((Tcl_Interp * interp)); /* 44 */
    void (*tkMacInvalidateWindow) _ANSI_ARGS_((MacDrawable * macWin, int flag)); /* 45 */
    int (*tkMacIsCharacterMissing) _ANSI_ARGS_((Tk_Font tkfont, unsigned int searchChar)); /* 46 */
    void (*tkMacMakeRealWindowExist) _ANSI_ARGS_((TkWindow * winPtr)); /* 47 */
    BitMapPtr (*tkMacMakeStippleMap) _ANSI_ARGS_((Drawable d1, Drawable d2)); /* 48 */
    void (*tkMacMenuClick) _ANSI_ARGS_((void)); /* 49 */
    void (*tkMacRegisterOffScreenWindow) _ANSI_ARGS_((Window window, GWorldPtr portPtr)); /* 50 */
    int (*tkMacResizable) _ANSI_ARGS_((TkWindow * winPtr)); /* 51 */
    void (*tkMacSetEmbedRgn) _ANSI_ARGS_((TkWindow * winPtr, RgnHandle rgn)); /* 52 */
    void (*tkMacSetHelpMenuItemCount) _ANSI_ARGS_((void)); /* 53 */
    void (*tkMacSetScrollbarGrow) _ANSI_ARGS_((TkWindow * winPtr, int flag)); /* 54 */
    void (*tkMacSetUpClippingRgn) _ANSI_ARGS_((Drawable drawable)); /* 55 */
    void (*tkMacSetUpGraphicsPort) _ANSI_ARGS_((GC gc)); /* 56 */
    void (*tkMacUpdateClipRgn) _ANSI_ARGS_((TkWindow * winPtr)); /* 57 */
    void (*tkMacUnregisterMacWindow) _ANSI_ARGS_((GWorldPtr portPtr)); /* 58 */
    int (*tkMacUseMenuID) _ANSI_ARGS_((short macID)); /* 59 */
    RgnHandle (*tkMacVisableClipRgn) _ANSI_ARGS_((TkWindow * winPtr)); /* 60 */
    void (*tkMacWinBounds) _ANSI_ARGS_((TkWindow * winPtr, Rect * geometry)); /* 61 */
    void (*tkMacWindowOffset) _ANSI_ARGS_((WindowRef wRef, int * xOffset, int * yOffset)); /* 62 */
    void (*tkResumeClipboard) _ANSI_ARGS_((void)); /* 63 */
    int (*tkSetMacColor) _ANSI_ARGS_((unsigned long pixel, RGBColor * macColor)); /* 64 */
    void (*tkSetWMName) _ANSI_ARGS_((TkWindow * winPtr, Tk_Uid titleUid)); /* 65 */
    void (*tkSuspendClipboard) _ANSI_ARGS_((void)); /* 66 */
    int (*tkWMGrowToplevel) _ANSI_ARGS_((WindowRef whichWindow, Point start)); /* 67 */
    int (*tkMacZoomToplevel) _ANSI_ARGS_((WindowPtr whichWindow, Point where, short zoomPart)); /* 68 */
    Tk_Window (*tk_TopCoordsToWindow) _ANSI_ARGS_((Tk_Window tkwin, int rootX, int rootY, int * newX, int * newY)); /* 69 */
    MacDrawable * (*tkMacContainerId) _ANSI_ARGS_((TkWindow * winPtr)); /* 70 */
    MacDrawable * (*tkMacGetHostToplevel) _ANSI_ARGS_((TkWindow * winPtr)); /* 71 */
#endif /* MAC_TCL */
} TkIntPlatStubs;

extern TkIntPlatStubs *tkIntPlatStubsPtr;

#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS)

/*
 * Inline function declarations:
 */

#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#ifndef TkCreateXEventSource
#define TkCreateXEventSource \
	(tkIntPlatStubsPtr->tkCreateXEventSource) /* 0 */
#endif
#ifndef TkFreeWindowId
#define TkFreeWindowId \
	(tkIntPlatStubsPtr->tkFreeWindowId) /* 1 */
#endif
#ifndef TkInitXId
#define TkInitXId \
	(tkIntPlatStubsPtr->tkInitXId) /* 2 */
#endif
#ifndef TkpCmapStressed
#define TkpCmapStressed \
	(tkIntPlatStubsPtr->tkpCmapStressed) /* 3 */
#endif
#ifndef TkpSync
#define TkpSync \
	(tkIntPlatStubsPtr->tkpSync) /* 4 */
#endif
#ifndef TkUnixContainerId
#define TkUnixContainerId \
	(tkIntPlatStubsPtr->tkUnixContainerId) /* 5 */
#endif
#ifndef TkUnixDoOneXEvent
#define TkUnixDoOneXEvent \
	(tkIntPlatStubsPtr->tkUnixDoOneXEvent) /* 6 */
#endif
#ifndef TkUnixSetMenubar
#define TkUnixSetMenubar \
	(tkIntPlatStubsPtr->tkUnixSetMenubar) /* 7 */
#endif
#endif /* UNIX */
#ifdef __WIN32__
#ifndef TkAlignImageData
#define TkAlignImageData \
	(tkIntPlatStubsPtr->tkAlignImageData) /* 0 */
#endif
#ifndef TkClipBox
#define TkClipBox \
	(tkIntPlatStubsPtr->tkClipBox) /* 1 */
#endif
#ifndef TkCreateRegion
#define TkCreateRegion \
	(tkIntPlatStubsPtr->tkCreateRegion) /* 2 */
#endif
#ifndef TkDestroyRegion
#define TkDestroyRegion \
	(tkIntPlatStubsPtr->tkDestroyRegion) /* 3 */
#endif
#ifndef TkGenerateActivateEvents
#define TkGenerateActivateEvents \
	(tkIntPlatStubsPtr->tkGenerateActivateEvents) /* 4 */
#endif
#ifndef TkIntersectRegion
#define TkIntersectRegion \
	(tkIntPlatStubsPtr->tkIntersectRegion) /* 5 */
#endif
#ifndef TkpGetMS
#define TkpGetMS \
	(tkIntPlatStubsPtr->tkpGetMS) /* 6 */
#endif
#ifndef TkPointerDeadWindow
#define TkPointerDeadWindow \
	(tkIntPlatStubsPtr->tkPointerDeadWindow) /* 7 */
#endif
#ifndef TkpPrintWindowId
#define TkpPrintWindowId \
	(tkIntPlatStubsPtr->tkpPrintWindowId) /* 8 */
#endif
#ifndef TkpScanWindowId
#define TkpScanWindowId \
	(tkIntPlatStubsPtr->tkpScanWindowId) /* 9 */
#endif
#ifndef TkpSetCapture
#define TkpSetCapture \
	(tkIntPlatStubsPtr->tkpSetCapture) /* 10 */
#endif
#ifndef TkpSetCursor
#define TkpSetCursor \
	(tkIntPlatStubsPtr->tkpSetCursor) /* 11 */
#endif
#ifndef TkpWmSetState
#define TkpWmSetState \
	(tkIntPlatStubsPtr->tkpWmSetState) /* 12 */
#endif
#ifndef TkRectInRegion
#define TkRectInRegion \
	(tkIntPlatStubsPtr->tkRectInRegion) /* 13 */
#endif
#ifndef TkSetPixmapColormap
#define TkSetPixmapColormap \
	(tkIntPlatStubsPtr->tkSetPixmapColormap) /* 14 */
#endif
#ifndef TkSetRegion
#define TkSetRegion \
	(tkIntPlatStubsPtr->tkSetRegion) /* 15 */
#endif
#ifndef TkUnionRectWithRegion
#define TkUnionRectWithRegion \
	(tkIntPlatStubsPtr->tkUnionRectWithRegion) /* 16 */
#endif
#ifndef TkWinCancelMouseTimer
#define TkWinCancelMouseTimer \
	(tkIntPlatStubsPtr->tkWinCancelMouseTimer) /* 17 */
#endif
#ifndef TkWinClipboardRender
#define TkWinClipboardRender \
	(tkIntPlatStubsPtr->tkWinClipboardRender) /* 18 */
#endif
#ifndef TkWinEmbeddedEventProc
#define TkWinEmbeddedEventProc \
	(tkIntPlatStubsPtr->tkWinEmbeddedEventProc) /* 19 */
#endif
#ifndef TkWinFillRect
#define TkWinFillRect \
	(tkIntPlatStubsPtr->tkWinFillRect) /* 20 */
#endif
#ifndef TkWinGetBorderPixels
#define TkWinGetBorderPixels \
	(tkIntPlatStubsPtr->tkWinGetBorderPixels) /* 21 */
#endif
#ifndef TkWinGetDrawableDC
#define TkWinGetDrawableDC \
	(tkIntPlatStubsPtr->tkWinGetDrawableDC) /* 22 */
#endif
#ifndef TkWinGetModifierState
#define TkWinGetModifierState \
	(tkIntPlatStubsPtr->tkWinGetModifierState) /* 23 */
#endif
#ifndef TkWinGetSystemPalette
#define TkWinGetSystemPalette \
	(tkIntPlatStubsPtr->tkWinGetSystemPalette) /* 24 */
#endif
#ifndef TkWinGetWrapperWindow
#define TkWinGetWrapperWindow \
	(tkIntPlatStubsPtr->tkWinGetWrapperWindow) /* 25 */
#endif
#ifndef TkWinHandleMenuEvent
#define TkWinHandleMenuEvent \
	(tkIntPlatStubsPtr->tkWinHandleMenuEvent) /* 26 */
#endif
#ifndef TkWinIndexOfColor
#define TkWinIndexOfColor \
	(tkIntPlatStubsPtr->tkWinIndexOfColor) /* 27 */
#endif
#ifndef TkWinReleaseDrawableDC
#define TkWinReleaseDrawableDC \
	(tkIntPlatStubsPtr->tkWinReleaseDrawableDC) /* 28 */
#endif
#ifndef TkWinResendEvent
#define TkWinResendEvent \
	(tkIntPlatStubsPtr->tkWinResendEvent) /* 29 */
#endif
#ifndef TkWinSelectPalette
#define TkWinSelectPalette \
	(tkIntPlatStubsPtr->tkWinSelectPalette) /* 30 */
#endif
#ifndef TkWinSetMenu
#define TkWinSetMenu \
	(tkIntPlatStubsPtr->tkWinSetMenu) /* 31 */
#endif
#ifndef TkWinSetWindowPos
#define TkWinSetWindowPos \
	(tkIntPlatStubsPtr->tkWinSetWindowPos) /* 32 */
#endif
#ifndef TkWinWmCleanup
#define TkWinWmCleanup \
	(tkIntPlatStubsPtr->tkWinWmCleanup) /* 33 */
#endif
#ifndef TkWinXCleanup
#define TkWinXCleanup \
	(tkIntPlatStubsPtr->tkWinXCleanup) /* 34 */
#endif
#ifndef TkWinXInit
#define TkWinXInit \
	(tkIntPlatStubsPtr->tkWinXInit) /* 35 */
#endif
#ifndef TkWinSetForegroundWindow
#define TkWinSetForegroundWindow \
	(tkIntPlatStubsPtr->tkWinSetForegroundWindow) /* 36 */
#endif
#ifndef TkWinDialogDebug
#define TkWinDialogDebug \
	(tkIntPlatStubsPtr->tkWinDialogDebug) /* 37 */
#endif
#ifndef TkWinGetMenuSystemDefault
#define TkWinGetMenuSystemDefault \
	(tkIntPlatStubsPtr->tkWinGetMenuSystemDefault) /* 38 */
#endif
#ifndef TkWinGetPlatformId
#define TkWinGetPlatformId \
	(tkIntPlatStubsPtr->tkWinGetPlatformId) /* 39 */
#endif
#endif /* __WIN32__ */
#ifdef MAC_TCL
#ifndef TkClipBox
#define TkClipBox \
	(tkIntPlatStubsPtr->tkClipBox) /* 0 */
#endif
#ifndef TkCreateRegion
#define TkCreateRegion \
	(tkIntPlatStubsPtr->tkCreateRegion) /* 1 */
#endif
#ifndef TkDestroyRegion
#define TkDestroyRegion \
	(tkIntPlatStubsPtr->tkDestroyRegion) /* 2 */
#endif
#ifndef TkGenerateActivateEvents
#define TkGenerateActivateEvents \
	(tkIntPlatStubsPtr->tkGenerateActivateEvents) /* 3 */
#endif
#ifndef TkIntersectRegion
#define TkIntersectRegion \
	(tkIntPlatStubsPtr->tkIntersectRegion) /* 4 */
#endif
#ifndef TkpCreateNativeBitmap
#define TkpCreateNativeBitmap \
	(tkIntPlatStubsPtr->tkpCreateNativeBitmap) /* 5 */
#endif
#ifndef TkpDefineNativeBitmaps
#define TkpDefineNativeBitmaps \
	(tkIntPlatStubsPtr->tkpDefineNativeBitmaps) /* 6 */
#endif
#ifndef TkpGetMS
#define TkpGetMS \
	(tkIntPlatStubsPtr->tkpGetMS) /* 7 */
#endif
#ifndef TkpGetNativeAppBitmap
#define TkpGetNativeAppBitmap \
	(tkIntPlatStubsPtr->tkpGetNativeAppBitmap) /* 8 */
#endif
#ifndef TkPointerDeadWindow
#define TkPointerDeadWindow \
	(tkIntPlatStubsPtr->tkPointerDeadWindow) /* 9 */
#endif
#ifndef TkpSetCapture
#define TkpSetCapture \
	(tkIntPlatStubsPtr->tkpSetCapture) /* 10 */
#endif
#ifndef TkpSetCursor
#define TkpSetCursor \
	(tkIntPlatStubsPtr->tkpSetCursor) /* 11 */
#endif
#ifndef TkpWmSetState
#define TkpWmSetState \
	(tkIntPlatStubsPtr->tkpWmSetState) /* 12 */
#endif
#ifndef TkRectInRegion
#define TkRectInRegion \
	(tkIntPlatStubsPtr->tkRectInRegion) /* 13 */
#endif
#ifndef TkSetRegion
#define TkSetRegion \
	(tkIntPlatStubsPtr->tkSetRegion) /* 14 */
#endif
#ifndef TkUnionRectWithRegion
#define TkUnionRectWithRegion \
	(tkIntPlatStubsPtr->tkUnionRectWithRegion) /* 15 */
#endif
#ifndef HandleWMEvent
#define HandleWMEvent \
	(tkIntPlatStubsPtr->handleWMEvent) /* 16 */
#endif
#ifndef TkAboutDlg
#define TkAboutDlg \
	(tkIntPlatStubsPtr->tkAboutDlg) /* 17 */
#endif
#ifndef TkCreateMacEventSource
#define TkCreateMacEventSource \
	(tkIntPlatStubsPtr->tkCreateMacEventSource) /* 18 */
#endif
#ifndef TkFontList
#define TkFontList \
	(tkIntPlatStubsPtr->tkFontList) /* 19 */
#endif
#ifndef TkGetTransientMaster
#define TkGetTransientMaster \
	(tkIntPlatStubsPtr->tkGetTransientMaster) /* 20 */
#endif
#ifndef TkGenerateButtonEvent
#define TkGenerateButtonEvent \
	(tkIntPlatStubsPtr->tkGenerateButtonEvent) /* 21 */
#endif
#ifndef TkGetCharPositions
#define TkGetCharPositions \
	(tkIntPlatStubsPtr->tkGetCharPositions) /* 22 */
#endif
#ifndef TkGenWMDestroyEvent
#define TkGenWMDestroyEvent \
	(tkIntPlatStubsPtr->tkGenWMDestroyEvent) /* 23 */
#endif
#ifndef TkGenWMConfigureEvent
#define TkGenWMConfigureEvent \
	(tkIntPlatStubsPtr->tkGenWMConfigureEvent) /* 24 */
#endif
#ifndef TkMacButtonKeyState
#define TkMacButtonKeyState \
	(tkIntPlatStubsPtr->tkMacButtonKeyState) /* 25 */
#endif
#ifndef TkMacClearMenubarActive
#define TkMacClearMenubarActive \
	(tkIntPlatStubsPtr->tkMacClearMenubarActive) /* 26 */
#endif
#ifndef TkMacConvertEvent
#define TkMacConvertEvent \
	(tkIntPlatStubsPtr->tkMacConvertEvent) /* 27 */
#endif
#ifndef TkMacDispatchMenuEvent
#define TkMacDispatchMenuEvent \
	(tkIntPlatStubsPtr->tkMacDispatchMenuEvent) /* 28 */
#endif
#ifndef TkMacInstallCursor
#define TkMacInstallCursor \
	(tkIntPlatStubsPtr->tkMacInstallCursor) /* 29 */
#endif
#ifndef TkMacConvertTkEvent
#define TkMacConvertTkEvent \
	(tkIntPlatStubsPtr->tkMacConvertTkEvent) /* 30 */
#endif
#ifndef TkMacHandleTearoffMenu
#define TkMacHandleTearoffMenu \
	(tkIntPlatStubsPtr->tkMacHandleTearoffMenu) /* 31 */
#endif
#ifndef tkMacInstallMWConsole
#define tkMacInstallMWConsole \
	(tkIntPlatStubsPtr->tkMacInstallMWConsole) /* 32 */
#endif
#ifndef TkMacInvalClipRgns
#define TkMacInvalClipRgns \
	(tkIntPlatStubsPtr->tkMacInvalClipRgns) /* 33 */
#endif
#ifndef TkMacDoHLEvent
#define TkMacDoHLEvent \
	(tkIntPlatStubsPtr->tkMacDoHLEvent) /* 34 */
#endif
#ifndef TkMacFontInfo
#define TkMacFontInfo \
	(tkIntPlatStubsPtr->tkMacFontInfo) /* 35 */
#endif
#ifndef TkMacGenerateTime
#define TkMacGenerateTime \
	(tkIntPlatStubsPtr->tkMacGenerateTime) /* 36 */
#endif
#ifndef TkMacGetDrawablePort
#define TkMacGetDrawablePort \
	(tkIntPlatStubsPtr->tkMacGetDrawablePort) /* 37 */
#endif
#ifndef TkMacGetScrollbarGrowWindow
#define TkMacGetScrollbarGrowWindow \
	(tkIntPlatStubsPtr->tkMacGetScrollbarGrowWindow) /* 38 */
#endif
#ifndef TkMacGetXWindow
#define TkMacGetXWindow \
	(tkIntPlatStubsPtr->tkMacGetXWindow) /* 39 */
#endif
#ifndef TkMacGrowToplevel
#define TkMacGrowToplevel \
	(tkIntPlatStubsPtr->tkMacGrowToplevel) /* 40 */
#endif
#ifndef TkMacHandleMenuSelect
#define TkMacHandleMenuSelect \
	(tkIntPlatStubsPtr->tkMacHandleMenuSelect) /* 41 */
#endif
#ifndef TkMacHaveAppearance
#define TkMacHaveAppearance \
	(tkIntPlatStubsPtr->tkMacHaveAppearance) /* 42 */
#endif
#ifndef TkMacInitAppleEvents
#define TkMacInitAppleEvents \
	(tkIntPlatStubsPtr->tkMacInitAppleEvents) /* 43 */
#endif
#ifndef TkMacInitMenus
#define TkMacInitMenus \
	(tkIntPlatStubsPtr->tkMacInitMenus) /* 44 */
#endif
#ifndef TkMacInvalidateWindow
#define TkMacInvalidateWindow \
	(tkIntPlatStubsPtr->tkMacInvalidateWindow) /* 45 */
#endif
#ifndef TkMacIsCharacterMissing
#define TkMacIsCharacterMissing \
	(tkIntPlatStubsPtr->tkMacIsCharacterMissing) /* 46 */
#endif
#ifndef TkMacMakeRealWindowExist
#define TkMacMakeRealWindowExist \
	(tkIntPlatStubsPtr->tkMacMakeRealWindowExist) /* 47 */
#endif
#ifndef TkMacMakeStippleMap
#define TkMacMakeStippleMap \
	(tkIntPlatStubsPtr->tkMacMakeStippleMap) /* 48 */
#endif
#ifndef TkMacMenuClick
#define TkMacMenuClick \
	(tkIntPlatStubsPtr->tkMacMenuClick) /* 49 */
#endif
#ifndef TkMacRegisterOffScreenWindow
#define TkMacRegisterOffScreenWindow \
	(tkIntPlatStubsPtr->tkMacRegisterOffScreenWindow) /* 50 */
#endif
#ifndef TkMacResizable
#define TkMacResizable \
	(tkIntPlatStubsPtr->tkMacResizable) /* 51 */
#endif
#ifndef TkMacSetEmbedRgn
#define TkMacSetEmbedRgn \
	(tkIntPlatStubsPtr->tkMacSetEmbedRgn) /* 52 */
#endif
#ifndef TkMacSetHelpMenuItemCount
#define TkMacSetHelpMenuItemCount \
	(tkIntPlatStubsPtr->tkMacSetHelpMenuItemCount) /* 53 */
#endif
#ifndef TkMacSetScrollbarGrow
#define TkMacSetScrollbarGrow \
	(tkIntPlatStubsPtr->tkMacSetScrollbarGrow) /* 54 */
#endif
#ifndef TkMacSetUpClippingRgn
#define TkMacSetUpClippingRgn \
	(tkIntPlatStubsPtr->tkMacSetUpClippingRgn) /* 55 */
#endif
#ifndef TkMacSetUpGraphicsPort
#define TkMacSetUpGraphicsPort \
	(tkIntPlatStubsPtr->tkMacSetUpGraphicsPort) /* 56 */
#endif
#ifndef TkMacUpdateClipRgn
#define TkMacUpdateClipRgn \
	(tkIntPlatStubsPtr->tkMacUpdateClipRgn) /* 57 */
#endif
#ifndef TkMacUnregisterMacWindow
#define TkMacUnregisterMacWindow \
	(tkIntPlatStubsPtr->tkMacUnregisterMacWindow) /* 58 */
#endif
#ifndef TkMacUseMenuID
#define TkMacUseMenuID \
	(tkIntPlatStubsPtr->tkMacUseMenuID) /* 59 */
#endif
#ifndef TkMacVisableClipRgn
#define TkMacVisableClipRgn \
	(tkIntPlatStubsPtr->tkMacVisableClipRgn) /* 60 */
#endif
#ifndef TkMacWinBounds
#define TkMacWinBounds \
	(tkIntPlatStubsPtr->tkMacWinBounds) /* 61 */
#endif
#ifndef TkMacWindowOffset
#define TkMacWindowOffset \
	(tkIntPlatStubsPtr->tkMacWindowOffset) /* 62 */
#endif
#ifndef TkResumeClipboard
#define TkResumeClipboard \
	(tkIntPlatStubsPtr->tkResumeClipboard) /* 63 */
#endif
#ifndef TkSetMacColor
#define TkSetMacColor \
	(tkIntPlatStubsPtr->tkSetMacColor) /* 64 */
#endif
#ifndef TkSetWMName
#define TkSetWMName \
	(tkIntPlatStubsPtr->tkSetWMName) /* 65 */
#endif
#ifndef TkSuspendClipboard
#define TkSuspendClipboard \
	(tkIntPlatStubsPtr->tkSuspendClipboard) /* 66 */
#endif
#ifndef TkWMGrowToplevel
#define TkWMGrowToplevel \
	(tkIntPlatStubsPtr->tkWMGrowToplevel) /* 67 */
#endif
#ifndef TkMacZoomToplevel
#define TkMacZoomToplevel \
	(tkIntPlatStubsPtr->tkMacZoomToplevel) /* 68 */
#endif
#ifndef Tk_TopCoordsToWindow
#define Tk_TopCoordsToWindow \
	(tkIntPlatStubsPtr->tk_TopCoordsToWindow) /* 69 */
#endif
#ifndef TkMacContainerId
#define TkMacContainerId \
	(tkIntPlatStubsPtr->tkMacContainerId) /* 70 */
#endif
#ifndef TkMacGetHostToplevel
#define TkMacGetHostToplevel \
	(tkIntPlatStubsPtr->tkMacGetHostToplevel) /* 71 */
#endif
#endif /* MAC_TCL */

#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TKINTPLATDECLS */

Added generic/tkIntXlibDecls.h.









































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
/*
 * tkIntXlibDecls.h --
 *
 *	This file contains the declarations for all platform dependent
 *	unsupported functions that are exported by the Tk library.  These
 *	interfaces are not guaranteed to remain the same between
 *	versions.  Use at your own risk.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * All rights reserved.
 *
 * RCS: @(#) $Id: tkIntXlibDecls.h,v 1.2.2.5 1999/04/06 02:48:28 redman Exp $
 */

#ifndef _TKINTXLIBDECLS
#define _TKINTXLIBDECLS

#include "X11/Xutil.h"

#ifdef BUILD_tk
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
 * script.  Any modifications to the function declarations below should be made
 * in the generic/tkInt.decls script.
 */

/* !BEGIN!: Do not edit below this line. */

/*
 * Exported function declarations:
 */

#ifdef __WIN32__
/* Slot 0 is reserved */
/* 1 */
EXTERN XModifierKeymap*	 XGetModifierMapping _ANSI_ARGS_((Display* d));
/* 2 */
EXTERN XImage *		XCreateImage _ANSI_ARGS_((Display* d, Visual* v, 
				unsigned int ui1, int i1, int i2, char* cp, 
				unsigned int ui2, unsigned int ui3, int i3, 
				int i4));
/* 3 */
EXTERN XImage *		XGetImage _ANSI_ARGS_((Display* d, Drawable dr, 
				int i1, int i2, unsigned int ui1, 
				unsigned int ui2, unsigned long ul, int i3));
/* 4 */
EXTERN char *		XGetAtomName _ANSI_ARGS_((Display* d, Atom a));
/* 5 */
EXTERN char *		XKeysymToString _ANSI_ARGS_((KeySym k));
/* 6 */
EXTERN Colormap		XCreateColormap _ANSI_ARGS_((Display* d, Window w, 
				Visual* v, int i));
/* 7 */
EXTERN Cursor		XCreatePixmapCursor _ANSI_ARGS_((Display* d, 
				Pixmap p1, Pixmap p2, XColor* x1, XColor* x2, 
				unsigned int ui1, unsigned int ui2));
/* 8 */
EXTERN Cursor		XCreateGlyphCursor _ANSI_ARGS_((Display* d, Font f1, 
				Font f2, unsigned int ui1, unsigned int ui2, 
				XColor* x1, XColor* x2));
/* 9 */
EXTERN GContext		XGContextFromGC _ANSI_ARGS_((GC g));
/* 10 */
EXTERN XHostAddress *	XListHosts _ANSI_ARGS_((Display* d, int* i, Bool* b));
/* 11 */
EXTERN KeySym		XKeycodeToKeysym _ANSI_ARGS_((Display* d, 
				unsigned int k, int i));
/* 12 */
EXTERN KeySym		XStringToKeysym _ANSI_ARGS_((_Xconst char* c));
/* 13 */
EXTERN Window		XRootWindow _ANSI_ARGS_((Display* d, int i));
/* 14 */
EXTERN XErrorHandler	XSetErrorHandler _ANSI_ARGS_((XErrorHandler x));
/* 15 */
EXTERN Status		XIconifyWindow _ANSI_ARGS_((Display* d, Window w, 
				int i));
/* 16 */
EXTERN Status		XWithdrawWindow _ANSI_ARGS_((Display* d, Window w, 
				int i));
/* 17 */
EXTERN Status		XGetWMColormapWindows _ANSI_ARGS_((Display* d, 
				Window w, Window** wpp, int* ip));
/* 18 */
EXTERN Status		XAllocColor _ANSI_ARGS_((Display* d, Colormap c, 
				XColor* xp));
/* 19 */
EXTERN void		XBell _ANSI_ARGS_((Display* d, int i));
/* 20 */
EXTERN void		XChangeProperty _ANSI_ARGS_((Display* d, Window w, 
				Atom a1, Atom a2, int i1, int i2, 
				_Xconst unsigned char* c, int i3));
/* 21 */
EXTERN void		XChangeWindowAttributes _ANSI_ARGS_((Display* d, 
				Window w, unsigned long ul, 
				XSetWindowAttributes* x));
/* 22 */
EXTERN void		XClearWindow _ANSI_ARGS_((Display* d, Window w));
/* 23 */
EXTERN void		XConfigureWindow _ANSI_ARGS_((Display* d, Window w, 
				unsigned int i, XWindowChanges* x));
/* 24 */
EXTERN void		XCopyArea _ANSI_ARGS_((Display* d, Drawable dr1, 
				Drawable dr2, GC g, int i1, int i2, 
				unsigned int ui1, unsigned int ui2, int i3, 
				int i4));
/* 25 */
EXTERN void		XCopyPlane _ANSI_ARGS_((Display* d, Drawable dr1, 
				Drawable dr2, GC g, int i1, int i2, 
				unsigned int ui1, unsigned int ui2, int i3, 
				int i4, unsigned long ul));
/* 26 */
EXTERN Pixmap		XCreateBitmapFromData _ANSI_ARGS_((Display* display, 
				Drawable d, _Xconst char* data, 
				unsigned int width, unsigned int height));
/* 27 */
EXTERN void		XDefineCursor _ANSI_ARGS_((Display* d, Window w, 
				Cursor c));
/* 28 */
EXTERN void		XDeleteProperty _ANSI_ARGS_((Display* d, Window w, 
				Atom a));
/* 29 */
EXTERN void		XDestroyWindow _ANSI_ARGS_((Display* d, Window w));
/* 30 */
EXTERN void		XDrawArc _ANSI_ARGS_((Display* d, Drawable dr, GC g, 
				int i1, int i2, unsigned int ui1, 
				unsigned int ui2, int i3, int i4));
/* 31 */
EXTERN void		XDrawLines _ANSI_ARGS_((Display* d, Drawable dr, 
				GC g, XPoint* x, int i1, int i2));
/* 32 */
EXTERN void		XDrawRectangle _ANSI_ARGS_((Display* d, Drawable dr, 
				GC g, int i1, int i2, unsigned int ui1, 
				unsigned int ui2));
/* 33 */
EXTERN void		XFillArc _ANSI_ARGS_((Display* d, Drawable dr, GC g, 
				int i1, int i2, unsigned int ui1, 
				unsigned int ui2, int i3, int i4));
/* 34 */
EXTERN void		XFillPolygon _ANSI_ARGS_((Display* d, Drawable dr, 
				GC g, XPoint* x, int i1, int i2, int i3));
/* 35 */
EXTERN void		XFillRectangles _ANSI_ARGS_((Display* d, Drawable dr, 
				GC g, XRectangle* x, int i));
/* 36 */
EXTERN void		XForceScreenSaver _ANSI_ARGS_((Display* d, int i));
/* 37 */
EXTERN void		XFreeColormap _ANSI_ARGS_((Display* d, Colormap c));
/* 38 */
EXTERN void		XFreeColors _ANSI_ARGS_((Display* d, Colormap c, 
				unsigned long* ulp, int i, unsigned long ul));
/* 39 */
EXTERN void		XFreeCursor _ANSI_ARGS_((Display* d, Cursor c));
/* 40 */
EXTERN void		XFreeModifiermap _ANSI_ARGS_((XModifierKeymap* x));
/* 41 */
EXTERN Status		XGetGeometry _ANSI_ARGS_((Display* d, Drawable dr, 
				Window* w, int* i1, int* i2, 
				unsigned int* ui1, unsigned int* ui2, 
				unsigned int* ui3, unsigned int* ui4));
/* 42 */
EXTERN void		XGetInputFocus _ANSI_ARGS_((Display* d, Window* w, 
				int* i));
/* 43 */
EXTERN int		XGetWindowProperty _ANSI_ARGS_((Display* d, Window w, 
				Atom a1, long l1, long l2, Bool b, Atom a2, 
				Atom* ap, int* ip, unsigned long* ulp1, 
				unsigned long* ulp2, unsigned char** cpp));
/* 44 */
EXTERN Status		XGetWindowAttributes _ANSI_ARGS_((Display* d, 
				Window w, XWindowAttributes* x));
/* 45 */
EXTERN int		XGrabKeyboard _ANSI_ARGS_((Display* d, Window w, 
				Bool b, int i1, int i2, Time t));
/* 46 */
EXTERN int		XGrabPointer _ANSI_ARGS_((Display* d, Window w1, 
				Bool b, unsigned int ui, int i1, int i2, 
				Window w2, Cursor c, Time t));
/* 47 */
EXTERN KeyCode		XKeysymToKeycode _ANSI_ARGS_((Display* d, KeySym k));
/* 48 */
EXTERN Status		XLookupColor _ANSI_ARGS_((Display* d, Colormap c1, 
				_Xconst char* c2, XColor* x1, XColor* x2));
/* 49 */
EXTERN void		XMapWindow _ANSI_ARGS_((Display* d, Window w));
/* 50 */
EXTERN void		XMoveResizeWindow _ANSI_ARGS_((Display* d, Window w, 
				int i1, int i2, unsigned int ui1, 
				unsigned int ui2));
/* 51 */
EXTERN void		XMoveWindow _ANSI_ARGS_((Display* d, Window w, 
				int i1, int i2));
/* 52 */
EXTERN void		XNextEvent _ANSI_ARGS_((Display* d, XEvent* x));
/* 53 */
EXTERN void		XPutBackEvent _ANSI_ARGS_((Display* d, XEvent* x));
/* 54 */
EXTERN void		XQueryColors _ANSI_ARGS_((Display* d, Colormap c, 
				XColor* x, int i));
/* 55 */
EXTERN Bool		XQueryPointer _ANSI_ARGS_((Display* d, Window w1, 
				Window* w2, Window* w3, int* i1, int* i2, 
				int* i3, int* i4, unsigned int* ui));
/* 56 */
EXTERN Status		XQueryTree _ANSI_ARGS_((Display* d, Window w1, 
				Window* w2, Window* w3, Window** w4, 
				unsigned int* ui));
/* 57 */
EXTERN void		XRaiseWindow _ANSI_ARGS_((Display* d, Window w));
/* 58 */
EXTERN void		XRefreshKeyboardMapping _ANSI_ARGS_((
				XMappingEvent* x));
/* 59 */
EXTERN void		XResizeWindow _ANSI_ARGS_((Display* d, Window w, 
				unsigned int ui1, unsigned int ui2));
/* 60 */
EXTERN void		XSelectInput _ANSI_ARGS_((Display* d, Window w, 
				long l));
/* 61 */
EXTERN Status		XSendEvent _ANSI_ARGS_((Display* d, Window w, Bool b, 
				long l, XEvent* x));
/* 62 */
EXTERN void		XSetCommand _ANSI_ARGS_((Display* d, Window w, 
				char** c, int i));
/* 63 */
EXTERN void		XSetIconName _ANSI_ARGS_((Display* d, Window w, 
				_Xconst char* c));
/* 64 */
EXTERN void		XSetInputFocus _ANSI_ARGS_((Display* d, Window w, 
				int i, Time t));
/* 65 */
EXTERN void		XSetSelectionOwner _ANSI_ARGS_((Display* d, Atom a, 
				Window w, Time t));
/* 66 */
EXTERN void		XSetWindowBackground _ANSI_ARGS_((Display* d, 
				Window w, unsigned long ul));
/* 67 */
EXTERN void		XSetWindowBackgroundPixmap _ANSI_ARGS_((Display* d, 
				Window w, Pixmap p));
/* 68 */
EXTERN void		XSetWindowBorder _ANSI_ARGS_((Display* d, Window w, 
				unsigned long ul));
/* 69 */
EXTERN void		XSetWindowBorderPixmap _ANSI_ARGS_((Display* d, 
				Window w, Pixmap p));
/* 70 */
EXTERN void		XSetWindowBorderWidth _ANSI_ARGS_((Display* d, 
				Window w, unsigned int ui));
/* 71 */
EXTERN void		XSetWindowColormap _ANSI_ARGS_((Display* d, Window w, 
				Colormap c));
/* 72 */
EXTERN Bool		XTranslateCoordinates _ANSI_ARGS_((Display* d, 
				Window w1, Window w2, int i1, int i2, 
				int* i3, int* i4, Window* w3));
/* 73 */
EXTERN void		XUngrabKeyboard _ANSI_ARGS_((Display* d, Time t));
/* 74 */
EXTERN void		XUngrabPointer _ANSI_ARGS_((Display* d, Time t));
/* 75 */
EXTERN void		XUnmapWindow _ANSI_ARGS_((Display* d, Window w));
/* 76 */
EXTERN void		XWindowEvent _ANSI_ARGS_((Display* d, Window w, 
				long l, XEvent* x));
/* 77 */
EXTERN void		XDestroyIC _ANSI_ARGS_((XIC x));
/* 78 */
EXTERN Bool		XFilterEvent _ANSI_ARGS_((XEvent* x, Window w));
/* 79 */
EXTERN int		XmbLookupString _ANSI_ARGS_((XIC xi, 
				XKeyPressedEvent* xk, char* c, int i, 
				KeySym* k, Status* s));
/* 80 */
EXTERN void		TkPutImage _ANSI_ARGS_((unsigned long * colors, 
				int ncolors, Display* display, Drawable d, 
				GC gc, XImage* image, int src_x, int src_y, 
				int dest_x, int dest_y, unsigned int width, 
				unsigned int height));
/* Slot 81 is reserved */
/* 82 */
EXTERN Status		XParseColor _ANSI_ARGS_((Display * display, 
				Colormap map, _Xconst char* spec, 
				XColor * colorPtr));
/* 83 */
EXTERN GC		XCreateGC _ANSI_ARGS_((Display* display, Drawable d, 
				unsigned long valuemask, XGCValues* values));
/* 84 */
EXTERN void		XFreeGC _ANSI_ARGS_((Display* display, GC gc));
/* 85 */
EXTERN Atom		XInternAtom _ANSI_ARGS_((Display* display, 
				_Xconst char* atom_name, Bool only_if_exists));
/* 86 */
EXTERN void		XSetBackground _ANSI_ARGS_((Display* display, GC gc, 
				unsigned long foreground));
/* 87 */
EXTERN void		XSetForeground _ANSI_ARGS_((Display* display, GC gc, 
				unsigned long foreground));
/* 88 */
EXTERN void		XSetClipMask _ANSI_ARGS_((Display* display, GC gc, 
				Pixmap pixmap));
/* 89 */
EXTERN void		XSetClipOrigin _ANSI_ARGS_((Display* display, GC gc, 
				int clip_x_origin, int clip_y_origin));
/* 90 */
EXTERN void		XSetTSOrigin _ANSI_ARGS_((Display* display, GC gc, 
				int ts_x_origin, int ts_y_origin));
/* 91 */
EXTERN void		XChangeGC _ANSI_ARGS_((Display * d, GC gc, 
				unsigned long mask, XGCValues * values));
/* 92 */
EXTERN void		XSetFont _ANSI_ARGS_((Display * display, GC gc, 
				Font font));
/* 93 */
EXTERN void		XSetArcMode _ANSI_ARGS_((Display * display, GC gc, 
				int arc_mode));
/* 94 */
EXTERN void		XSetStipple _ANSI_ARGS_((Display * display, GC gc, 
				Pixmap stipple));
/* 95 */
EXTERN void		XSetFillRule _ANSI_ARGS_((Display * display, GC gc, 
				int fill_rule));
/* 96 */
EXTERN void		XSetFillStyle _ANSI_ARGS_((Display * display, GC gc, 
				int fill_style));
/* 97 */
EXTERN void		XSetFunction _ANSI_ARGS_((Display * display, GC gc, 
				int function));
/* 98 */
EXTERN void		XSetLineAttributes _ANSI_ARGS_((Display * display, 
				GC gc, unsigned int line_width, 
				int line_style, int cap_style, 
				int join_style));
/* 99 */
EXTERN int		_XInitImageFuncPtrs _ANSI_ARGS_((XImage * image));
/* 100 */
EXTERN XIC		XCreateIC _ANSI_ARGS_((void));
/* 101 */
EXTERN XVisualInfo *	XGetVisualInfo _ANSI_ARGS_((Display* display, 
				long vinfo_mask, XVisualInfo* vinfo_template, 
				int* nitems_return));
/* 102 */
EXTERN void		XSetWMClientMachine _ANSI_ARGS_((Display* display, 
				Window w, XTextProperty* text_prop));
/* 103 */
EXTERN Status		XStringListToTextProperty _ANSI_ARGS_((char** list, 
				int count, XTextProperty* text_prop_return));
#endif /* __WIN32__ */
#ifdef MAC_TCL
/* Slot 0 is reserved */
/* 1 */
EXTERN XModifierKeymap*	 XGetModifierMapping _ANSI_ARGS_((Display* d));
/* 2 */
EXTERN XImage *		XCreateImage _ANSI_ARGS_((Display* d, Visual* v, 
				unsigned int ui1, int i1, int i2, char* cp, 
				unsigned int ui2, unsigned int ui3, int i3, 
				int i4));
/* 3 */
EXTERN XImage *		XGetImage _ANSI_ARGS_((Display* d, Drawable dr, 
				int i1, int i2, unsigned int ui1, 
				unsigned int ui2, unsigned long ul, int i3));
/* 4 */
EXTERN char *		XGetAtomName _ANSI_ARGS_((Display* d, Atom a));
/* 5 */
EXTERN char *		XKeysymToString _ANSI_ARGS_((KeySym k));
/* 6 */
EXTERN Colormap		XCreateColormap _ANSI_ARGS_((Display* d, Window w, 
				Visual* v, int i));
/* 7 */
EXTERN GContext		XGContextFromGC _ANSI_ARGS_((GC g));
/* 8 */
EXTERN KeySym		XKeycodeToKeysym _ANSI_ARGS_((Display* d, KeyCode k, 
				int i));
/* 9 */
EXTERN KeySym		XStringToKeysym _ANSI_ARGS_((_Xconst char* c));
/* 10 */
EXTERN Window		XRootWindow _ANSI_ARGS_((Display* d, int i));
/* 11 */
EXTERN XErrorHandler	XSetErrorHandler _ANSI_ARGS_((XErrorHandler x));
/* 12 */
EXTERN Status		XAllocColor _ANSI_ARGS_((Display* d, Colormap c, 
				XColor* xp));
/* 13 */
EXTERN void		XBell _ANSI_ARGS_((Display* d, int i));
/* 14 */
EXTERN void		XChangeProperty _ANSI_ARGS_((Display* d, Window w, 
				Atom a, Atom a, int i1, int i2, 
				_Xconst unsigned char* c, int i3));
/* 15 */
EXTERN void		XChangeWindowAttributes _ANSI_ARGS_((Display* d, 
				Window w, unsigned long ul, 
				XSetWindowAttributes* x));
/* 16 */
EXTERN void		XConfigureWindow _ANSI_ARGS_((Display* d, Window w, 
				unsigned int i, XWindowChanges* x));
/* 17 */
EXTERN void		XCopyArea _ANSI_ARGS_((Display* d, Drawable dr1, 
				Drawable dr2, GC g, int i1, int i2, 
				unsigned int ui1, unsigned int ui2, int i3, 
				int i4));
/* 18 */
EXTERN void		XCopyPlane _ANSI_ARGS_((Display* d, Drawable dr1, 
				Drawable dr2, GC g, int i1, int i2, 
				unsigned int ui1, unsigned int ui2, int i3, 
				int i4, unsigned long ul));
/* 19 */
EXTERN Pixmap		XCreateBitmapFromData _ANSI_ARGS_((Display* display, 
				Drawable d, _Xconst char* data, 
				unsigned int width, unsigned int height));
/* 20 */
EXTERN void		XDefineCursor _ANSI_ARGS_((Display* d, Window w, 
				Cursor c));
/* 21 */
EXTERN void		XDestroyWindow _ANSI_ARGS_((Display* d, Window w));
/* 22 */
EXTERN void		XDrawArc _ANSI_ARGS_((Display* d, Drawable dr, GC g, 
				int i1, int i2, unsigned int ui1, 
				unsigned int ui2, int i3, int i4));
/* 23 */
EXTERN void		XDrawLines _ANSI_ARGS_((Display* d, Drawable dr, 
				GC g, XPoint* x, int i1, int i2));
/* 24 */
EXTERN void		XDrawRectangle _ANSI_ARGS_((Display* d, Drawable dr, 
				GC g, int i1, int i2, unsigned int ui1, 
				unsigned int ui2));
/* 25 */
EXTERN void		XFillArc _ANSI_ARGS_((Display* d, Drawable dr, GC g, 
				int i1, int i2, unsigned int ui1, 
				unsigned int ui2, int i3, int i4));
/* 26 */
EXTERN void		XFillPolygon _ANSI_ARGS_((Display* d, Drawable dr, 
				GC g, XPoint* x, int i1, int i2, int i3));
/* 27 */
EXTERN void		XFillRectangles _ANSI_ARGS_((Display* d, Drawable dr, 
				GC g, XRectangle* x, int i));
/* 28 */
EXTERN void		XFreeColormap _ANSI_ARGS_((Display* d, Colormap c));
/* 29 */
EXTERN void		XFreeColors _ANSI_ARGS_((Display* d, Colormap c, 
				unsigned long* ulp, int i, unsigned long ul));
/* 30 */
EXTERN void		XFreeModifiermap _ANSI_ARGS_((XModifierKeymap* x));
/* 31 */
EXTERN Status		XGetGeometry _ANSI_ARGS_((Display* d, Drawable dr, 
				Window* w, int* i1, int* i2, 
				unsigned int* ui1, unsigned int* ui2, 
				unsigned int* ui3, unsigned int* ui4));
/* 32 */
EXTERN int		XGetWindowProperty _ANSI_ARGS_((Display* d, Window w, 
				Atom a1, long l1, long l2, Bool b, Atom a2, 
				Atom* ap, int* ip, unsigned long* ulp1, 
				unsigned long* ulp2, unsigned char** cpp));
/* 33 */
EXTERN int		XGrabKeyboard _ANSI_ARGS_((Display* d, Window w, 
				Bool b, int i1, int i2, Time t));
/* 34 */
EXTERN int		XGrabPointer _ANSI_ARGS_((Display* d, Window w1, 
				Bool b, unsigned int ui, int i1, int i2, 
				Window w2, Cursor c, Time t));
/* 35 */
EXTERN KeyCode		XKeysymToKeycode _ANSI_ARGS_((Display* d, KeySym k));
/* 36 */
EXTERN void		XMapWindow _ANSI_ARGS_((Display* d, Window w));
/* 37 */
EXTERN void		XMoveResizeWindow _ANSI_ARGS_((Display* d, Window w, 
				int i1, int i2, unsigned int ui1, 
				unsigned int ui2));
/* 38 */
EXTERN void		XMoveWindow _ANSI_ARGS_((Display* d, Window w, 
				int i1, int i2));
/* 39 */
EXTERN Bool		XQueryPointer _ANSI_ARGS_((Display* d, Window w1, 
				Window* w2, Window* w3, int* i1, int* i2, 
				int* i3, int* i4, unsigned int* ui));
/* 40 */
EXTERN void		XRaiseWindow _ANSI_ARGS_((Display* d, Window w));
/* 41 */
EXTERN void		XRefreshKeyboardMapping _ANSI_ARGS_((
				XMappingEvent* x));
/* 42 */
EXTERN void		XResizeWindow _ANSI_ARGS_((Display* d, Window w, 
				unsigned int ui1, unsigned int ui2));
/* 43 */
EXTERN void		XSelectInput _ANSI_ARGS_((Display* d, Window w, 
				long l));
/* 44 */
EXTERN Status		XSendEvent _ANSI_ARGS_((Display* d, Window w, Bool b, 
				long l, XEvent* x));
/* 45 */
EXTERN void		XSetIconName _ANSI_ARGS_((Display* d, Window w, 
				_Xconst char* c));
/* 46 */
EXTERN void		XSetInputFocus _ANSI_ARGS_((Display* d, Window w, 
				int i, Time t));
/* 47 */
EXTERN void		XSetSelectionOwner _ANSI_ARGS_((Display* d, Atom a, 
				Window w, Time t));
/* 48 */
EXTERN void		XSetWindowBackground _ANSI_ARGS_((Display* d, 
				Window w, unsigned long ul));
/* 49 */
EXTERN void		XSetWindowBackgroundPixmap _ANSI_ARGS_((Display* d, 
				Window w, Pixmap p));
/* 50 */
EXTERN void		XSetWindowBorder _ANSI_ARGS_((Display* d, Window w, 
				unsigned long ul));
/* 51 */
EXTERN void		XSetWindowBorderPixmap _ANSI_ARGS_((Display* d, 
				Window w, Pixmap p));
/* 52 */
EXTERN void		XSetWindowBorderWidth _ANSI_ARGS_((Display* d, 
				Window w, unsigned int ui));
/* 53 */
EXTERN void		XSetWindowColormap _ANSI_ARGS_((Display* d, Window w, 
				Colormap c));
/* 54 */
EXTERN void		XUngrabKeyboard _ANSI_ARGS_((Display* d, Time t));
/* 55 */
EXTERN void		XUngrabPointer _ANSI_ARGS_((Display* d, Time t));
/* 56 */
EXTERN void		XUnmapWindow _ANSI_ARGS_((Display* d, Window w));
/* 57 */
EXTERN void		TkPutImage _ANSI_ARGS_((unsigned long * colors, 
				int ncolors, Display* display, Drawable d, 
				GC gc, XImage* image, int src_x, int src_y, 
				int dest_x, int dest_y, unsigned int width, 
				unsigned int height));
/* 58 */
EXTERN Status		XParseColor _ANSI_ARGS_((Display * display, 
				Colormap map, _Xconst char* spec, 
				XColor * colorPtr));
/* 59 */
EXTERN GC		XCreateGC _ANSI_ARGS_((Display* display, Drawable d, 
				unsigned long valuemask, XGCValues* values));
/* 60 */
EXTERN void		XFreeGC _ANSI_ARGS_((Display* display, GC gc));
/* 61 */
EXTERN Atom		XInternAtom _ANSI_ARGS_((Display* display, 
				_Xconst char* atom_name, Bool only_if_exists));
/* 62 */
EXTERN void		XSetBackground _ANSI_ARGS_((Display* display, GC gc, 
				unsigned long foreground));
/* 63 */
EXTERN void		XSetForeground _ANSI_ARGS_((Display* display, GC gc, 
				unsigned long foreground));
/* 64 */
EXTERN void		XSetClipMask _ANSI_ARGS_((Display* display, GC gc, 
				Pixmap pixmap));
/* 65 */
EXTERN void		XSetClipOrigin _ANSI_ARGS_((Display* display, GC gc, 
				int clip_x_origin, int clip_y_origin));
/* 66 */
EXTERN void		XSetTSOrigin _ANSI_ARGS_((Display* display, GC gc, 
				int ts_x_origin, int ts_y_origin));
/* 67 */
EXTERN void		XChangeGC _ANSI_ARGS_((Display * d, GC gc, 
				unsigned long mask, XGCValues * values));
/* 68 */
EXTERN void		XSetFont _ANSI_ARGS_((Display * display, GC gc, 
				Font font));
/* 69 */
EXTERN void		XSetArcMode _ANSI_ARGS_((Display * display, GC gc, 
				int arc_mode));
/* 70 */
EXTERN void		XSetStipple _ANSI_ARGS_((Display * display, GC gc, 
				Pixmap stipple));
/* 71 */
EXTERN void		XSetFillRule _ANSI_ARGS_((Display * display, GC gc, 
				int fill_rule));
/* 72 */
EXTERN void		XSetFillStyle _ANSI_ARGS_((Display * display, GC gc, 
				int fill_style));
/* 73 */
EXTERN void		XSetFunction _ANSI_ARGS_((Display * display, GC gc, 
				int function));
/* 74 */
EXTERN void		XSetLineAttributes _ANSI_ARGS_((Display * display, 
				GC gc, unsigned int line_width, 
				int line_style, int cap_style, 
				int join_style));
/* 75 */
EXTERN int		_XInitImageFuncPtrs _ANSI_ARGS_((XImage * image));
/* 76 */
EXTERN XIC		XCreateIC _ANSI_ARGS_((void));
/* 77 */
EXTERN XVisualInfo *	XGetVisualInfo _ANSI_ARGS_((Display* display, 
				long vinfo_mask, XVisualInfo* vinfo_template, 
				int* nitems_return));
/* 78 */
EXTERN void		XSetWMClientMachine _ANSI_ARGS_((Display* display, 
				Window w, XTextProperty* text_prop));
/* 79 */
EXTERN Status		XStringListToTextProperty _ANSI_ARGS_((char** list, 
				int count, XTextProperty* text_prop_return));
#endif /* MAC_TCL */

typedef struct TkIntXlibStubs {
    int magic;
    struct TkIntXlibStubHooks *hooks;

#ifdef __WIN32__
    void *reserved0;
    XModifierKeymap* (*xGetModifierMapping) _ANSI_ARGS_((Display* d)); /* 1 */
    XImage * (*xCreateImage) _ANSI_ARGS_((Display* d, Visual* v, unsigned int ui1, int i1, int i2, char* cp, unsigned int ui2, unsigned int ui3, int i3, int i4)); /* 2 */
    XImage * (*xGetImage) _ANSI_ARGS_((Display* d, Drawable dr, int i1, int i2, unsigned int ui1, unsigned int ui2, unsigned long ul, int i3)); /* 3 */
    char * (*xGetAtomName) _ANSI_ARGS_((Display* d, Atom a)); /* 4 */
    char * (*xKeysymToString) _ANSI_ARGS_((KeySym k)); /* 5 */
    Colormap (*xCreateColormap) _ANSI_ARGS_((Display* d, Window w, Visual* v, int i)); /* 6 */
    Cursor (*xCreatePixmapCursor) _ANSI_ARGS_((Display* d, Pixmap p1, Pixmap p2, XColor* x1, XColor* x2, unsigned int ui1, unsigned int ui2)); /* 7 */
    Cursor (*xCreateGlyphCursor) _ANSI_ARGS_((Display* d, Font f1, Font f2, unsigned int ui1, unsigned int ui2, XColor* x1, XColor* x2)); /* 8 */
    GContext (*xGContextFromGC) _ANSI_ARGS_((GC g)); /* 9 */
    XHostAddress * (*xListHosts) _ANSI_ARGS_((Display* d, int* i, Bool* b)); /* 10 */
    KeySym (*xKeycodeToKeysym) _ANSI_ARGS_((Display* d, unsigned int k, int i)); /* 11 */
    KeySym (*xStringToKeysym) _ANSI_ARGS_((_Xconst char* c)); /* 12 */
    Window (*xRootWindow) _ANSI_ARGS_((Display* d, int i)); /* 13 */
    XErrorHandler (*xSetErrorHandler) _ANSI_ARGS_((XErrorHandler x)); /* 14 */
    Status (*xIconifyWindow) _ANSI_ARGS_((Display* d, Window w, int i)); /* 15 */
    Status (*xWithdrawWindow) _ANSI_ARGS_((Display* d, Window w, int i)); /* 16 */
    Status (*xGetWMColormapWindows) _ANSI_ARGS_((Display* d, Window w, Window** wpp, int* ip)); /* 17 */
    Status (*xAllocColor) _ANSI_ARGS_((Display* d, Colormap c, XColor* xp)); /* 18 */
    void (*xBell) _ANSI_ARGS_((Display* d, int i)); /* 19 */
    void (*xChangeProperty) _ANSI_ARGS_((Display* d, Window w, Atom a1, Atom a2, int i1, int i2, _Xconst unsigned char* c, int i3)); /* 20 */
    void (*xChangeWindowAttributes) _ANSI_ARGS_((Display* d, Window w, unsigned long ul, XSetWindowAttributes* x)); /* 21 */
    void (*xClearWindow) _ANSI_ARGS_((Display* d, Window w)); /* 22 */
    void (*xConfigureWindow) _ANSI_ARGS_((Display* d, Window w, unsigned int i, XWindowChanges* x)); /* 23 */
    void (*xCopyArea) _ANSI_ARGS_((Display* d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 24 */
    void (*xCopyPlane) _ANSI_ARGS_((Display* d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4, unsigned long ul)); /* 25 */
    Pixmap (*xCreateBitmapFromData) _ANSI_ARGS_((Display* display, Drawable d, _Xconst char* data, unsigned int width, unsigned int height)); /* 26 */
    void (*xDefineCursor) _ANSI_ARGS_((Display* d, Window w, Cursor c)); /* 27 */
    void (*xDeleteProperty) _ANSI_ARGS_((Display* d, Window w, Atom a)); /* 28 */
    void (*xDestroyWindow) _ANSI_ARGS_((Display* d, Window w)); /* 29 */
    void (*xDrawArc) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 30 */
    void (*xDrawLines) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2)); /* 31 */
    void (*xDrawRectangle) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2)); /* 32 */
    void (*xFillArc) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 33 */
    void (*xFillPolygon) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2, int i3)); /* 34 */
    void (*xFillRectangles) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XRectangle* x, int i)); /* 35 */
    void (*xForceScreenSaver) _ANSI_ARGS_((Display* d, int i)); /* 36 */
    void (*xFreeColormap) _ANSI_ARGS_((Display* d, Colormap c)); /* 37 */
    void (*xFreeColors) _ANSI_ARGS_((Display* d, Colormap c, unsigned long* ulp, int i, unsigned long ul)); /* 38 */
    void (*xFreeCursor) _ANSI_ARGS_((Display* d, Cursor c)); /* 39 */
    void (*xFreeModifiermap) _ANSI_ARGS_((XModifierKeymap* x)); /* 40 */
    Status (*xGetGeometry) _ANSI_ARGS_((Display* d, Drawable dr, Window* w, int* i1, int* i2, unsigned int* ui1, unsigned int* ui2, unsigned int* ui3, unsigned int* ui4)); /* 41 */
    void (*xGetInputFocus) _ANSI_ARGS_((Display* d, Window* w, int* i)); /* 42 */
    int (*xGetWindowProperty) _ANSI_ARGS_((Display* d, Window w, Atom a1, long l1, long l2, Bool b, Atom a2, Atom* ap, int* ip, unsigned long* ulp1, unsigned long* ulp2, unsigned char** cpp)); /* 43 */
    Status (*xGetWindowAttributes) _ANSI_ARGS_((Display* d, Window w, XWindowAttributes* x)); /* 44 */
    int (*xGrabKeyboard) _ANSI_ARGS_((Display* d, Window w, Bool b, int i1, int i2, Time t)); /* 45 */
    int (*xGrabPointer) _ANSI_ARGS_((Display* d, Window w1, Bool b, unsigned int ui, int i1, int i2, Window w2, Cursor c, Time t)); /* 46 */
    KeyCode (*xKeysymToKeycode) _ANSI_ARGS_((Display* d, KeySym k)); /* 47 */
    Status (*xLookupColor) _ANSI_ARGS_((Display* d, Colormap c1, _Xconst char* c2, XColor* x1, XColor* x2)); /* 48 */
    void (*xMapWindow) _ANSI_ARGS_((Display* d, Window w)); /* 49 */
    void (*xMoveResizeWindow) _ANSI_ARGS_((Display* d, Window w, int i1, int i2, unsigned int ui1, unsigned int ui2)); /* 50 */
    void (*xMoveWindow) _ANSI_ARGS_((Display* d, Window w, int i1, int i2)); /* 51 */
    void (*xNextEvent) _ANSI_ARGS_((Display* d, XEvent* x)); /* 52 */
    void (*xPutBackEvent) _ANSI_ARGS_((Display* d, XEvent* x)); /* 53 */
    void (*xQueryColors) _ANSI_ARGS_((Display* d, Colormap c, XColor* x, int i)); /* 54 */
    Bool (*xQueryPointer) _ANSI_ARGS_((Display* d, Window w1, Window* w2, Window* w3, int* i1, int* i2, int* i3, int* i4, unsigned int* ui)); /* 55 */
    Status (*xQueryTree) _ANSI_ARGS_((Display* d, Window w1, Window* w2, Window* w3, Window** w4, unsigned int* ui)); /* 56 */
    void (*xRaiseWindow) _ANSI_ARGS_((Display* d, Window w)); /* 57 */
    void (*xRefreshKeyboardMapping) _ANSI_ARGS_((XMappingEvent* x)); /* 58 */
    void (*xResizeWindow) _ANSI_ARGS_((Display* d, Window w, unsigned int ui1, unsigned int ui2)); /* 59 */
    void (*xSelectInput) _ANSI_ARGS_((Display* d, Window w, long l)); /* 60 */
    Status (*xSendEvent) _ANSI_ARGS_((Display* d, Window w, Bool b, long l, XEvent* x)); /* 61 */
    void (*xSetCommand) _ANSI_ARGS_((Display* d, Window w, char** c, int i)); /* 62 */
    void (*xSetIconName) _ANSI_ARGS_((Display* d, Window w, _Xconst char* c)); /* 63 */
    void (*xSetInputFocus) _ANSI_ARGS_((Display* d, Window w, int i, Time t)); /* 64 */
    void (*xSetSelectionOwner) _ANSI_ARGS_((Display* d, Atom a, Window w, Time t)); /* 65 */
    void (*xSetWindowBackground) _ANSI_ARGS_((Display* d, Window w, unsigned long ul)); /* 66 */
    void (*xSetWindowBackgroundPixmap) _ANSI_ARGS_((Display* d, Window w, Pixmap p)); /* 67 */
    void (*xSetWindowBorder) _ANSI_ARGS_((Display* d, Window w, unsigned long ul)); /* 68 */
    void (*xSetWindowBorderPixmap) _ANSI_ARGS_((Display* d, Window w, Pixmap p)); /* 69 */
    void (*xSetWindowBorderWidth) _ANSI_ARGS_((Display* d, Window w, unsigned int ui)); /* 70 */
    void (*xSetWindowColormap) _ANSI_ARGS_((Display* d, Window w, Colormap c)); /* 71 */
    Bool (*xTranslateCoordinates) _ANSI_ARGS_((Display* d, Window w1, Window w2, int i1, int i2, int* i3, int* i4, Window* w3)); /* 72 */
    void (*xUngrabKeyboard) _ANSI_ARGS_((Display* d, Time t)); /* 73 */
    void (*xUngrabPointer) _ANSI_ARGS_((Display* d, Time t)); /* 74 */
    void (*xUnmapWindow) _ANSI_ARGS_((Display* d, Window w)); /* 75 */
    void (*xWindowEvent) _ANSI_ARGS_((Display* d, Window w, long l, XEvent* x)); /* 76 */
    void (*xDestroyIC) _ANSI_ARGS_((XIC x)); /* 77 */
    Bool (*xFilterEvent) _ANSI_ARGS_((XEvent* x, Window w)); /* 78 */
    int (*xmbLookupString) _ANSI_ARGS_((XIC xi, XKeyPressedEvent* xk, char* c, int i, KeySym* k, Status* s)); /* 79 */
    void (*tkPutImage) _ANSI_ARGS_((unsigned long * colors, int ncolors, Display* display, Drawable d, GC gc, XImage* image, int src_x, int src_y, int dest_x, int dest_y, unsigned int width, unsigned int height)); /* 80 */
    void *reserved81;
    Status (*xParseColor) _ANSI_ARGS_((Display * display, Colormap map, _Xconst char* spec, XColor * colorPtr)); /* 82 */
    GC (*xCreateGC) _ANSI_ARGS_((Display* display, Drawable d, unsigned long valuemask, XGCValues* values)); /* 83 */
    void (*xFreeGC) _ANSI_ARGS_((Display* display, GC gc)); /* 84 */
    Atom (*xInternAtom) _ANSI_ARGS_((Display* display, _Xconst char* atom_name, Bool only_if_exists)); /* 85 */
    void (*xSetBackground) _ANSI_ARGS_((Display* display, GC gc, unsigned long foreground)); /* 86 */
    void (*xSetForeground) _ANSI_ARGS_((Display* display, GC gc, unsigned long foreground)); /* 87 */
    void (*xSetClipMask) _ANSI_ARGS_((Display* display, GC gc, Pixmap pixmap)); /* 88 */
    void (*xSetClipOrigin) _ANSI_ARGS_((Display* display, GC gc, int clip_x_origin, int clip_y_origin)); /* 89 */
    void (*xSetTSOrigin) _ANSI_ARGS_((Display* display, GC gc, int ts_x_origin, int ts_y_origin)); /* 90 */
    void (*xChangeGC) _ANSI_ARGS_((Display * d, GC gc, unsigned long mask, XGCValues * values)); /* 91 */
    void (*xSetFont) _ANSI_ARGS_((Display * display, GC gc, Font font)); /* 92 */
    void (*xSetArcMode) _ANSI_ARGS_((Display * display, GC gc, int arc_mode)); /* 93 */
    void (*xSetStipple) _ANSI_ARGS_((Display * display, GC gc, Pixmap stipple)); /* 94 */
    void (*xSetFillRule) _ANSI_ARGS_((Display * display, GC gc, int fill_rule)); /* 95 */
    void (*xSetFillStyle) _ANSI_ARGS_((Display * display, GC gc, int fill_style)); /* 96 */
    void (*xSetFunction) _ANSI_ARGS_((Display * display, GC gc, int function)); /* 97 */
    void (*xSetLineAttributes) _ANSI_ARGS_((Display * display, GC gc, unsigned int line_width, int line_style, int cap_style, int join_style)); /* 98 */
    int (*_XInitImageFuncPtrs) _ANSI_ARGS_((XImage * image)); /* 99 */
    XIC (*xCreateIC) _ANSI_ARGS_((void)); /* 100 */
    XVisualInfo * (*xGetVisualInfo) _ANSI_ARGS_((Display* display, long vinfo_mask, XVisualInfo* vinfo_template, int* nitems_return)); /* 101 */
    void (*xSetWMClientMachine) _ANSI_ARGS_((Display* display, Window w, XTextProperty* text_prop)); /* 102 */
    Status (*xStringListToTextProperty) _ANSI_ARGS_((char** list, int count, XTextProperty* text_prop_return)); /* 103 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    void *reserved0;
    XModifierKeymap* (*xGetModifierMapping) _ANSI_ARGS_((Display* d)); /* 1 */
    XImage * (*xCreateImage) _ANSI_ARGS_((Display* d, Visual* v, unsigned int ui1, int i1, int i2, char* cp, unsigned int ui2, unsigned int ui3, int i3, int i4)); /* 2 */
    XImage * (*xGetImage) _ANSI_ARGS_((Display* d, Drawable dr, int i1, int i2, unsigned int ui1, unsigned int ui2, unsigned long ul, int i3)); /* 3 */
    char * (*xGetAtomName) _ANSI_ARGS_((Display* d, Atom a)); /* 4 */
    char * (*xKeysymToString) _ANSI_ARGS_((KeySym k)); /* 5 */
    Colormap (*xCreateColormap) _ANSI_ARGS_((Display* d, Window w, Visual* v, int i)); /* 6 */
    GContext (*xGContextFromGC) _ANSI_ARGS_((GC g)); /* 7 */
    KeySym (*xKeycodeToKeysym) _ANSI_ARGS_((Display* d, KeyCode k, int i)); /* 8 */
    KeySym (*xStringToKeysym) _ANSI_ARGS_((_Xconst char* c)); /* 9 */
    Window (*xRootWindow) _ANSI_ARGS_((Display* d, int i)); /* 10 */
    XErrorHandler (*xSetErrorHandler) _ANSI_ARGS_((XErrorHandler x)); /* 11 */
    Status (*xAllocColor) _ANSI_ARGS_((Display* d, Colormap c, XColor* xp)); /* 12 */
    void (*xBell) _ANSI_ARGS_((Display* d, int i)); /* 13 */
    void (*xChangeProperty) _ANSI_ARGS_((Display* d, Window w, Atom a, Atom a, int i1, int i2, _Xconst unsigned char* c, int i3)); /* 14 */
    void (*xChangeWindowAttributes) _ANSI_ARGS_((Display* d, Window w, unsigned long ul, XSetWindowAttributes* x)); /* 15 */
    void (*xConfigureWindow) _ANSI_ARGS_((Display* d, Window w, unsigned int i, XWindowChanges* x)); /* 16 */
    void (*xCopyArea) _ANSI_ARGS_((Display* d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 17 */
    void (*xCopyPlane) _ANSI_ARGS_((Display* d, Drawable dr1, Drawable dr2, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4, unsigned long ul)); /* 18 */
    Pixmap (*xCreateBitmapFromData) _ANSI_ARGS_((Display* display, Drawable d, _Xconst char* data, unsigned int width, unsigned int height)); /* 19 */
    void (*xDefineCursor) _ANSI_ARGS_((Display* d, Window w, Cursor c)); /* 20 */
    void (*xDestroyWindow) _ANSI_ARGS_((Display* d, Window w)); /* 21 */
    void (*xDrawArc) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 22 */
    void (*xDrawLines) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2)); /* 23 */
    void (*xDrawRectangle) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2)); /* 24 */
    void (*xFillArc) _ANSI_ARGS_((Display* d, Drawable dr, GC g, int i1, int i2, unsigned int ui1, unsigned int ui2, int i3, int i4)); /* 25 */
    void (*xFillPolygon) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2, int i3)); /* 26 */
    void (*xFillRectangles) _ANSI_ARGS_((Display* d, Drawable dr, GC g, XRectangle* x, int i)); /* 27 */
    void (*xFreeColormap) _ANSI_ARGS_((Display* d, Colormap c)); /* 28 */
    void (*xFreeColors) _ANSI_ARGS_((Display* d, Colormap c, unsigned long* ulp, int i, unsigned long ul)); /* 29 */
    void (*xFreeModifiermap) _ANSI_ARGS_((XModifierKeymap* x)); /* 30 */
    Status (*xGetGeometry) _ANSI_ARGS_((Display* d, Drawable dr, Window* w, int* i1, int* i2, unsigned int* ui1, unsigned int* ui2, unsigned int* ui3, unsigned int* ui4)); /* 31 */
    int (*xGetWindowProperty) _ANSI_ARGS_((Display* d, Window w, Atom a1, long l1, long l2, Bool b, Atom a2, Atom* ap, int* ip, unsigned long* ulp1, unsigned long* ulp2, unsigned char** cpp)); /* 32 */
    int (*xGrabKeyboard) _ANSI_ARGS_((Display* d, Window w, Bool b, int i1, int i2, Time t)); /* 33 */
    int (*xGrabPointer) _ANSI_ARGS_((Display* d, Window w1, Bool b, unsigned int ui, int i1, int i2, Window w2, Cursor c, Time t)); /* 34 */
    KeyCode (*xKeysymToKeycode) _ANSI_ARGS_((Display* d, KeySym k)); /* 35 */
    void (*xMapWindow) _ANSI_ARGS_((Display* d, Window w)); /* 36 */
    void (*xMoveResizeWindow) _ANSI_ARGS_((Display* d, Window w, int i1, int i2, unsigned int ui1, unsigned int ui2)); /* 37 */
    void (*xMoveWindow) _ANSI_ARGS_((Display* d, Window w, int i1, int i2)); /* 38 */
    Bool (*xQueryPointer) _ANSI_ARGS_((Display* d, Window w1, Window* w2, Window* w3, int* i1, int* i2, int* i3, int* i4, unsigned int* ui)); /* 39 */
    void (*xRaiseWindow) _ANSI_ARGS_((Display* d, Window w)); /* 40 */
    void (*xRefreshKeyboardMapping) _ANSI_ARGS_((XMappingEvent* x)); /* 41 */
    void (*xResizeWindow) _ANSI_ARGS_((Display* d, Window w, unsigned int ui1, unsigned int ui2)); /* 42 */
    void (*xSelectInput) _ANSI_ARGS_((Display* d, Window w, long l)); /* 43 */
    Status (*xSendEvent) _ANSI_ARGS_((Display* d, Window w, Bool b, long l, XEvent* x)); /* 44 */
    void (*xSetIconName) _ANSI_ARGS_((Display* d, Window w, _Xconst char* c)); /* 45 */
    void (*xSetInputFocus) _ANSI_ARGS_((Display* d, Window w, int i, Time t)); /* 46 */
    void (*xSetSelectionOwner) _ANSI_ARGS_((Display* d, Atom a, Window w, Time t)); /* 47 */
    void (*xSetWindowBackground) _ANSI_ARGS_((Display* d, Window w, unsigned long ul)); /* 48 */
    void (*xSetWindowBackgroundPixmap) _ANSI_ARGS_((Display* d, Window w, Pixmap p)); /* 49 */
    void (*xSetWindowBorder) _ANSI_ARGS_((Display* d, Window w, unsigned long ul)); /* 50 */
    void (*xSetWindowBorderPixmap) _ANSI_ARGS_((Display* d, Window w, Pixmap p)); /* 51 */
    void (*xSetWindowBorderWidth) _ANSI_ARGS_((Display* d, Window w, unsigned int ui)); /* 52 */
    void (*xSetWindowColormap) _ANSI_ARGS_((Display* d, Window w, Colormap c)); /* 53 */
    void (*xUngrabKeyboard) _ANSI_ARGS_((Display* d, Time t)); /* 54 */
    void (*xUngrabPointer) _ANSI_ARGS_((Display* d, Time t)); /* 55 */
    void (*xUnmapWindow) _ANSI_ARGS_((Display* d, Window w)); /* 56 */
    void (*tkPutImage) _ANSI_ARGS_((unsigned long * colors, int ncolors, Display* display, Drawable d, GC gc, XImage* image, int src_x, int src_y, int dest_x, int dest_y, unsigned int width, unsigned int height)); /* 57 */
    Status (*xParseColor) _ANSI_ARGS_((Display * display, Colormap map, _Xconst char* spec, XColor * colorPtr)); /* 58 */
    GC (*xCreateGC) _ANSI_ARGS_((Display* display, Drawable d, unsigned long valuemask, XGCValues* values)); /* 59 */
    void (*xFreeGC) _ANSI_ARGS_((Display* display, GC gc)); /* 60 */
    Atom (*xInternAtom) _ANSI_ARGS_((Display* display, _Xconst char* atom_name, Bool only_if_exists)); /* 61 */
    void (*xSetBackground) _ANSI_ARGS_((Display* display, GC gc, unsigned long foreground)); /* 62 */
    void (*xSetForeground) _ANSI_ARGS_((Display* display, GC gc, unsigned long foreground)); /* 63 */
    void (*xSetClipMask) _ANSI_ARGS_((Display* display, GC gc, Pixmap pixmap)); /* 64 */
    void (*xSetClipOrigin) _ANSI_ARGS_((Display* display, GC gc, int clip_x_origin, int clip_y_origin)); /* 65 */
    void (*xSetTSOrigin) _ANSI_ARGS_((Display* display, GC gc, int ts_x_origin, int ts_y_origin)); /* 66 */
    void (*xChangeGC) _ANSI_ARGS_((Display * d, GC gc, unsigned long mask, XGCValues * values)); /* 67 */
    void (*xSetFont) _ANSI_ARGS_((Display * display, GC gc, Font font)); /* 68 */
    void (*xSetArcMode) _ANSI_ARGS_((Display * display, GC gc, int arc_mode)); /* 69 */
    void (*xSetStipple) _ANSI_ARGS_((Display * display, GC gc, Pixmap stipple)); /* 70 */
    void (*xSetFillRule) _ANSI_ARGS_((Display * display, GC gc, int fill_rule)); /* 71 */
    void (*xSetFillStyle) _ANSI_ARGS_((Display * display, GC gc, int fill_style)); /* 72 */
    void (*xSetFunction) _ANSI_ARGS_((Display * display, GC gc, int function)); /* 73 */
    void (*xSetLineAttributes) _ANSI_ARGS_((Display * display, GC gc, unsigned int line_width, int line_style, int cap_style, int join_style)); /* 74 */
    int (*_XInitImageFuncPtrs) _ANSI_ARGS_((XImage * image)); /* 75 */
    XIC (*xCreateIC) _ANSI_ARGS_((void)); /* 76 */
    XVisualInfo * (*xGetVisualInfo) _ANSI_ARGS_((Display* display, long vinfo_mask, XVisualInfo* vinfo_template, int* nitems_return)); /* 77 */
    void (*xSetWMClientMachine) _ANSI_ARGS_((Display* display, Window w, XTextProperty* text_prop)); /* 78 */
    Status (*xStringListToTextProperty) _ANSI_ARGS_((char** list, int count, XTextProperty* text_prop_return)); /* 79 */
#endif /* MAC_TCL */
} TkIntXlibStubs;

extern TkIntXlibStubs *tkIntXlibStubsPtr;

#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS)

/*
 * Inline function declarations:
 */

#ifdef __WIN32__
/* Slot 0 is reserved */
#ifndef XGetModifierMapping
#define XGetModifierMapping \
	(tkIntXlibStubsPtr->xGetModifierMapping) /* 1 */
#endif
#ifndef XCreateImage
#define XCreateImage \
	(tkIntXlibStubsPtr->xCreateImage) /* 2 */
#endif
#ifndef XGetImage
#define XGetImage \
	(tkIntXlibStubsPtr->xGetImage) /* 3 */
#endif
#ifndef XGetAtomName
#define XGetAtomName \
	(tkIntXlibStubsPtr->xGetAtomName) /* 4 */
#endif
#ifndef XKeysymToString
#define XKeysymToString \
	(tkIntXlibStubsPtr->xKeysymToString) /* 5 */
#endif
#ifndef XCreateColormap
#define XCreateColormap \
	(tkIntXlibStubsPtr->xCreateColormap) /* 6 */
#endif
#ifndef XCreatePixmapCursor
#define XCreatePixmapCursor \
	(tkIntXlibStubsPtr->xCreatePixmapCursor) /* 7 */
#endif
#ifndef XCreateGlyphCursor
#define XCreateGlyphCursor \
	(tkIntXlibStubsPtr->xCreateGlyphCursor) /* 8 */
#endif
#ifndef XGContextFromGC
#define XGContextFromGC \
	(tkIntXlibStubsPtr->xGContextFromGC) /* 9 */
#endif
#ifndef XListHosts
#define XListHosts \
	(tkIntXlibStubsPtr->xListHosts) /* 10 */
#endif
#ifndef XKeycodeToKeysym
#define XKeycodeToKeysym \
	(tkIntXlibStubsPtr->xKeycodeToKeysym) /* 11 */
#endif
#ifndef XStringToKeysym
#define XStringToKeysym \
	(tkIntXlibStubsPtr->xStringToKeysym) /* 12 */
#endif
#ifndef XRootWindow
#define XRootWindow \
	(tkIntXlibStubsPtr->xRootWindow) /* 13 */
#endif
#ifndef XSetErrorHandler
#define XSetErrorHandler \
	(tkIntXlibStubsPtr->xSetErrorHandler) /* 14 */
#endif
#ifndef XIconifyWindow
#define XIconifyWindow \
	(tkIntXlibStubsPtr->xIconifyWindow) /* 15 */
#endif
#ifndef XWithdrawWindow
#define XWithdrawWindow \
	(tkIntXlibStubsPtr->xWithdrawWindow) /* 16 */
#endif
#ifndef XGetWMColormapWindows
#define XGetWMColormapWindows \
	(tkIntXlibStubsPtr->xGetWMColormapWindows) /* 17 */
#endif
#ifndef XAllocColor
#define XAllocColor \
	(tkIntXlibStubsPtr->xAllocColor) /* 18 */
#endif
#ifndef XBell
#define XBell \
	(tkIntXlibStubsPtr->xBell) /* 19 */
#endif
#ifndef XChangeProperty
#define XChangeProperty \
	(tkIntXlibStubsPtr->xChangeProperty) /* 20 */
#endif
#ifndef XChangeWindowAttributes
#define XChangeWindowAttributes \
	(tkIntXlibStubsPtr->xChangeWindowAttributes) /* 21 */
#endif
#ifndef XClearWindow
#define XClearWindow \
	(tkIntXlibStubsPtr->xClearWindow) /* 22 */
#endif
#ifndef XConfigureWindow
#define XConfigureWindow \
	(tkIntXlibStubsPtr->xConfigureWindow) /* 23 */
#endif
#ifndef XCopyArea
#define XCopyArea \
	(tkIntXlibStubsPtr->xCopyArea) /* 24 */
#endif
#ifndef XCopyPlane
#define XCopyPlane \
	(tkIntXlibStubsPtr->xCopyPlane) /* 25 */
#endif
#ifndef XCreateBitmapFromData
#define XCreateBitmapFromData \
	(tkIntXlibStubsPtr->xCreateBitmapFromData) /* 26 */
#endif
#ifndef XDefineCursor
#define XDefineCursor \
	(tkIntXlibStubsPtr->xDefineCursor) /* 27 */
#endif
#ifndef XDeleteProperty
#define XDeleteProperty \
	(tkIntXlibStubsPtr->xDeleteProperty) /* 28 */
#endif
#ifndef XDestroyWindow
#define XDestroyWindow \
	(tkIntXlibStubsPtr->xDestroyWindow) /* 29 */
#endif
#ifndef XDrawArc
#define XDrawArc \
	(tkIntXlibStubsPtr->xDrawArc) /* 30 */
#endif
#ifndef XDrawLines
#define XDrawLines \
	(tkIntXlibStubsPtr->xDrawLines) /* 31 */
#endif
#ifndef XDrawRectangle
#define XDrawRectangle \
	(tkIntXlibStubsPtr->xDrawRectangle) /* 32 */
#endif
#ifndef XFillArc
#define XFillArc \
	(tkIntXlibStubsPtr->xFillArc) /* 33 */
#endif
#ifndef XFillPolygon
#define XFillPolygon \
	(tkIntXlibStubsPtr->xFillPolygon) /* 34 */
#endif
#ifndef XFillRectangles
#define XFillRectangles \
	(tkIntXlibStubsPtr->xFillRectangles) /* 35 */
#endif
#ifndef XForceScreenSaver
#define XForceScreenSaver \
	(tkIntXlibStubsPtr->xForceScreenSaver) /* 36 */
#endif
#ifndef XFreeColormap
#define XFreeColormap \
	(tkIntXlibStubsPtr->xFreeColormap) /* 37 */
#endif
#ifndef XFreeColors
#define XFreeColors \
	(tkIntXlibStubsPtr->xFreeColors) /* 38 */
#endif
#ifndef XFreeCursor
#define XFreeCursor \
	(tkIntXlibStubsPtr->xFreeCursor) /* 39 */
#endif
#ifndef XFreeModifiermap
#define XFreeModifiermap \
	(tkIntXlibStubsPtr->xFreeModifiermap) /* 40 */
#endif
#ifndef XGetGeometry
#define XGetGeometry \
	(tkIntXlibStubsPtr->xGetGeometry) /* 41 */
#endif
#ifndef XGetInputFocus
#define XGetInputFocus \
	(tkIntXlibStubsPtr->xGetInputFocus) /* 42 */
#endif
#ifndef XGetWindowProperty
#define XGetWindowProperty \
	(tkIntXlibStubsPtr->xGetWindowProperty) /* 43 */
#endif
#ifndef XGetWindowAttributes
#define XGetWindowAttributes \
	(tkIntXlibStubsPtr->xGetWindowAttributes) /* 44 */
#endif
#ifndef XGrabKeyboard
#define XGrabKeyboard \
	(tkIntXlibStubsPtr->xGrabKeyboard) /* 45 */
#endif
#ifndef XGrabPointer
#define XGrabPointer \
	(tkIntXlibStubsPtr->xGrabPointer) /* 46 */
#endif
#ifndef XKeysymToKeycode
#define XKeysymToKeycode \
	(tkIntXlibStubsPtr->xKeysymToKeycode) /* 47 */
#endif
#ifndef XLookupColor
#define XLookupColor \
	(tkIntXlibStubsPtr->xLookupColor) /* 48 */
#endif
#ifndef XMapWindow
#define XMapWindow \
	(tkIntXlibStubsPtr->xMapWindow) /* 49 */
#endif
#ifndef XMoveResizeWindow
#define XMoveResizeWindow \
	(tkIntXlibStubsPtr->xMoveResizeWindow) /* 50 */
#endif
#ifndef XMoveWindow
#define XMoveWindow \
	(tkIntXlibStubsPtr->xMoveWindow) /* 51 */
#endif
#ifndef XNextEvent
#define XNextEvent \
	(tkIntXlibStubsPtr->xNextEvent) /* 52 */
#endif
#ifndef XPutBackEvent
#define XPutBackEvent \
	(tkIntXlibStubsPtr->xPutBackEvent) /* 53 */
#endif
#ifndef XQueryColors
#define XQueryColors \
	(tkIntXlibStubsPtr->xQueryColors) /* 54 */
#endif
#ifndef XQueryPointer
#define XQueryPointer \
	(tkIntXlibStubsPtr->xQueryPointer) /* 55 */
#endif
#ifndef XQueryTree
#define XQueryTree \
	(tkIntXlibStubsPtr->xQueryTree) /* 56 */
#endif
#ifndef XRaiseWindow
#define XRaiseWindow \
	(tkIntXlibStubsPtr->xRaiseWindow) /* 57 */
#endif
#ifndef XRefreshKeyboardMapping
#define XRefreshKeyboardMapping \
	(tkIntXlibStubsPtr->xRefreshKeyboardMapping) /* 58 */
#endif
#ifndef XResizeWindow
#define XResizeWindow \
	(tkIntXlibStubsPtr->xResizeWindow) /* 59 */
#endif
#ifndef XSelectInput
#define XSelectInput \
	(tkIntXlibStubsPtr->xSelectInput) /* 60 */
#endif
#ifndef XSendEvent
#define XSendEvent \
	(tkIntXlibStubsPtr->xSendEvent) /* 61 */
#endif
#ifndef XSetCommand
#define XSetCommand \
	(tkIntXlibStubsPtr->xSetCommand) /* 62 */
#endif
#ifndef XSetIconName
#define XSetIconName \
	(tkIntXlibStubsPtr->xSetIconName) /* 63 */
#endif
#ifndef XSetInputFocus
#define XSetInputFocus \
	(tkIntXlibStubsPtr->xSetInputFocus) /* 64 */
#endif
#ifndef XSetSelectionOwner
#define XSetSelectionOwner \
	(tkIntXlibStubsPtr->xSetSelectionOwner) /* 65 */
#endif
#ifndef XSetWindowBackground
#define XSetWindowBackground \
	(tkIntXlibStubsPtr->xSetWindowBackground) /* 66 */
#endif
#ifndef XSetWindowBackgroundPixmap
#define XSetWindowBackgroundPixmap \
	(tkIntXlibStubsPtr->xSetWindowBackgroundPixmap) /* 67 */
#endif
#ifndef XSetWindowBorder
#define XSetWindowBorder \
	(tkIntXlibStubsPtr->xSetWindowBorder) /* 68 */
#endif
#ifndef XSetWindowBorderPixmap
#define XSetWindowBorderPixmap \
	(tkIntXlibStubsPtr->xSetWindowBorderPixmap) /* 69 */
#endif
#ifndef XSetWindowBorderWidth
#define XSetWindowBorderWidth \
	(tkIntXlibStubsPtr->xSetWindowBorderWidth) /* 70 */
#endif
#ifndef XSetWindowColormap
#define XSetWindowColormap \
	(tkIntXlibStubsPtr->xSetWindowColormap) /* 71 */
#endif
#ifndef XTranslateCoordinates
#define XTranslateCoordinates \
	(tkIntXlibStubsPtr->xTranslateCoordinates) /* 72 */
#endif
#ifndef XUngrabKeyboard
#define XUngrabKeyboard \
	(tkIntXlibStubsPtr->xUngrabKeyboard) /* 73 */
#endif
#ifndef XUngrabPointer
#define XUngrabPointer \
	(tkIntXlibStubsPtr->xUngrabPointer) /* 74 */
#endif
#ifndef XUnmapWindow
#define XUnmapWindow \
	(tkIntXlibStubsPtr->xUnmapWindow) /* 75 */
#endif
#ifndef XWindowEvent
#define XWindowEvent \
	(tkIntXlibStubsPtr->xWindowEvent) /* 76 */
#endif
#ifndef XDestroyIC
#define XDestroyIC \
	(tkIntXlibStubsPtr->xDestroyIC) /* 77 */
#endif
#ifndef XFilterEvent
#define XFilterEvent \
	(tkIntXlibStubsPtr->xFilterEvent) /* 78 */
#endif
#ifndef XmbLookupString
#define XmbLookupString \
	(tkIntXlibStubsPtr->xmbLookupString) /* 79 */
#endif
#ifndef TkPutImage
#define TkPutImage \
	(tkIntXlibStubsPtr->tkPutImage) /* 80 */
#endif
/* Slot 81 is reserved */
#ifndef XParseColor
#define XParseColor \
	(tkIntXlibStubsPtr->xParseColor) /* 82 */
#endif
#ifndef XCreateGC
#define XCreateGC \
	(tkIntXlibStubsPtr->xCreateGC) /* 83 */
#endif
#ifndef XFreeGC
#define XFreeGC \
	(tkIntXlibStubsPtr->xFreeGC) /* 84 */
#endif
#ifndef XInternAtom
#define XInternAtom \
	(tkIntXlibStubsPtr->xInternAtom) /* 85 */
#endif
#ifndef XSetBackground
#define XSetBackground \
	(tkIntXlibStubsPtr->xSetBackground) /* 86 */
#endif
#ifndef XSetForeground
#define XSetForeground \
	(tkIntXlibStubsPtr->xSetForeground) /* 87 */
#endif
#ifndef XSetClipMask
#define XSetClipMask \
	(tkIntXlibStubsPtr->xSetClipMask) /* 88 */
#endif
#ifndef XSetClipOrigin
#define XSetClipOrigin \
	(tkIntXlibStubsPtr->xSetClipOrigin) /* 89 */
#endif
#ifndef XSetTSOrigin
#define XSetTSOrigin \
	(tkIntXlibStubsPtr->xSetTSOrigin) /* 90 */
#endif
#ifndef XChangeGC
#define XChangeGC \
	(tkIntXlibStubsPtr->xChangeGC) /* 91 */
#endif
#ifndef XSetFont
#define XSetFont \
	(tkIntXlibStubsPtr->xSetFont) /* 92 */
#endif
#ifndef XSetArcMode
#define XSetArcMode \
	(tkIntXlibStubsPtr->xSetArcMode) /* 93 */
#endif
#ifndef XSetStipple
#define XSetStipple \
	(tkIntXlibStubsPtr->xSetStipple) /* 94 */
#endif
#ifndef XSetFillRule
#define XSetFillRule \
	(tkIntXlibStubsPtr->xSetFillRule) /* 95 */
#endif
#ifndef XSetFillStyle
#define XSetFillStyle \
	(tkIntXlibStubsPtr->xSetFillStyle) /* 96 */
#endif
#ifndef XSetFunction
#define XSetFunction \
	(tkIntXlibStubsPtr->xSetFunction) /* 97 */
#endif
#ifndef XSetLineAttributes
#define XSetLineAttributes \
	(tkIntXlibStubsPtr->xSetLineAttributes) /* 98 */
#endif
#ifndef _XInitImageFuncPtrs
#define _XInitImageFuncPtrs \
	(tkIntXlibStubsPtr->_XInitImageFuncPtrs) /* 99 */
#endif
#ifndef XCreateIC
#define XCreateIC \
	(tkIntXlibStubsPtr->xCreateIC) /* 100 */
#endif
#ifndef XGetVisualInfo
#define XGetVisualInfo \
	(tkIntXlibStubsPtr->xGetVisualInfo) /* 101 */
#endif
#ifndef XSetWMClientMachine
#define XSetWMClientMachine \
	(tkIntXlibStubsPtr->xSetWMClientMachine) /* 102 */
#endif
#ifndef XStringListToTextProperty
#define XStringListToTextProperty \
	(tkIntXlibStubsPtr->xStringListToTextProperty) /* 103 */
#endif
#endif /* __WIN32__ */
#ifdef MAC_TCL
/* Slot 0 is reserved */
#ifndef XGetModifierMapping
#define XGetModifierMapping \
	(tkIntXlibStubsPtr->xGetModifierMapping) /* 1 */
#endif
#ifndef XCreateImage
#define XCreateImage \
	(tkIntXlibStubsPtr->xCreateImage) /* 2 */
#endif
#ifndef XGetImage
#define XGetImage \
	(tkIntXlibStubsPtr->xGetImage) /* 3 */
#endif
#ifndef XGetAtomName
#define XGetAtomName \
	(tkIntXlibStubsPtr->xGetAtomName) /* 4 */
#endif
#ifndef XKeysymToString
#define XKeysymToString \
	(tkIntXlibStubsPtr->xKeysymToString) /* 5 */
#endif
#ifndef XCreateColormap
#define XCreateColormap \
	(tkIntXlibStubsPtr->xCreateColormap) /* 6 */
#endif
#ifndef XGContextFromGC
#define XGContextFromGC \
	(tkIntXlibStubsPtr->xGContextFromGC) /* 7 */
#endif
#ifndef XKeycodeToKeysym
#define XKeycodeToKeysym \
	(tkIntXlibStubsPtr->xKeycodeToKeysym) /* 8 */
#endif
#ifndef XStringToKeysym
#define XStringToKeysym \
	(tkIntXlibStubsPtr->xStringToKeysym) /* 9 */
#endif
#ifndef XRootWindow
#define XRootWindow \
	(tkIntXlibStubsPtr->xRootWindow) /* 10 */
#endif
#ifndef XSetErrorHandler
#define XSetErrorHandler \
	(tkIntXlibStubsPtr->xSetErrorHandler) /* 11 */
#endif
#ifndef XAllocColor
#define XAllocColor \
	(tkIntXlibStubsPtr->xAllocColor) /* 12 */
#endif
#ifndef XBell
#define XBell \
	(tkIntXlibStubsPtr->xBell) /* 13 */
#endif
#ifndef XChangeProperty
#define XChangeProperty \
	(tkIntXlibStubsPtr->xChangeProperty) /* 14 */
#endif
#ifndef XChangeWindowAttributes
#define XChangeWindowAttributes \
	(tkIntXlibStubsPtr->xChangeWindowAttributes) /* 15 */
#endif
#ifndef XConfigureWindow
#define XConfigureWindow \
	(tkIntXlibStubsPtr->xConfigureWindow) /* 16 */
#endif
#ifndef XCopyArea
#define XCopyArea \
	(tkIntXlibStubsPtr->xCopyArea) /* 17 */
#endif
#ifndef XCopyPlane
#define XCopyPlane \
	(tkIntXlibStubsPtr->xCopyPlane) /* 18 */
#endif
#ifndef XCreateBitmapFromData
#define XCreateBitmapFromData \
	(tkIntXlibStubsPtr->xCreateBitmapFromData) /* 19 */
#endif
#ifndef XDefineCursor
#define XDefineCursor \
	(tkIntXlibStubsPtr->xDefineCursor) /* 20 */
#endif
#ifndef XDestroyWindow
#define XDestroyWindow \
	(tkIntXlibStubsPtr->xDestroyWindow) /* 21 */
#endif
#ifndef XDrawArc
#define XDrawArc \
	(tkIntXlibStubsPtr->xDrawArc) /* 22 */
#endif
#ifndef XDrawLines
#define XDrawLines \
	(tkIntXlibStubsPtr->xDrawLines) /* 23 */
#endif
#ifndef XDrawRectangle
#define XDrawRectangle \
	(tkIntXlibStubsPtr->xDrawRectangle) /* 24 */
#endif
#ifndef XFillArc
#define XFillArc \
	(tkIntXlibStubsPtr->xFillArc) /* 25 */
#endif
#ifndef XFillPolygon
#define XFillPolygon \
	(tkIntXlibStubsPtr->xFillPolygon) /* 26 */
#endif
#ifndef XFillRectangles
#define XFillRectangles \
	(tkIntXlibStubsPtr->xFillRectangles) /* 27 */
#endif
#ifndef XFreeColormap
#define XFreeColormap \
	(tkIntXlibStubsPtr->xFreeColormap) /* 28 */
#endif
#ifndef XFreeColors
#define XFreeColors \
	(tkIntXlibStubsPtr->xFreeColors) /* 29 */
#endif
#ifndef XFreeModifiermap
#define XFreeModifiermap \
	(tkIntXlibStubsPtr->xFreeModifiermap) /* 30 */
#endif
#ifndef XGetGeometry
#define XGetGeometry \
	(tkIntXlibStubsPtr->xGetGeometry) /* 31 */
#endif
#ifndef XGetWindowProperty
#define XGetWindowProperty \
	(tkIntXlibStubsPtr->xGetWindowProperty) /* 32 */
#endif
#ifndef XGrabKeyboard
#define XGrabKeyboard \
	(tkIntXlibStubsPtr->xGrabKeyboard) /* 33 */
#endif
#ifndef XGrabPointer
#define XGrabPointer \
	(tkIntXlibStubsPtr->xGrabPointer) /* 34 */
#endif
#ifndef XKeysymToKeycode
#define XKeysymToKeycode \
	(tkIntXlibStubsPtr->xKeysymToKeycode) /* 35 */
#endif
#ifndef XMapWindow
#define XMapWindow \
	(tkIntXlibStubsPtr->xMapWindow) /* 36 */
#endif
#ifndef XMoveResizeWindow
#define XMoveResizeWindow \
	(tkIntXlibStubsPtr->xMoveResizeWindow) /* 37 */
#endif
#ifndef XMoveWindow
#define XMoveWindow \
	(tkIntXlibStubsPtr->xMoveWindow) /* 38 */
#endif
#ifndef XQueryPointer
#define XQueryPointer \
	(tkIntXlibStubsPtr->xQueryPointer) /* 39 */
#endif
#ifndef XRaiseWindow
#define XRaiseWindow \
	(tkIntXlibStubsPtr->xRaiseWindow) /* 40 */
#endif
#ifndef XRefreshKeyboardMapping
#define XRefreshKeyboardMapping \
	(tkIntXlibStubsPtr->xRefreshKeyboardMapping) /* 41 */
#endif
#ifndef XResizeWindow
#define XResizeWindow \
	(tkIntXlibStubsPtr->xResizeWindow) /* 42 */
#endif
#ifndef XSelectInput
#define XSelectInput \
	(tkIntXlibStubsPtr->xSelectInput) /* 43 */
#endif
#ifndef XSendEvent
#define XSendEvent \
	(tkIntXlibStubsPtr->xSendEvent) /* 44 */
#endif
#ifndef XSetIconName
#define XSetIconName \
	(tkIntXlibStubsPtr->xSetIconName) /* 45 */
#endif
#ifndef XSetInputFocus
#define XSetInputFocus \
	(tkIntXlibStubsPtr->xSetInputFocus) /* 46 */
#endif
#ifndef XSetSelectionOwner
#define XSetSelectionOwner \
	(tkIntXlibStubsPtr->xSetSelectionOwner) /* 47 */
#endif
#ifndef XSetWindowBackground
#define XSetWindowBackground \
	(tkIntXlibStubsPtr->xSetWindowBackground) /* 48 */
#endif
#ifndef XSetWindowBackgroundPixmap
#define XSetWindowBackgroundPixmap \
	(tkIntXlibStubsPtr->xSetWindowBackgroundPixmap) /* 49 */
#endif
#ifndef XSetWindowBorder
#define XSetWindowBorder \
	(tkIntXlibStubsPtr->xSetWindowBorder) /* 50 */
#endif
#ifndef XSetWindowBorderPixmap
#define XSetWindowBorderPixmap \
	(tkIntXlibStubsPtr->xSetWindowBorderPixmap) /* 51 */
#endif
#ifndef XSetWindowBorderWidth
#define XSetWindowBorderWidth \
	(tkIntXlibStubsPtr->xSetWindowBorderWidth) /* 52 */
#endif
#ifndef XSetWindowColormap
#define XSetWindowColormap \
	(tkIntXlibStubsPtr->xSetWindowColormap) /* 53 */
#endif
#ifndef XUngrabKeyboard
#define XUngrabKeyboard \
	(tkIntXlibStubsPtr->xUngrabKeyboard) /* 54 */
#endif
#ifndef XUngrabPointer
#define XUngrabPointer \
	(tkIntXlibStubsPtr->xUngrabPointer) /* 55 */
#endif
#ifndef XUnmapWindow
#define XUnmapWindow \
	(tkIntXlibStubsPtr->xUnmapWindow) /* 56 */
#endif
#ifndef TkPutImage
#define TkPutImage \
	(tkIntXlibStubsPtr->tkPutImage) /* 57 */
#endif
#ifndef XParseColor
#define XParseColor \
	(tkIntXlibStubsPtr->xParseColor) /* 58 */
#endif
#ifndef XCreateGC
#define XCreateGC \
	(tkIntXlibStubsPtr->xCreateGC) /* 59 */
#endif
#ifndef XFreeGC
#define XFreeGC \
	(tkIntXlibStubsPtr->xFreeGC) /* 60 */
#endif
#ifndef XInternAtom
#define XInternAtom \
	(tkIntXlibStubsPtr->xInternAtom) /* 61 */
#endif
#ifndef XSetBackground
#define XSetBackground \
	(tkIntXlibStubsPtr->xSetBackground) /* 62 */
#endif
#ifndef XSetForeground
#define XSetForeground \
	(tkIntXlibStubsPtr->xSetForeground) /* 63 */
#endif
#ifndef XSetClipMask
#define XSetClipMask \
	(tkIntXlibStubsPtr->xSetClipMask) /* 64 */
#endif
#ifndef XSetClipOrigin
#define XSetClipOrigin \
	(tkIntXlibStubsPtr->xSetClipOrigin) /* 65 */
#endif
#ifndef XSetTSOrigin
#define XSetTSOrigin \
	(tkIntXlibStubsPtr->xSetTSOrigin) /* 66 */
#endif
#ifndef XChangeGC
#define XChangeGC \
	(tkIntXlibStubsPtr->xChangeGC) /* 67 */
#endif
#ifndef XSetFont
#define XSetFont \
	(tkIntXlibStubsPtr->xSetFont) /* 68 */
#endif
#ifndef XSetArcMode
#define XSetArcMode \
	(tkIntXlibStubsPtr->xSetArcMode) /* 69 */
#endif
#ifndef XSetStipple
#define XSetStipple \
	(tkIntXlibStubsPtr->xSetStipple) /* 70 */
#endif
#ifndef XSetFillRule
#define XSetFillRule \
	(tkIntXlibStubsPtr->xSetFillRule) /* 71 */
#endif
#ifndef XSetFillStyle
#define XSetFillStyle \
	(tkIntXlibStubsPtr->xSetFillStyle) /* 72 */
#endif
#ifndef XSetFunction
#define XSetFunction \
	(tkIntXlibStubsPtr->xSetFunction) /* 73 */
#endif
#ifndef XSetLineAttributes
#define XSetLineAttributes \
	(tkIntXlibStubsPtr->xSetLineAttributes) /* 74 */
#endif
#ifndef _XInitImageFuncPtrs
#define _XInitImageFuncPtrs \
	(tkIntXlibStubsPtr->_XInitImageFuncPtrs) /* 75 */
#endif
#ifndef XCreateIC
#define XCreateIC \
	(tkIntXlibStubsPtr->xCreateIC) /* 76 */
#endif
#ifndef XGetVisualInfo
#define XGetVisualInfo \
	(tkIntXlibStubsPtr->xGetVisualInfo) /* 77 */
#endif
#ifndef XSetWMClientMachine
#define XSetWMClientMachine \
	(tkIntXlibStubsPtr->xSetWMClientMachine) /* 78 */
#endif
#ifndef XStringListToTextProperty
#define XStringListToTextProperty \
	(tkIntXlibStubsPtr->xStringListToTextProperty) /* 79 */
#endif
#endif /* MAC_TCL */

#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TKINTXLIBDECLS */

Changes to generic/tkListbox.c.

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
/* 
 * tkListbox.c --
 *
 *	This module implements listbox widgets for the Tk
 *	toolkit.  A listbox displays a collection of strings,
 *	one per line, and provides scrolling and selection.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkListbox.c 1.120 97/10/29 13:06:59
 */

#include "tkPort.h"
#include "default.h"
#include "tkInt.h"

/*
 * One record of the following type is kept for each element
 * associated with a listbox widget:
 */

typedef struct Element {
    int textLength;		/* # non-NULL characters in text. */
    int lBearing;		/* Distance from first character's
				 * origin to left edge of character. */
    int pixelWidth;		/* Total width of element in pixels (including
				 * left bearing and right bearing). */
    int selected;		/* 1 means this item is selected, 0 means
				 * it isn't. */
    struct Element *nextPtr;	/* Next in list of all elements of this













|












|







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
/* 
 * tkListbox.c --
 *
 *	This module implements listbox widgets for the Tk
 *	toolkit.  A listbox displays a collection of strings,
 *	one per line, and provides scrolling and selection.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkListbox.c,v 1.1.4.3 1999/03/30 04:12:57 stanton Exp $
 */

#include "tkPort.h"
#include "default.h"
#include "tkInt.h"

/*
 * One record of the following type is kept for each element
 * associated with a listbox widget:
 */

typedef struct Element {
    int textLength;		/* # non-NULL bytes in text string. */
    int lBearing;		/* Distance from first character's
				 * origin to left edge of character. */
    int pixelWidth;		/* Total width of element in pixels (including
				 * left bearing and right bearing). */
    int selected;		/* 1 means this item is selected, 0 means
				 * it isn't. */
    struct Element *nextPtr;	/* Next in list of all elements of this
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
	    ListboxEventProc, (ClientData) listPtr);
    Tk_CreateSelHandler(listPtr->tkwin, XA_PRIMARY, XA_STRING,
	    ListboxFetchSelection, (ClientData) listPtr, XA_STRING);
    if (ConfigureListbox(interp, listPtr, argc-2, argv+2, 0) != TCL_OK) {
	goto error;
    }

    interp->result = Tk_PathName(listPtr->tkwin);
    return TCL_OK;

    error:
    Tk_DestroyWindow(listPtr->tkwin);
    return TCL_ERROR;
}








|







424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
	    ListboxEventProc, (ClientData) listPtr);
    Tk_CreateSelHandler(listPtr->tkwin, XA_PRIMARY, XA_STRING,
	    ListboxFetchSelection, (ClientData) listPtr, XA_STRING);
    if (ConfigureListbox(interp, listPtr, argc-2, argv+2, 0) != TCL_OK) {
	goto error;
    }

    Tcl_SetResult(interp, Tk_PathName(listPtr->tkwin), TCL_STATIC);
    return TCL_OK;

    error:
    Tk_DestroyWindow(listPtr->tkwin);
    return TCL_ERROR;
}

514
515
516
517
518
519
520


521
522
523
524
525
526
527
528
529
530
531
532
533
	for (i = 0, elPtr = listPtr->firstPtr; i < index;
		i++, elPtr = elPtr->nextPtr) {
	    /* Empty loop body. */
	}
	if ((index >= listPtr->topIndex) && (index < listPtr->numElements)
		    && (index < (listPtr->topIndex + listPtr->fullLines
		    + listPtr->partialLine))) {


	    x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset;
	    y = ((index - listPtr->topIndex)*listPtr->lineHeight)
		    + listPtr->inset + listPtr->selBorderWidth;
	    Tk_GetFontMetrics(listPtr->tkfont, &fm);
	    sprintf(interp->result, "%d %d %d %d", x, y, elPtr->pixelWidth,
		    fm.linespace);
	}
    } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " cget option\"",
		    (char *) NULL);







>
>




|
|







514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
	for (i = 0, elPtr = listPtr->firstPtr; i < index;
		i++, elPtr = elPtr->nextPtr) {
	    /* Empty loop body. */
	}
	if ((index >= listPtr->topIndex) && (index < listPtr->numElements)
		    && (index < (listPtr->topIndex + listPtr->fullLines
		    + listPtr->partialLine))) {
	    char buf[TCL_INTEGER_SPACE * 4];

	    x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset;
	    y = ((index - listPtr->topIndex)*listPtr->lineHeight)
		    + listPtr->inset + listPtr->selBorderWidth;
	    Tk_GetFontMetrics(listPtr->tkfont, &fm);
	    sprintf(buf, "%d %d %d %d", x, y, elPtr->pixelWidth, fm.linespace);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	}
    } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " cget option\"",
		    (char *) NULL);
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565


566
567
568
569
570
571
572
	} else {
	    result = ConfigureListbox(interp, listPtr, argc-2, argv+2,
		    TK_CONFIG_ARGV_ONLY);
	}
    } else if ((c == 'c') && (strncmp(argv[1], "curselection", length) == 0)
	    && (length >= 2)) {
	int i, count;
	char index[20];
	Element *elPtr;

	if (argc != 2) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " curselection\"",
		    (char *) NULL);
	    goto error;
	}
	count = 0;
	for (i = 0, elPtr = listPtr->firstPtr; elPtr != NULL;
		i++, elPtr = elPtr->nextPtr) {
	    if (elPtr->selected) {


		sprintf(index, "%d", i);
		Tcl_AppendElement(interp, index);
		count++;
	    }
	}
	if (count != listPtr->numSelected) {
	    panic("ListboxWidgetCmd: selection count incorrect");







<












>
>







548
549
550
551
552
553
554

555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
	} else {
	    result = ConfigureListbox(interp, listPtr, argc-2, argv+2,
		    TK_CONFIG_ARGV_ONLY);
	}
    } else if ((c == 'c') && (strncmp(argv[1], "curselection", length) == 0)
	    && (length >= 2)) {
	int i, count;

	Element *elPtr;

	if (argc != 2) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " curselection\"",
		    (char *) NULL);
	    goto error;
	}
	count = 0;
	for (i = 0, elPtr = listPtr->firstPtr; elPtr != NULL;
		i++, elPtr = elPtr->nextPtr) {
	    if (elPtr->selected) {
		char index[TCL_INTEGER_SPACE];

		sprintf(index, "%d", i);
		Tcl_AppendElement(interp, index);
		count++;
	    }
	}
	if (count != listPtr->numSelected) {
	    panic("ListboxWidgetCmd: selection count incorrect");
605
606
607
608
609
610
611


612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640

641
642
643
644
645
646
647
648
649
650
651
652

653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669

670
671
672
673
674
675
676
677
678
679
680

681
682
683
684
685
686
687
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " get first ?last?\"", (char *) NULL);
	    goto error;
	}
	if (GetListboxIndex(interp, listPtr, argv[2], 0, &first) != TCL_OK) {
	    goto error;
	}


	if ((argc == 4) && (GetListboxIndex(interp, listPtr, argv[3],
		0, &last) != TCL_OK)) {
	    goto error;
	}
	if (first >= listPtr->numElements) {
	    goto done;
	}
	if (last >= listPtr->numElements) {
	    last = listPtr->numElements-1;
	}

	for (elPtr = listPtr->firstPtr, i = 0; i < first;
		i++, elPtr = elPtr->nextPtr) {
	    /* Empty loop body. */
	}
	if (elPtr != NULL) {
	    if (argc == 3) {
		if (first >= 0) {
		    interp->result = elPtr->text;
		}
	    } else {
		for (  ; i <= last; i++, elPtr = elPtr->nextPtr) {
		    Tcl_AppendElement(interp, elPtr->text);
		}
	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
	    && (length >= 3)) {
	int index;


	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " index index\"",
		    (char *) NULL);
	    goto error;
	}
	if (GetListboxIndex(interp, listPtr, argv[2], 1, &index)
		!= TCL_OK) {
	    goto error;
	}
	sprintf(interp->result, "%d", index);

    } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
	    && (length >= 3)) {
	int index;

	if (argc < 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " insert index ?element element ...?\"",
		    (char *) NULL);
	    goto error;
	}
	if (GetListboxIndex(interp, listPtr, argv[2], 1, &index)
		!= TCL_OK) {
	    goto error;
	}
	InsertEls(listPtr, index, argc-3, argv+3);
    } else if ((c == 'n') && (strncmp(argv[1], "nearest", length) == 0)) {
	int index, y;


	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " nearest y\"", (char *) NULL);
	    goto error;
	}
	if (Tcl_GetInt(interp, argv[2], &y) != TCL_OK) {
	    goto error;
	}
	index = NearestListboxElement(listPtr, y);
	sprintf(interp->result, "%d", index);

    } else if ((c == 's') && (length >= 2)
	    && (strncmp(argv[1], "scan", length) == 0)) {
	int x, y;

	if (argc != 5) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " scan mark|dragto x y\"", (char *) NULL);







>
>
|
|
















|










>











|
>

















>










|
>







608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " get first ?last?\"", (char *) NULL);
	    goto error;
	}
	if (GetListboxIndex(interp, listPtr, argv[2], 0, &first) != TCL_OK) {
	    goto error;
	}
	last = first;
	if ((argc == 4)
		&& (GetListboxIndex(interp, listPtr, argv[3], 0,
			&last) != TCL_OK)) {
	    goto error;
	}
	if (first >= listPtr->numElements) {
	    goto done;
	}
	if (last >= listPtr->numElements) {
	    last = listPtr->numElements-1;
	}

	for (elPtr = listPtr->firstPtr, i = 0; i < first;
		i++, elPtr = elPtr->nextPtr) {
	    /* Empty loop body. */
	}
	if (elPtr != NULL) {
	    if (argc == 3) {
		if (first >= 0) {
		    Tcl_SetResult(interp, elPtr->text, TCL_STATIC);
		}
	    } else {
		for (  ; i <= last; i++, elPtr = elPtr->nextPtr) {
		    Tcl_AppendElement(interp, elPtr->text);
		}
	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
	    && (length >= 3)) {
	int index;
	char buf[TCL_INTEGER_SPACE];

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " index index\"",
		    (char *) NULL);
	    goto error;
	}
	if (GetListboxIndex(interp, listPtr, argv[2], 1, &index)
		!= TCL_OK) {
	    goto error;
	}
	sprintf(buf, "%d", index);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
	    && (length >= 3)) {
	int index;

	if (argc < 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " insert index ?element element ...?\"",
		    (char *) NULL);
	    goto error;
	}
	if (GetListboxIndex(interp, listPtr, argv[2], 1, &index)
		!= TCL_OK) {
	    goto error;
	}
	InsertEls(listPtr, index, argc-3, argv+3);
    } else if ((c == 'n') && (strncmp(argv[1], "nearest", length) == 0)) {
	int index, y;
	char buf[TCL_INTEGER_SPACE];

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " nearest y\"", (char *) NULL);
	    goto error;
	}
	if (Tcl_GetInt(interp, argv[2], &y) != TCL_OK) {
	    goto error;
	}
	index = NearestListboxElement(listPtr, y);
	sprintf(buf, "%d", index);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 's') && (length >= 2)
	    && (strncmp(argv[1], "scan", length) == 0)) {
	int x, y;

	if (argc != 5) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " scan mark|dragto x y\"", (char *) NULL);
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812


813
814
815
816
817
818

819
820
821
822
823
824
825
826
827
828
829


830
831
832
833
834
835
836

837
838
839
840
841
842
843
    
	    if (argc != 4) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
			argv[0], " selection includes index\"", (char *) NULL);
		goto error;
	    }
	    if ((first < 0) || (first >= listPtr->numElements)) {
		interp->result = "0";
		goto done;
	    }
	    for (elPtr = listPtr->firstPtr, i = 0; i < first;
		    i++, elPtr = elPtr->nextPtr) {
		/* Empty loop body. */
	    }
	    if (elPtr->selected) {
		interp->result = "1";
	    } else {
		interp->result = "0";
	    }
	} else if ((c == 's') && (strncmp(argv[2], "set", length) == 0)) {
	    ListboxSelect(listPtr, first, last, 1);
	} else {
	    Tcl_AppendResult(interp, "bad selection option \"", argv[2],
		    "\": must be anchor, clear, includes, or set",
		    (char *) NULL);
	    goto error;
	}
    } else if ((c == 's') && (length >= 2)
	    && (strncmp(argv[1], "size", length) == 0)) {


	if (argc != 2) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " size\"", (char *) NULL);
	    goto error;
	}
	sprintf(interp->result, "%d", listPtr->numElements);

    } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
	int index, count, type, windowWidth, windowUnits;
	int offset = 0;		/* Initialized to stop gcc warnings. */
	double fraction, fraction2;

	windowWidth = Tk_Width(listPtr->tkwin)
	    - 2*(listPtr->inset + listPtr->selBorderWidth);
	if (argc == 2) {
	    if (listPtr->maxWidth == 0) {
		interp->result = "0 1";
	    } else {


		fraction = listPtr->xOffset/((double) listPtr->maxWidth);
		fraction2 = (listPtr->xOffset + windowWidth)
			/((double) listPtr->maxWidth);
		if (fraction2 > 1.0) {
		    fraction2 = 1.0;
		}
		sprintf(interp->result, "%g %g", fraction, fraction2);

	    }
	} else if (argc == 3) {
	    if (Tcl_GetInt(interp, argv[2], &index) != TCL_OK) {
		goto error;
	    }
	    ChangeListboxOffset(listPtr, index*listPtr->xScrollUnit);
	} else {







|







|

|











>
>





|
>









|

>
>






|
>







793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
    
	    if (argc != 4) {
		Tcl_AppendResult(interp, "wrong # args: should be \"",
			argv[0], " selection includes index\"", (char *) NULL);
		goto error;
	    }
	    if ((first < 0) || (first >= listPtr->numElements)) {
		Tcl_SetResult(interp, "0", TCL_STATIC);
		goto done;
	    }
	    for (elPtr = listPtr->firstPtr, i = 0; i < first;
		    i++, elPtr = elPtr->nextPtr) {
		/* Empty loop body. */
	    }
	    if (elPtr->selected) {
		Tcl_SetResult(interp, "1", TCL_STATIC);
	    } else {
		Tcl_SetResult(interp, "0", TCL_STATIC);
	    }
	} else if ((c == 's') && (strncmp(argv[2], "set", length) == 0)) {
	    ListboxSelect(listPtr, first, last, 1);
	} else {
	    Tcl_AppendResult(interp, "bad selection option \"", argv[2],
		    "\": must be anchor, clear, includes, or set",
		    (char *) NULL);
	    goto error;
	}
    } else if ((c == 's') && (length >= 2)
	    && (strncmp(argv[1], "size", length) == 0)) {
	char buf[TCL_INTEGER_SPACE];

	if (argc != 2) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " size\"", (char *) NULL);
	    goto error;
	}
	sprintf(buf, "%d", listPtr->numElements);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
	int index, count, type, windowWidth, windowUnits;
	int offset = 0;		/* Initialized to stop gcc warnings. */
	double fraction, fraction2;

	windowWidth = Tk_Width(listPtr->tkwin)
	    - 2*(listPtr->inset + listPtr->selBorderWidth);
	if (argc == 2) {
	    if (listPtr->maxWidth == 0) {
		Tcl_SetResult(interp, "0 1", TCL_STATIC);
	    } else {
		char buf[TCL_DOUBLE_SPACE * 2];
		
		fraction = listPtr->xOffset/((double) listPtr->maxWidth);
		fraction2 = (listPtr->xOffset + windowWidth)
			/((double) listPtr->maxWidth);
		if (fraction2 > 1.0) {
		    fraction2 = 1.0;
		}
		sprintf(buf, "%g %g", fraction, fraction2);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    }
	} else if (argc == 3) {
	    if (Tcl_GetInt(interp, argv[2], &index) != TCL_OK) {
		goto error;
	    }
	    ChangeListboxOffset(listPtr, index*listPtr->xScrollUnit);
	} else {
865
866
867
868
869
870
871
872
873


874
875
876
877
878
879
880

881
882
883
884
885
886
887
	}
    } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)) {
	int index, count, type;
	double fraction, fraction2;

	if (argc == 2) {
	    if (listPtr->numElements == 0) {
		interp->result = "0 1";
	    } else {


		fraction = listPtr->topIndex/((double) listPtr->numElements);
		fraction2 = (listPtr->topIndex+listPtr->fullLines)
			/((double) listPtr->numElements);
		if (fraction2 > 1.0) {
		    fraction2 = 1.0;
		}
		sprintf(interp->result, "%g %g", fraction, fraction2);

	    }
	} else if (argc == 3) {
	    if (GetListboxIndex(interp, listPtr, argv[2], 0, &index)
		    != TCL_OK) {
		goto error;
	    }
	    ChangeListboxView(listPtr, index);







|

>
>






|
>







880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
	}
    } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)) {
	int index, count, type;
	double fraction, fraction2;

	if (argc == 2) {
	    if (listPtr->numElements == 0) {
		Tcl_SetResult(interp, "0 1", TCL_STATIC);
	    } else {
		char buf[TCL_DOUBLE_SPACE * 2];

		fraction = listPtr->topIndex/((double) listPtr->numElements);
		fraction2 = (listPtr->topIndex+listPtr->fullLines)
			/((double) listPtr->numElements);
		if (fraction2 > 1.0) {
		    fraction2 = 1.0;
		}
		sprintf(buf, "%g %g", fraction, fraction2);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    }
	} else if (argc == 3) {
	    if (GetListboxIndex(interp, listPtr, argv[2], 0, &index)
		    != TCL_OK) {
		goto error;
	    }
	    ChangeListboxView(listPtr, index);
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or reconfigure)
 *	a listbox widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, border width,
 *	etc. get set for listPtr;  old resources get freed,
 *	if there were any.
 *
 *----------------------------------------------------------------------







|







1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or reconfigure)
 *	a listbox widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, border width,
 *	etc. get set for listPtr;  old resources get freed,
 *	if there were any.
 *
 *----------------------------------------------------------------------
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
 *
 *	Parse an index into a listbox and return either its value
 *	or an error.
 *
 * Results:
 *	A standard Tcl result.  If all went well, then *indexPtr is
 *	filled in with the index (into listPtr) corresponding to
 *	string.  Otherwise an error message is left in interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */








|







1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
 *
 *	Parse an index into a listbox and return either its value
 *	or an error.
 *
 * Results:
 *	A standard Tcl result.  If all went well, then *indexPtr is
 *	filled in with the index (into listPtr) corresponding to
 *	string.  Otherwise an error message is left in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

Changes to generic/tkMacWinMenu.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

17



18
19
20
21
22
23
24
/* 
 * tkMacWinMenu.c --
 *
 *	This module implements the common elements of the Mac and Windows
 *	specific features of menus. This file is not used for UNIX.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacWinMenu.c 1.39 97/04/09 14:56:59
 */

#include "tkMenu.h"


static int postCommandGeneration;




static int			PreprocessMenu _ANSI_ARGS_((TkMenu *menuPtr));


/*
 *----------------------------------------------------------------------
 *











|




>
|
>
>
>







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
/* 
 * tkMacWinMenu.c --
 *
 *	This module implements the common elements of the Mac and Windows
 *	specific features of menus. This file is not used for UNIX.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacWinMenu.c,v 1.1.4.3 1998/12/13 08:16:08 lfb Exp $
 */

#include "tkMenu.h"

typedef struct ThreadSpecificData {
    int postCommandGeneration;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;


static int			PreprocessMenu _ANSI_ARGS_((TkMenu *menuPtr));


/*
 *----------------------------------------------------------------------
 *
39
40
41
42
43
44
45


46
47
48
49
50
51
52

static int
PreprocessMenu(menuPtr)
    TkMenu *menuPtr;
{
    int index, result, finished;
    TkMenu *cascadeMenuPtr;


   
    Tcl_Preserve((ClientData) menuPtr);
    
    /*
     * First, let's process the post command on ourselves. If this command
     * destroys this menu, or if there was an error, we are done.
     */







>
>







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58

static int
PreprocessMenu(menuPtr)
    TkMenu *menuPtr;
{
    int index, result, finished;
    TkMenu *cascadeMenuPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
   
    Tcl_Preserve((ClientData) menuPtr);
    
    /*
     * First, let's process the post command on ourselves. If this command
     * destroys this menu, or if there was an error, we are done.
     */
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
     */
    
    
    do {
    	finished = 1;
        for (index = 0; index < menuPtr->numEntries; index++) {
            if ((menuPtr->entries[index]->type == CASCADE_ENTRY)
            	    && (menuPtr->entries[index]->name != NULL)) {
            	if ((menuPtr->entries[index]->childMenuRefPtr != NULL)
            		&& (menuPtr->entries[index]->childMenuRefPtr->menuPtr
            		!= NULL)) {
            	    cascadeMenuPtr =
            	    	    menuPtr->entries[index]->childMenuRefPtr->menuPtr;
            	    if (cascadeMenuPtr->postCommandGeneration != 
            	    	    postCommandGeneration) {
            	    	cascadeMenuPtr->postCommandGeneration = 
            	    		postCommandGeneration;
            	        result = PreprocessMenu(cascadeMenuPtr);
            	        if (result != TCL_OK) {
            	            goto done;
            	        }
            	        finished = 0;
            	        break;
            	    }







|






|

|







69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
     */
    
    
    do {
    	finished = 1;
        for (index = 0; index < menuPtr->numEntries; index++) {
            if ((menuPtr->entries[index]->type == CASCADE_ENTRY)
            	    && (menuPtr->entries[index]->namePtr != NULL)) {
            	if ((menuPtr->entries[index]->childMenuRefPtr != NULL)
            		&& (menuPtr->entries[index]->childMenuRefPtr->menuPtr
            		!= NULL)) {
            	    cascadeMenuPtr =
            	    	    menuPtr->entries[index]->childMenuRefPtr->menuPtr;
            	    if (cascadeMenuPtr->postCommandGeneration != 
            	    	    tsdPtr->postCommandGeneration) {
            	    	cascadeMenuPtr->postCommandGeneration = 
            	    		tsdPtr->postCommandGeneration;
            	        result = PreprocessMenu(cascadeMenuPtr);
            	        if (result != TCL_OK) {
            	            goto done;
            	        }
            	        finished = 0;
            	        break;
            	    }
124
125
126
127
128
129
130



131
132
133
134
 *----------------------------------------------------------------------
 */

int
TkPreprocessMenu(menuPtr)
    TkMenu *menuPtr;
{



    postCommandGeneration++;
    menuPtr->postCommandGeneration = postCommandGeneration;
    return PreprocessMenu(menuPtr);
}







>
>
>
|
|


130
131
132
133
134
135
136
137
138
139
140
141
142
143
 *----------------------------------------------------------------------
 */

int
TkPreprocessMenu(menuPtr)
    TkMenu *menuPtr;
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    tsdPtr->postCommandGeneration++;
    menuPtr->postCommandGeneration = tsdPtr->postCommandGeneration;
    return PreprocessMenu(menuPtr);
}

Changes to generic/tkMain.c.

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
/* 
 * tkMain.c --
 *
 *	This file contains a generic main program for Tk-based applications.
 *	It can be used as-is for many applications, just by supplying a
 *	different appInitProc procedure for each specific application.
 *	Or, it can be used as a template for creating new main programs
 *	for Tk applications.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMain.c 1.154 97/08/29 10:40:43
 */

#include <ctype.h>
#include <stdio.h>
#include <string.h>
#include <tcl.h>
#include <tk.h>

#ifdef NO_STDLIB_H
#   include "../compat/stdlib.h"
#else
#   include <stdlib.h>
#endif

















/*
 * Declarations for various library procedures and variables (don't want
 * to include tkInt.h or tkPort.h here, because people might copy this
 * file out of the Tk source directory to make their own modified versions).
 * Note: don't declare "exit" here even though a declaration is really
 * needed, because it will conflict with a declaration elsewhere on
 * some systems.
 */

extern int		isatty _ANSI_ARGS_((int fd));
#if !defined(__WIN32__) && !defined(_WIN32)

extern char *		strrchr _ANSI_ARGS_((CONST char *string, int c));
#endif
extern void		TkpDisplayWarning _ANSI_ARGS_((char *msg,
			    char *title));

/*
 * Global variables used by the main program:
 */

static Tcl_Interp *interp;	/* Interpreter for this application. */
static Tcl_DString command;	/* Used to assemble lines of terminal input
				 * into Tcl commands. */
static Tcl_DString line;	/* Used to read the next line from the
                                 * terminal input. */
static int tty;			/* Non-zero means standard input is a
				 * terminal-like device.  Zero means it's
				 * a file. */

/*
 * Forward declarations for procedures defined later in this file.
 */

static void		Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
static void		StdinProc _ANSI_ARGS_((ClientData clientData,
			    int mask));

/*
 *----------------------------------------------------------------------
 *
 * Tk_Main --
 *
 *	Main program for Wish and most other Tk-based applications.
 *
 * Results:
 *	None. This procedure never returns (it exits the process when
 *	it's done.
 *
 * Side effects:
 *	This procedure initializes the Tk world and then starts
 *	interpreting commands;  almost anything could happen, depending
 *	on the script being interpreted.
 *
 *----------------------------------------------------------------------
 */

void
Tk_Main(argc, argv, appInitProc)
    int argc;				/* Number of arguments. */
    char **argv;			/* Array of argument strings. */
    Tcl_AppInitProc *appInitProc;	/* Application-specific initialization
					 * procedure to call after most
					 * initialization but before starting
					 * to execute commands. */

{
    char *args, *fileName;
    char buf[20];
    int code;
    size_t length;
    Tcl_Channel inChannel, outChannel;


















    Tcl_FindExecutable(argv[0]);
    interp = Tcl_CreateInterp();





#ifdef TCL_MEM_DEBUG
    Tcl_InitMemory(interp);
#endif

    /*
     * Parse command-line arguments.  A leading "-file" argument is
     * ignored (a historical relic from the distant past).  If the










|




|







>





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










<

>





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












|














<

|






>


|



>
>
>
>
>

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

|
>
>
>
>
>







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
/* 
 * tkMain.c --
 *
 *	This file contains a generic main program for Tk-based applications.
 *	It can be used as-is for many applications, just by supplying a
 *	different appInitProc procedure for each specific application.
 *	Or, it can be used as a template for creating new main programs
 *	for Tk applications.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMain.c,v 1.1.4.7 1999/04/07 00:58:22 stanton Exp $
 */

#include <ctype.h>
#include <stdio.h>
#include <string.h>
#include <tcl.h>
#include <tk.h>
#include "tkInt.h"
#ifdef NO_STDLIB_H
#   include "../compat/stdlib.h"
#else
#   include <stdlib.h>
#endif
#ifdef __WIN32__
#include "tkWinInt.h"
#endif


typedef struct ThreadSpecificData {
    Tcl_Interp *interp;         /* Interpreter for this thread. */
    Tcl_DString command;        /* Used to assemble lines of terminal input
				 * into Tcl commands. */
    Tcl_DString line;           /* Used to read the next line from the
				 * terminal input. */
    int tty;                    /* Non-zero means standard input is a 
				 * terminal-like device.  Zero means it's
				 * a file. */
} ThreadSpecificData;
Tcl_ThreadDataKey dataKey;

/*
 * Declarations for various library procedures and variables (don't want
 * to include tkInt.h or tkPort.h here, because people might copy this
 * file out of the Tk source directory to make their own modified versions).
 * Note: don't declare "exit" here even though a declaration is really
 * needed, because it will conflict with a declaration elsewhere on
 * some systems.
 */


#if !defined(__WIN32__) && !defined(_WIN32)
extern int		isatty _ANSI_ARGS_((int fd));
extern char *		strrchr _ANSI_ARGS_((CONST char *string, int c));
#endif
extern void		TkpDisplayWarning _ANSI_ARGS_((char *msg,
			    char *title));




extern void TkConsoleCreate_ _ANSI_ARGS_((void));









/*
 * Forward declarations for procedures defined later in this file.
 */

static void		Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
static void		StdinProc _ANSI_ARGS_((ClientData clientData,
			    int mask));

/*
 *----------------------------------------------------------------------
 *
 * TkMainEx --
 *
 *	Main program for Wish and most other Tk-based applications.
 *
 * Results:
 *	None. This procedure never returns (it exits the process when
 *	it's done.
 *
 * Side effects:
 *	This procedure initializes the Tk world and then starts
 *	interpreting commands;  almost anything could happen, depending
 *	on the script being interpreted.
 *
 *----------------------------------------------------------------------
 */

void
Tk_MainEx(argc, argv, appInitProc, interp)
    int argc;				/* Number of arguments. */
    char **argv;			/* Array of argument strings. */
    Tcl_AppInitProc *appInitProc;	/* Application-specific initialization
					 * procedure to call after most
					 * initialization but before starting
					 * to execute commands. */
    Tcl_Interp *interp;
{
    char *args, *fileName;
    char buf[TCL_INTEGER_SPACE];
    int code;
    size_t length;
    Tcl_Channel inChannel, outChannel;
    Tcl_DString argString;
    ThreadSpecificData *tsdPtr;
#ifdef __WIN32__
    HANDLE handle;
#endif

    /*
     * Ensure that we are getting the matching version of Tcl.  This is
     * really only an issue when Tk is loaded dynamically.
     */

    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
	abort();
    }

    tsdPtr = (ThreadSpecificData *) 
	Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    
    Tcl_FindExecutable(argv[0]);
    tsdPtr->interp = interp;

#if (defined(__WIN32__) || defined(MAC_TCL))
    TkConsoleCreate_();
#endif
    
#ifdef TCL_MEM_DEBUG
    Tcl_InitMemory(interp);
#endif

    /*
     * Parse command-line arguments.  A leading "-file" argument is
     * ignored (a historical relic from the distant past).  If the
127
128
129
130
131
132
133

134

135
136






137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152









153










154
155
156
157
158
159
160
161
162
163
164

165
166
167
168
169
170
171
172

173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207

208
209
210
211
212
213
214
215
216
217
218
219
220
221

    /*
     * Make command-line arguments available in the Tcl variables "argc"
     * and "argv".
     */

    args = Tcl_Merge(argc-1, argv+1);

    Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);

    ckfree(args);
    sprintf(buf, "%d", argc-1);






    Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
	    TCL_GLOBAL_ONLY);

    /*
     * Set the "tcl_interactive" variable.
     */

    /*
     * For now, under Windows, we assume we are not running as a console mode
     * app, so we need to use the GUI console.  In order to enable this, we
     * always claim to be running on a tty.  This probably isn't the right
     * way to do it.
     */

#ifdef __WIN32__









    tty = 1;










#else
    tty = isatty(0);
#endif
    Tcl_SetVar(interp, "tcl_interactive",
	    ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);

    /*
     * Invoke application-specific initialization.
     */

    if ((*appInitProc)(interp) != TCL_OK) {

	TkpDisplayWarning(interp->result, "Application initialization failed");
    }

    /*
     * Invoke the script specified on the command line, if any.
     */

    if (fileName != NULL) {

	code = Tcl_EvalFile(interp, fileName);
	if (code != TCL_OK) {
	    /*
	     * The following statement guarantees that the errorInfo
	     * variable is set properly.
	     */

	    Tcl_AddErrorInfo(interp, "");
	    TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo",
		    TCL_GLOBAL_ONLY), "Error in startup script");
	    Tcl_DeleteInterp(interp);
	    Tcl_Exit(1);
	}
	tty = 0;
    } else {

	/*
	 * Evaluate the .rc file, if one has been specified.
	 */

	Tcl_SourceRCFile(interp);

	/*
	 * Establish a channel handler for stdin.
	 */

	inChannel = Tcl_GetStdChannel(TCL_STDIN);
	if (inChannel) {
	    Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
		    (ClientData) inChannel);
	}
	if (tty) {
	    Prompt(interp, 0);
	}
    }


    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
    if (outChannel) {
	Tcl_Flush(outChannel);
    }
    Tcl_DStringInit(&command);
    Tcl_DStringInit(&line);
    Tcl_ResetResult(interp);

    /*
     * Loop infinitely, waiting for commands to execute.  When there
     * are no windows left, Tk_MainLoop returns and we exit.
     */








>
|
>


>
>
>
>
>
>

|
<













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

|


|






>
|







>













|

















|



>





|
|







155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174

175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278

    /*
     * Make command-line arguments available in the Tcl variables "argc"
     * and "argv".
     */

    args = Tcl_Merge(argc-1, argv+1);
    Tcl_ExternalToUtfDString(NULL, args, -1, &argString);
    Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&argString);
    ckfree(args);
    sprintf(buf, "%d", argc-1);

    if (fileName == NULL) {
	Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
    } else {
	fileName = Tcl_ExternalToUtfDString(NULL, fileName, -1, &argString);
    }
    Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);


    /*
     * Set the "tcl_interactive" variable.
     */

    /*
     * For now, under Windows, we assume we are not running as a console mode
     * app, so we need to use the GUI console.  In order to enable this, we
     * always claim to be running on a tty.  This probably isn't the right
     * way to do it.
     */

#ifdef __WIN32__
    handle = GetStdHandle(STD_INPUT_HANDLE);

    if ((handle == INVALID_HANDLE_VALUE) || (handle == 0) 
	     || (GetFileType(handle) == FILE_TYPE_UNKNOWN)) {
	/*
	 * If it's a bad or closed handle, then it's been connected
	 * to a wish console window.
	 */

	tsdPtr->tty = 1;
    } else if (GetFileType(handle) == FILE_TYPE_CHAR) {
	/*
	 * A character file handle is a tty by definition.
	 */

	tsdPtr->tty = 1;
    } else {
	tsdPtr->tty = 0;
    }

#else
    tsdPtr->tty = isatty(0);
#endif
    Tcl_SetVar(interp, "tcl_interactive",
	    ((fileName == NULL) && tsdPtr->tty) ? "1" : "0", TCL_GLOBAL_ONLY);

    /*
     * Invoke application-specific initialization.
     */

    if ((*appInitProc)(interp) != TCL_OK) {
	TkpDisplayWarning(Tcl_GetStringResult(interp),
		"Application initialization failed");
    }

    /*
     * Invoke the script specified on the command line, if any.
     */

    if (fileName != NULL) {
	Tcl_ResetResult(interp);
	code = Tcl_EvalFile(interp, fileName);
	if (code != TCL_OK) {
	    /*
	     * The following statement guarantees that the errorInfo
	     * variable is set properly.
	     */

	    Tcl_AddErrorInfo(interp, "");
	    TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo",
		    TCL_GLOBAL_ONLY), "Error in startup script");
	    Tcl_DeleteInterp(interp);
	    Tcl_Exit(1);
	}
	tsdPtr->tty = 0;
    } else {

	/*
	 * Evaluate the .rc file, if one has been specified.
	 */

	Tcl_SourceRCFile(interp);

	/*
	 * Establish a channel handler for stdin.
	 */

	inChannel = Tcl_GetStdChannel(TCL_STDIN);
	if (inChannel) {
	    Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
		    (ClientData) inChannel);
	}
	if (tsdPtr->tty) {
	    Prompt(interp, 0);
	}
    }
    Tcl_DStringFree(&argString);

    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
    if (outChannel) {
	Tcl_Flush(outChannel);
    }
    Tcl_DStringInit(&tsdPtr->command);
    Tcl_DStringInit(&tsdPtr->line);
    Tcl_ResetResult(interp);

    /*
     * Loop infinitely, waiting for commands to execute.  When there
     * are no windows left, Tk_MainLoop returns and we exit.
     */

250
251
252
253
254
255
256



257
258
259
260
261
262
263
264
265
266
267
268
269
270
271

272
273
274
275
276
277
278
279
280
    ClientData clientData;		/* Not used. */
    int mask;				/* Not used. */
{
    static int gotPartial = 0;
    char *cmd;
    int code, count;
    Tcl_Channel chan = (Tcl_Channel) clientData;




    count = Tcl_Gets(chan, &line);

    if (count < 0) {
	if (!gotPartial) {
	    if (tty) {
		Tcl_Exit(0);
	    } else {
		Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
	    }
	    return;
	} 
    }

    (void) Tcl_DStringAppend(&command, Tcl_DStringValue(&line), -1);

    cmd = Tcl_DStringAppend(&command, "\n", -1);
    Tcl_DStringFree(&line);
    if (!Tcl_CommandComplete(cmd)) {
        gotPartial = 1;
        goto prompt;
    }
    gotPartial = 0;

    /*







>
>
>

|



|








|
>
|
|







307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
    ClientData clientData;		/* Not used. */
    int mask;				/* Not used. */
{
    static int gotPartial = 0;
    char *cmd;
    int code, count;
    Tcl_Channel chan = (Tcl_Channel) clientData;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    Tcl_Interp *interp = tsdPtr->interp;

    count = Tcl_Gets(chan, &tsdPtr->line);

    if (count < 0) {
	if (!gotPartial) {
	    if (tsdPtr->tty) {
		Tcl_Exit(0);
	    } else {
		Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
	    }
	    return;
	} 
    }

    (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue(
            &tsdPtr->line), -1);
    cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1);
    Tcl_DStringFree(&tsdPtr->line);
    if (!Tcl_CommandComplete(cmd)) {
        gotPartial = 1;
        goto prompt;
    }
    gotPartial = 0;

    /*
289
290
291
292
293
294
295
296
297
298
299

300
301
302
303
304

305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
    code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
    
    chan = Tcl_GetStdChannel(TCL_STDIN);
    if (chan) {
	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
		(ClientData) chan);
    }
    Tcl_DStringFree(&command);
    if (*interp->result != 0) {
	if ((code != TCL_OK) || (tty)) {
	    /*

	     * The statement below used to call "printf", but that resulted
	     * in core dumps under Solaris 2.3 if the result was very long.
             *
             * NOTE: This probably will not work under Windows either.
	     */


	    puts(interp->result);
	}
    }

    /*
     * Output a prompt.
     */

    prompt:
    if (tty) {
	Prompt(interp, gotPartial);
    }
    Tcl_ResetResult(interp);
}

/*
 *----------------------------------------------------------------------







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








|







350
351
352
353
354
355
356
357
358
359

360
361
362



363
364

365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
    code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
    
    chan = Tcl_GetStdChannel(TCL_STDIN);
    if (chan) {
	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
		(ClientData) chan);
    }
    Tcl_DStringFree(&tsdPtr->command);
    if (Tcl_GetStringResult(interp)[0] != '\0') {
	if ((code != TCL_OK) || (tsdPtr->tty)) {

	    chan = Tcl_GetStdChannel(TCL_STDOUT);
	    if (chan) {
		Tcl_WriteObj(chan, Tcl_GetObjResult(interp));



		Tcl_WriteChars(chan, "\n", 1);
	    }

	}
    }

    /*
     * Output a prompt.
     */

    prompt:
    if (tsdPtr->tty) {
	Prompt(interp, gotPartial);
    }
    Tcl_ResetResult(interp);
}

/*
 *----------------------------------------------------------------------
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
             * We must check that outChannel is a real channel - it
             * is possible that someone has transferred stdout out of
             * this interpreter with "interp transfer".
             */

	    outChannel = Tcl_GetChannel(interp, "stdout", NULL);
            if (outChannel != (Tcl_Channel) NULL) {
                Tcl_Write(outChannel, "% ", 2);
            }
	}
    } else {
	code = Tcl_Eval(interp, promptCmd);
	if (code != TCL_OK) {
	    Tcl_AddErrorInfo(interp,
		    "\n    (script that generates prompt)");
            /*
             * We must check that errChannel is a real channel - it
             * is possible that someone has transferred stderr out of
             * this interpreter with "interp transfer".
             */
            
	    errChannel = Tcl_GetChannel(interp, "stderr", NULL);
            if (errChannel != (Tcl_Channel) NULL) {
                Tcl_Write(errChannel, interp->result, -1);
                Tcl_Write(errChannel, "\n", 1);
            }
	    goto defaultPrompt;
	}
    }
    outChannel = Tcl_GetChannel(interp, "stdout", NULL);
    if (outChannel != (Tcl_Channel) NULL) {
        Tcl_Flush(outChannel);
    }
}







|















|
|









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
             * We must check that outChannel is a real channel - it
             * is possible that someone has transferred stdout out of
             * this interpreter with "interp transfer".
             */

	    outChannel = Tcl_GetChannel(interp, "stdout", NULL);
            if (outChannel != (Tcl_Channel) NULL) {
                Tcl_WriteChars(outChannel, "% ", 2);
            }
	}
    } else {
	code = Tcl_Eval(interp, promptCmd);
	if (code != TCL_OK) {
	    Tcl_AddErrorInfo(interp,
		    "\n    (script that generates prompt)");
            /*
             * We must check that errChannel is a real channel - it
             * is possible that someone has transferred stderr out of
             * this interpreter with "interp transfer".
             */
            
	    errChannel = Tcl_GetChannel(interp, "stderr", NULL);
            if (errChannel != (Tcl_Channel) NULL) {
                Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
                Tcl_WriteChars(errChannel, "\n", 1);
            }
	    goto defaultPrompt;
	}
    }
    outChannel = Tcl_GetChannel(interp, "stdout", NULL);
    if (outChannel != (Tcl_Channel) NULL) {
        Tcl_Flush(outChannel);
    }
}

Changes to generic/tkMenu.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
/* 
 * tkMenu.c --
 *
 * This file contains most of the code for implementing menus in Tk. It takes
 * care of all of the generic (platform-independent) parts of menus, and
 * is supplemented by platform-specific files. The geometry calculation
 * and drawing code for menus is in the file tkMenuDraw.c
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMenu.c 1.148 97/10/29 09:22:00
 */

/*
 * Notes on implementation of menus:
 *
 * Menus can be used in three ways:
 * - as a popup menu, either as part of a menubutton or standalone.









|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
/* 
 * tkMenu.c --
 *
 * This file contains most of the code for implementing menus in Tk. It takes
 * care of all of the generic (platform-independent) parts of menus, and
 * is supplemented by platform-specific files. The geometry calculation
 * and drawing code for menus is in the file tkMenuDraw.c
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMenu.c,v 1.1.4.8 1999/03/10 07:13:44 stanton Exp $
 */

/*
 * Notes on implementation of menus:
 *
 * Menus can be used in three ways:
 * - as a popup menu, either as part of a menubutton or standalone.
64
65
66
67
68
69
70









71
72
73
74
75













76
77
78
79
80
81
82
83





84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101












102
103
104
105
106
107

108
109
110
111
112
113
114
115
116
117

118




119

120
121



122
123
124
125
126
127
128
129


130

131
132
133

134
135
136
137
138







139

140
141
142

143

144
145
146
147
148
149
150
151
152
153
154
155
156

157
158
159
160

161

162
163
164
165

166
167










168
169





170
171
172
173
174



175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200

201
202

203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227

228
229
230
231
232
233
234

235
236



237








238






239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268



269
270
271
272
273
274
275
276
277

278
279

280
281
282
283
284
285
286
287
288
289
290
291
292
293


294














































295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328



329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348

349
350
351
352
353
354

355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398


399











400
401
402
403
404
405
406


407
408
409
410
411
412
413
414

415
416
417
418
419
420
421
 * 2. When a cascade item is added to a menu that has been cloned, and the
 * menu that the cascade item points to exists, that menu has to be cloned.
 * 3. When the menu that a cascade entry points to is changed, the old
 * cloned cascade menu has to be discarded, and the new one has to be cloned.
 *
 */










#include "tkPort.h"
#include "tkMenu.h"

#define MENU_HASH_KEY "tkMenus"














static int menusInitialized;	/* Whether or not the hash tables, etc., have
				 * been setup */

/*
 * Configuration specs for individual menu entries. If this changes, be sure
 * to update code in TkpMenuInit that changes the font string entry.
 */






Tk_ConfigSpec tkMenuEntryConfigSpecs[] = {
    {TK_CONFIG_BORDER, "-activebackground", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorder),
	COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
	|TK_CONFIG_NULL_OK},
    {TK_CONFIG_COLOR, "-activeforeground", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_ACTIVE_FG, Tk_Offset(TkMenuEntry, activeFg),
	COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
	|TK_CONFIG_NULL_OK},
    {TK_CONFIG_STRING, "-accelerator", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_ACCELERATOR, Tk_Offset(TkMenuEntry, accel),
	COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
	|TK_CONFIG_NULL_OK},
    {TK_CONFIG_BORDER, "-background", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_BG, Tk_Offset(TkMenuEntry, border),
	COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
	|SEPARATOR_MASK|TEAROFF_MASK|TK_CONFIG_NULL_OK},
    {TK_CONFIG_BITMAP, "-bitmap", (char *) NULL, (char *) NULL,












	DEF_MENU_ENTRY_BITMAP, Tk_Offset(TkMenuEntry, bitmap),
	COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
	|TK_CONFIG_NULL_OK},
    {TK_CONFIG_BOOLEAN, "-columnbreak", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_COLUMN_BREAK, Tk_Offset(TkMenuEntry, columnBreak),
	COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK},

    {TK_CONFIG_STRING, "-command", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_COMMAND, Tk_Offset(TkMenuEntry, command),
	COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
	|TK_CONFIG_NULL_OK},
    {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_FONT, Tk_Offset(TkMenuEntry, tkfont),
	COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
	|TK_CONFIG_NULL_OK},
    {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_FG, Tk_Offset(TkMenuEntry, fg),

	COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK




	|TK_CONFIG_NULL_OK},

    {TK_CONFIG_BOOLEAN, "-hidemargin", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_HIDE_MARGIN, Tk_Offset(TkMenuEntry, hideMargin),



	COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
	|SEPARATOR_MASK|TEAROFF_MASK},
    {TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_IMAGE, Tk_Offset(TkMenuEntry, imageString),
	COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
	|TK_CONFIG_NULL_OK},
    {TK_CONFIG_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_INDICATOR, Tk_Offset(TkMenuEntry, indicatorOn),


	CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_DONT_SET_DEFAULT},

    {TK_CONFIG_STRING, "-label", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_LABEL, Tk_Offset(TkMenuEntry, label),
	COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK},

    {TK_CONFIG_STRING, "-menu", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_MENU, Tk_Offset(TkMenuEntry, name),
	CASCADE_MASK|TK_CONFIG_NULL_OK},
    {TK_CONFIG_STRING, "-offvalue", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_OFF_VALUE, Tk_Offset(TkMenuEntry, offValue),







	CHECK_BUTTON_MASK},

    {TK_CONFIG_STRING, "-onvalue", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_ON_VALUE, Tk_Offset(TkMenuEntry, onValue),
	CHECK_BUTTON_MASK},

    {TK_CONFIG_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,

	DEF_MENU_ENTRY_SELECT, Tk_Offset(TkMenuEntry, indicatorFg),
	CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
    {TK_CONFIG_STRING, "-selectimage", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_SELECT_IMAGE, Tk_Offset(TkMenuEntry, selectImageString),
	CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
    {TK_CONFIG_UID, "-state", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_STATE, Tk_Offset(TkMenuEntry, state),
	COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
	|TEAROFF_MASK|TK_CONFIG_DONT_SET_DEFAULT},
    {TK_CONFIG_STRING, "-value", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_VALUE, Tk_Offset(TkMenuEntry, onValue),
	RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
    {TK_CONFIG_STRING, "-variable", (char *) NULL, (char *) NULL,

	DEF_MENU_ENTRY_CHECK_VARIABLE, Tk_Offset(TkMenuEntry, name),
	CHECK_BUTTON_MASK|TK_CONFIG_NULL_OK},
    {TK_CONFIG_STRING, "-variable", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_RADIO_VARIABLE, Tk_Offset(TkMenuEntry, name),

	RADIO_BUTTON_MASK},

    {TK_CONFIG_INT, "-underline", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_UNDERLINE, Tk_Offset(TkMenuEntry, underline),
	COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
	|TK_CONFIG_DONT_SET_DEFAULT},

    {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, 0}










};






/*
 * Configuration specs valid for the menu as a whole. If this changes, be sure
 * to update code in TkpMenuInit that changes the font string entry.
 */




Tk_ConfigSpec tkMenuConfigSpecs[] = {
    {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
	DEF_MENU_ACTIVE_BG_COLOR, Tk_Offset(TkMenu, activeBorder),
	TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
	DEF_MENU_ACTIVE_BG_MONO, Tk_Offset(TkMenu, activeBorder),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_PIXELS, "-activeborderwidth", "activeBorderWidth",
        "BorderWidth", DEF_MENU_ACTIVE_BORDER_WIDTH,
        Tk_Offset(TkMenu, activeBorderWidth), 0},
    {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
	DEF_MENU_ACTIVE_FG_COLOR, Tk_Offset(TkMenu, activeFg),
	TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
	DEF_MENU_ACTIVE_FG_MONO, Tk_Offset(TkMenu, activeFg),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_BORDER, "-background", "background", "Background",
	DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, border), TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_BORDER, "-background", "background", "Background",
	DEF_MENU_BG_MONO, Tk_Offset(TkMenu, border), TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	DEF_MENU_BORDER_WIDTH, Tk_Offset(TkMenu, borderWidth), 0},

    {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
	DEF_MENU_CURSOR, Tk_Offset(TkMenu, cursor), TK_CONFIG_NULL_OK},

    {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
	"DisabledForeground", DEF_MENU_DISABLED_FG_COLOR,
	Tk_Offset(TkMenu, disabledFg), TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
    {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
	"DisabledForeground", DEF_MENU_DISABLED_FG_MONO,
	Tk_Offset(TkMenu, disabledFg), TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
    {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_FONT, "-font", "font", "Font",
	DEF_MENU_FONT, Tk_Offset(TkMenu, tkfont), 0},
    {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
	DEF_MENU_FG, Tk_Offset(TkMenu, fg), 0},
    {TK_CONFIG_STRING, "-postcommand", "postCommand", "Command",
	DEF_MENU_POST_COMMAND, Tk_Offset(TkMenu, postCommand),
        TK_CONFIG_NULL_OK},
    {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
	DEF_MENU_RELIEF, Tk_Offset(TkMenu, relief), 0},
    {TK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background",
	DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFg),
	TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background",
	DEF_MENU_SELECT_MONO, Tk_Offset(TkMenu, indicatorFg),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
	DEF_MENU_TAKE_FOCUS, Tk_Offset(TkMenu, takeFocus), TK_CONFIG_NULL_OK},

    {TK_CONFIG_BOOLEAN, "-tearoff", "tearOff", "TearOff",
	DEF_MENU_TEAROFF, Tk_Offset(TkMenu, tearOff), 0},
    {TK_CONFIG_STRING, "-tearoffcommand", "tearOffCommand", "TearOffCommand",
	DEF_MENU_TEAROFF_CMD, Tk_Offset(TkMenu, tearOffCommand),
	TK_CONFIG_NULL_OK},
    {TK_CONFIG_STRING, "-title", "title", "Title",
    	DEF_MENU_TITLE, Tk_Offset(TkMenu, title), TK_CONFIG_NULL_OK},

    {TK_CONFIG_STRING, "-type", "type", "Type",
	DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypeName), TK_CONFIG_NULL_OK},



    {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,








	(char *) NULL, 0, 0}






};

/*
 * Prototypes for static procedures in this file:
 */

static int		CloneMenu _ANSI_ARGS_((TkMenu *menuPtr,
			    char *newMenuName, char *newMenuTypeString));
static int		ConfigureMenu _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, int argc, char **argv,
			    int flags));
static int		ConfigureMenuCloneEntries _ANSI_ARGS_((
			    Tcl_Interp *interp, TkMenu *menuPtr, int index,
			    int argc, char **argv, int flags));
static int		ConfigureMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr,
			    int argc, char **argv, int flags));
static void		DeleteMenuCloneEntries _ANSI_ARGS_((TkMenu *menuPtr,
			    int first, int last));
static void		DestroyMenuHashTable _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp));
static void		DestroyMenuInstance _ANSI_ARGS_((TkMenu *menuPtr));
static void		DestroyMenuEntry _ANSI_ARGS_((char *memPtr));
static int		GetIndexFromCoords
			    _ANSI_ARGS_((Tcl_Interp *interp, TkMenu *menuPtr,
			    char *string, int *indexPtr));
static int		MenuDoYPosition _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, char *arg));
static int		MenuAddOrInsert _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, char *indexString, int argc,
			    char **argv));



static void		MenuCmdDeletedProc _ANSI_ARGS_((
			    ClientData clientData));
static TkMenuEntry *	MenuNewEntry _ANSI_ARGS_((TkMenu *menuPtr, int index,
			    int type));
static char *		MenuVarProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, char *name1, char *name2,
			    int flags));
static int		MenuWidgetCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));

static void		MenuWorldChanged _ANSI_ARGS_((
			    ClientData instanceData));

static void		RecursivelyDeleteMenu _ANSI_ARGS_((TkMenu *menuPtr));
static void		UnhookCascadeEntry _ANSI_ARGS_((TkMenuEntry *mePtr));

/*
 * The structure below is a list of procs that respond to certain window
 * manager events. One of these includes a font change, which forces
 * the geometry proc to be called.
 */

static TkClassProcs menuClass = {
    NULL,			/* createProc. */
    MenuWorldChanged		/* geometryProc. */
};



















































/*
 *--------------------------------------------------------------
 *
 * Tk_MenuCmd --
 *
 *	This procedure is invoked to process the "menu" Tcl
 *	command.  See the user documentation for details on
 *	what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_MenuCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    Tk_Window tkwin = (Tk_Window) clientData;
    Tk_Window new;
    register TkMenu *menuPtr;
    TkMenuReferences *menuRefPtr;
    int i, len;
    char *arg, c;
    int toplevel;




    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " pathName ?options?\"", (char *) NULL);
	return TCL_ERROR;
    }

    TkMenuInit();

    toplevel = 1;
    for (i = 2; i < argc; i += 2) {
	arg = argv[i];
	len = strlen(arg);
	if (len < 2) {
	    continue;
	}
	c = arg[1];
	if ((c == 't') && (strncmp(arg, "-type", strlen(arg)) == 0)
		&& (len >= 3)) {
	    if (strcmp(argv[i + 1], "menubar") == 0) {

		toplevel = 0;
	    }
	    break;
	}
    }


    new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], toplevel ? ""
	    : NULL);
    if (new == NULL) {
	return TCL_ERROR;
    }

    /*
     * Initialize the data structure for the menu.
     */

    menuPtr = (TkMenu *) ckalloc(sizeof(TkMenu));
    menuPtr->tkwin = new;
    menuPtr->display = Tk_Display(new);
    menuPtr->interp = interp;
    menuPtr->widgetCmd = Tcl_CreateCommand(interp,
	    Tk_PathName(menuPtr->tkwin), MenuWidgetCmd,
	    (ClientData) menuPtr, MenuCmdDeletedProc);
    menuPtr->entries = NULL;
    menuPtr->numEntries = 0;
    menuPtr->active = -1;
    menuPtr->border = NULL;
    menuPtr->borderWidth = 0;
    menuPtr->relief = TK_RELIEF_FLAT;
    menuPtr->activeBorder = NULL;
    menuPtr->activeBorderWidth = 0;
    menuPtr->tkfont = NULL;
    menuPtr->fg = NULL;
    menuPtr->disabledFg = NULL;
    menuPtr->activeFg = NULL;
    menuPtr->indicatorFg = NULL;
    menuPtr->tearOff = 1;
    menuPtr->tearOffCommand = NULL;
    menuPtr->cursor = None;
    menuPtr->takeFocus = NULL;
    menuPtr->postCommand = NULL;
    menuPtr->postCommandGeneration = 0;
    menuPtr->postedCascade = NULL;
    menuPtr->nextInstancePtr = NULL;
    menuPtr->masterMenuPtr = menuPtr;
    menuPtr->menuType = UNKNOWN_TYPE;
    menuPtr->menuFlags = 0;
    menuPtr->parentTopLevelPtr = NULL;
    menuPtr->menuTypeName = NULL;
    menuPtr->title = NULL;


    TkMenuInitializeDrawingFields(menuPtr);












    menuRefPtr = TkCreateMenuReferences(menuPtr->interp,
	    Tk_PathName(menuPtr->tkwin));
    menuRefPtr->menuPtr = menuPtr;
    menuPtr->menuRefPtr = menuRefPtr;
    if (TCL_OK != TkpNewMenu(menuPtr)) {
    	goto error;


    }

    Tk_SetClass(menuPtr->tkwin, "Menu");
    TkSetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr);
    Tk_CreateEventHandler(new, ExposureMask|StructureNotifyMask|ActivateMask,
	    TkMenuEventProc, (ClientData) menuPtr);
    if (ConfigureMenu(interp, menuPtr, argc-2, argv+2, 0) != TCL_OK) {
	goto error;

    }

    /*
     * If a menu has a parent menu pointing to it as a cascade entry, the
     * parent menu needs to be told that this menu now exists so that
     * the platform-part of the menu is correctly updated.
     *







>
>
>
>
>
>
>
>
>





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






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


>
>
>
>
>

<
|


>
>
>
|
|
|
<
<
|
|
|

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

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







|

|
<


|

|










|

|
|
>
>
>







|
|
>


>













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




|














|
|



|
|

|



|
<

>
>
>

|
<
|






|
|
<
|
<
<
<
<
<
|
>






>
|













|
|




|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







|
|
>
>

>
>
>
>
>
>
>
>
>
>
>






|
>
>


<
<


|
|
>







64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113

114
115
116

117
118
119

120
121
122

123
124
125
126
127
128
129
130
131
132
133
134
135
136
137

138
139
140

141
142
143

144
145
146
147

148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163


164


165
166
167
168
169
170
171
172

173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189

190
191
192
193

194
195


196


197
198
199
200
201
202

203
204
205
206
207
208
209


210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230

231
232
233
234
235
236
237
238
239


240
241
242
243
244
245
246


247
248
249
250

251
252
253
254
255
256
257
258
259
260
261
262
263
264

265

266
267
268
269
270
271
272
273
274
275
276
277
278


279

280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321

322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451

452
453
454
455
456
457

458
459
460
461
462
463
464
465
466

467





468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545


546
547
548
549
550
551
552
553
554
555
556
557
 * 2. When a cascade item is added to a menu that has been cloned, and the
 * menu that the cascade item points to exists, that menu has to be cloned.
 * 3. When the menu that a cascade entry points to is changed, the old
 * cloned cascade menu has to be discarded, and the new one has to be cloned.
 *
 */

#if 0

/*
 * used only to test for old config code
 */

#define __NO_OLD_CONFIG
#endif

#include "tkPort.h"
#include "tkMenu.h"

#define MENU_HASH_KEY "tkMenus"

typedef struct ThreadSpecificData {
    int menusInitialized;       /* Flag indicates whether thread-specific
				 * elements of the Windows Menu module
				 * have been initialized. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * The following flag indicates whether the process-wide state for
 * the Menu module has been intialized.  The Mutex protects access to
 * that flag.
 */

static int menusInitialized;
TCL_DECLARE_MUTEX(menuMutex)

/*
 * Configuration specs for individual menu entries. If this changes, be sure
 * to update code in TkpMenuInit that changes the font string entry.
 */

char *tkMenuStateStrings[] = {"active", "normal", "disabled", (char *) NULL};

static char *menuEntryTypeStrings[] = {"cascade", "checkbutton", "command", 
	"radiobutton", "separator", (char *) NULL};

Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = {
    {TK_OPTION_BORDER, "-activebackground", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorderPtr), -1, 

	TK_OPTION_NULL_OK},
    {TK_OPTION_COLOR, "-activeforeground", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_ACTIVE_FG,

	Tk_Offset(TkMenuEntry, activeFgPtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_STRING, "-accelerator", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_ACCELERATOR,

	Tk_Offset(TkMenuEntry, accelPtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_BG,

	Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_BITMAP, "-bitmap", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_BITMAP,
	Tk_Offset(TkMenuEntry, bitmapPtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_BOOLEAN, "-columnbreak", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_COLUMN_BREAK,
	-1, Tk_Offset(TkMenuEntry, columnBreak)},
    {TK_OPTION_STRING, "-command", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_COMMAND,
	Tk_Offset(TkMenuEntry, commandPtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_FONT, "-font", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_FONT,
	Tk_Offset(TkMenuEntry, fontPtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_COLOR, "-foreground", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_FG,

	Tk_Offset(TkMenuEntry, fgPtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_BOOLEAN, "-hidemargin", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_HIDE_MARGIN,

	-1, Tk_Offset(TkMenuEntry, hideMargin)},
    {TK_OPTION_STRING, "-image", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_IMAGE,

	Tk_Offset(TkMenuEntry, imagePtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_STRING, "-label", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_LABEL,
	Tk_Offset(TkMenuEntry, labelPtr), -1, 0},

    {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_STATE,
	-1, Tk_Offset(TkMenuEntry, state), 0,
	(ClientData) tkMenuStateStrings},
    {TK_OPTION_INT, "-underline", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_UNDERLINE, -1, Tk_Offset(TkMenuEntry, underline)},
    {TK_OPTION_END}
};

Tk_OptionSpec tkSeparatorEntryConfigSpecs[] = {
    {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_BG,
	Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_END}
};



Tk_OptionSpec tkCheckButtonEntryConfigSpecs[] = {


    {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_INDICATOR,
	-1, Tk_Offset(TkMenuEntry, indicatorOn)},
    {TK_OPTION_STRING, "-offvalue", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_OFF_VALUE,
	Tk_Offset(TkMenuEntry, offValuePtr), -1},
    {TK_OPTION_STRING, "-onvalue", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_ON_VALUE,

	Tk_Offset(TkMenuEntry, onValuePtr), -1},
    {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_SELECT,
	Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_SELECT_IMAGE,
	Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_CHECK_VARIABLE,
	Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
};

Tk_OptionSpec tkRadioButtonEntryConfigSpecs[] = {
    {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_INDICATOR,

	-1, Tk_Offset(TkMenuEntry, indicatorOn)},
    {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_SELECT,
	Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK},

    {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_SELECT_IMAGE, 


	Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK},


    {TK_OPTION_STRING, "-value", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_VALUE,
	Tk_Offset(TkMenuEntry, onValuePtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_RADIO_VARIABLE,
	Tk_Offset(TkMenuEntry, namePtr), -1, 0},

    {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
};

Tk_OptionSpec tkCascadeEntryConfigSpecs[] = {
    {TK_OPTION_STRING, "-menu", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_MENU,


	Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
};

Tk_OptionSpec tkTearoffEntryConfigSpecs[] = {
    {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_BG,
	Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL,
	DEF_MENU_ENTRY_STATE, -1, Tk_Offset(TkMenuEntry, state), 0,
	(ClientData) tkMenuStateStrings},
    {TK_OPTION_END}
};

static Tk_OptionSpec *specsArray[] = {
    tkCascadeEntryConfigSpecs, tkCheckButtonEntryConfigSpecs,
    tkBasicMenuEntryConfigSpecs, tkRadioButtonEntryConfigSpecs,
    tkSeparatorEntryConfigSpecs, tkTearoffEntryConfigSpecs};
    
/*

 * Menu type strings for use with Tcl_GetIndexFromObj.
 */

static char *menuTypeStrings[] = {"normal", "tearoff", "menubar",
	(char *) NULL};

Tk_OptionSpec tkMenuConfigSpecs[] = {
    {TK_OPTION_BORDER, "-activebackground", "activeBackground", 
	"Foreground", DEF_MENU_ACTIVE_BG_COLOR, 


	Tk_Offset(TkMenu, activeBorderPtr), -1, 0,
	(ClientData) DEF_MENU_ACTIVE_BG_MONO},
    {TK_OPTION_PIXELS, "-activeborderwidth", "activeBorderWidth",
        "BorderWidth", DEF_MENU_ACTIVE_BORDER_WIDTH,
        Tk_Offset(TkMenu, activeBorderWidthPtr), -1},
    {TK_OPTION_COLOR, "-activeforeground", "activeForeground", 
	"Background", DEF_MENU_ACTIVE_FG_COLOR, 


	Tk_Offset(TkMenu, activeFgPtr), -1, 0,
	(ClientData) DEF_MENU_ACTIVE_FG_MONO},
    {TK_OPTION_BORDER, "-background", "background", "Background",
	DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, borderPtr), -1, 0,

	(ClientData) DEF_MENU_BG_MONO},
    {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-borderwidth"},
    {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-background"},
    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	DEF_MENU_BORDER_WIDTH,
	Tk_Offset(TkMenu, borderWidthPtr), -1, 0},
    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
	DEF_MENU_CURSOR,
	Tk_Offset(TkMenu, cursorPtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
	"DisabledForeground", DEF_MENU_DISABLED_FG_COLOR,
	Tk_Offset(TkMenu, disabledFgPtr), -1, TK_OPTION_NULL_OK,

	(ClientData) DEF_MENU_DISABLED_FG_MONO},

    {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-foreground"},
    {TK_OPTION_FONT, "-font", "font", "Font",
	DEF_MENU_FONT, Tk_Offset(TkMenu, fontPtr), -1},
    {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
	DEF_MENU_FG, Tk_Offset(TkMenu, fgPtr), -1},
    {TK_OPTION_STRING, "-postcommand", "postCommand", "Command",
	DEF_MENU_POST_COMMAND, 
	Tk_Offset(TkMenu, postCommandPtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
	DEF_MENU_RELIEF, Tk_Offset(TkMenu, reliefPtr), -1},
    {TK_OPTION_COLOR, "-selectcolor", "selectColor", "Background",
	DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFgPtr), -1, 0,


	(ClientData) DEF_MENU_SELECT_MONO},

    {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
	DEF_MENU_TAKE_FOCUS,
	Tk_Offset(TkMenu, takeFocusPtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_BOOLEAN, "-tearoff", "tearOff", "TearOff",
	DEF_MENU_TEAROFF, -1, Tk_Offset(TkMenu, tearoff)},
    {TK_OPTION_STRING, "-tearoffcommand", "tearOffCommand", 
	"TearOffCommand", DEF_MENU_TEAROFF_CMD,
	Tk_Offset(TkMenu, tearoffCommandPtr), -1, TK_OPTION_NULL_OK},
    {TK_OPTION_STRING, "-title", "title", "Title",
	DEF_MENU_TITLE,  Tk_Offset(TkMenu, titlePtr), -1,
	TK_OPTION_NULL_OK},
    {TK_OPTION_STRING_TABLE, "-type", "type", "Type",
	DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypePtr), -1, TK_OPTION_NULL_OK,
	(ClientData) menuTypeStrings},
    {TK_OPTION_END}
};

/*
 * Command line options. Put here because MenuCmd has to look at them
 * along with MenuWidgetObjCmd.
 */

static char *menuOptions[] = {
    "activate", "add", "cget", "clone", "configure", "delete", "entrycget",
    "entryconfigure", "index", "insert", "invoke", "post", "postcascade",
    "type", "unpost", "yposition", (char *) NULL
};
enum options {
    MENU_ACTIVATE, MENU_ADD, MENU_CGET, MENU_CLONE, MENU_CONFIGURE,
    MENU_DELETE, MENU_ENTRYCGET, MENU_ENTRYCONFIGURE, MENU_INDEX,
    MENU_INSERT, MENU_INVOKE, MENU_POST, MENU_POSTCASCADE, MENU_TYPE,
    MENU_UNPOST, MENU_YPOSITION
};

/*
 * Prototypes for static procedures in this file:
 */

static int		CloneMenu _ANSI_ARGS_((TkMenu *menuPtr,
			    Tcl_Obj *newMenuName, Tcl_Obj *newMenuTypeString));
static int		ConfigureMenu _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, int objc, Tcl_Obj *CONST objv[]));

static int		ConfigureMenuCloneEntries _ANSI_ARGS_((
			    Tcl_Interp *interp, TkMenu *menuPtr, int index,
			    int objc, Tcl_Obj *CONST objv[]));
static int		ConfigureMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr,
			    int objc, Tcl_Obj *CONST objv[]));
static void		DeleteMenuCloneEntries _ANSI_ARGS_((TkMenu *menuPtr,
			    int first, int last));
static void		DestroyMenuHashTable _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp));
static void		DestroyMenuInstance _ANSI_ARGS_((TkMenu *menuPtr));
static void		DestroyMenuEntry _ANSI_ARGS_((char *memPtr));
static int		GetIndexFromCoords
			    _ANSI_ARGS_((Tcl_Interp *interp, TkMenu *menuPtr,
			    char *string, int *indexPtr));
static int		MenuDoYPosition _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, Tcl_Obj *objPtr));
static int		MenuAddOrInsert _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, Tcl_Obj *indexPtr, int objc,
			    Tcl_Obj *CONST objv[]));
static int		MenuCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
static void		MenuCmdDeletedProc _ANSI_ARGS_((
			    ClientData clientData));
static TkMenuEntry *	MenuNewEntry _ANSI_ARGS_((TkMenu *menuPtr, int index,
			    int type));
static char *		MenuVarProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, char *name1, char *name2,
			    int flags));
static int		MenuWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
static void		MenuWorldChanged _ANSI_ARGS_((
			    ClientData instanceData));
static int		PostProcessEntry _ANSI_ARGS_((TkMenuEntry *mePtr));
static void		RecursivelyDeleteMenu _ANSI_ARGS_((TkMenu *menuPtr));
static void		UnhookCascadeEntry _ANSI_ARGS_((TkMenuEntry *mePtr));

/*
 * The structure below is a list of procs that respond to certain window
 * manager events. One of these includes a font change, which forces
 * the geometry proc to be called.
 */

static TkClassProcs menuClass = {
    NULL,			/* createProc. */
    MenuWorldChanged		/* geometryProc. */
};

/*
 *--------------------------------------------------------------
 *
 * Tk_CreateMenuCmd --
 *
 *	Called by Tk at initialization time to create the menu
 *	command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
TkCreateMenuCmd(interp)
    Tcl_Interp *interp;		/* Interpreter we are creating the 
				 * command in. */
{
    TkMenuOptionTables *optionTablesPtr = 
	    (TkMenuOptionTables *) ckalloc(sizeof(TkMenuOptionTables));

    optionTablesPtr->menuOptionTable = 
	    Tk_CreateOptionTable(interp, tkMenuConfigSpecs);
    optionTablesPtr->entryOptionTables[TEAROFF_ENTRY] =
	    Tk_CreateOptionTable(interp, specsArray[TEAROFF_ENTRY]);
    optionTablesPtr->entryOptionTables[COMMAND_ENTRY] =
	    Tk_CreateOptionTable(interp, specsArray[COMMAND_ENTRY]);
    optionTablesPtr->entryOptionTables[CASCADE_ENTRY] =
	    Tk_CreateOptionTable(interp, specsArray[CASCADE_ENTRY]);
    optionTablesPtr->entryOptionTables[SEPARATOR_ENTRY] =
	    Tk_CreateOptionTable(interp, specsArray[SEPARATOR_ENTRY]);
    optionTablesPtr->entryOptionTables[RADIO_BUTTON_ENTRY] =
	    Tk_CreateOptionTable(interp, specsArray[RADIO_BUTTON_ENTRY]);
    optionTablesPtr->entryOptionTables[CHECK_BUTTON_ENTRY] =
	    Tk_CreateOptionTable(interp, specsArray[CHECK_BUTTON_ENTRY]);

    Tcl_CreateObjCommand(interp, "menu", MenuCmd,
	    (ClientData) optionTablesPtr, NULL);

    if (Tcl_IsSafe(interp)) {
	Tcl_HideCommand(interp, "menu", "menu");
    }

    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * MenuCmd --
 *
 *	This procedure is invoked to process the "menu" Tcl
 *	command.  See the user documentation for details on
 *	what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
MenuCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument strings. */
{
    Tk_Window tkwin = Tk_MainWindow(interp);
    Tk_Window new;
    register TkMenu *menuPtr;
    TkMenuReferences *menuRefPtr;
    int i, index;

    int toplevel;
    char *windowName;
    static char *typeStringList[] = {"-type", (char *) NULL};
    TkMenuOptionTables *optionTablesPtr = (TkMenuOptionTables *) clientData;

    if (objc < 2) {

	Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
	return TCL_ERROR;
    }

    TkMenuInit();

    toplevel = 1;
    for (i = 2; i < (objc - 1); i++) {
	if (Tcl_GetIndexFromObj(NULL, objv[i], typeStringList, NULL, 0, &index)

		!= TCL_ERROR) {





	    if ((Tcl_GetIndexFromObj(NULL, objv[i + 1], menuTypeStrings, NULL,
		    0, &index) == TCL_OK) && (index == MENUBAR)) {
		toplevel = 0;
	    }
	    break;
	}
    }

    windowName = Tcl_GetStringFromObj(objv[1], NULL);
    new = Tk_CreateWindowFromPath(interp, tkwin, windowName, toplevel ? ""
	    : NULL);
    if (new == NULL) {
	return TCL_ERROR;
    }

    /*
     * Initialize the data structure for the menu.
     */

    menuPtr = (TkMenu *) ckalloc(sizeof(TkMenu));
    menuPtr->tkwin = new;
    menuPtr->display = Tk_Display(new);
    menuPtr->interp = interp;
    menuPtr->widgetCmd = Tcl_CreateObjCommand(interp,
	    Tk_PathName(menuPtr->tkwin), MenuWidgetObjCmd,
	    (ClientData) menuPtr, MenuCmdDeletedProc);
    menuPtr->entries = NULL;
    menuPtr->numEntries = 0;
    menuPtr->active = -1;
    menuPtr->borderPtr = NULL;
    menuPtr->borderWidthPtr = NULL;
    menuPtr->reliefPtr = NULL;
    menuPtr->activeBorderPtr = NULL;
    menuPtr->activeBorderWidthPtr = NULL;
    menuPtr->fontPtr = NULL;
    menuPtr->fgPtr = NULL;
    menuPtr->disabledFgPtr = NULL;
    menuPtr->activeFgPtr = NULL;
    menuPtr->indicatorFgPtr = NULL;
    menuPtr->tearoff = 0;
    menuPtr->tearoffCommandPtr = NULL;
    menuPtr->cursorPtr = None;
    menuPtr->takeFocusPtr = NULL;
    menuPtr->postCommandPtr = NULL;
    menuPtr->postCommandGeneration = 0;
    menuPtr->postedCascade = NULL;
    menuPtr->nextInstancePtr = NULL;
    menuPtr->masterMenuPtr = menuPtr;
    menuPtr->menuType = UNKNOWN_TYPE;
    menuPtr->menuFlags = 0;
    menuPtr->parentTopLevelPtr = NULL;
    menuPtr->menuTypePtr = NULL;
    menuPtr->titlePtr = NULL;
    menuPtr->errorStructPtr = NULL;
    menuPtr->optionTablesPtr = optionTablesPtr;
    TkMenuInitializeDrawingFields(menuPtr);

    Tk_SetClass(menuPtr->tkwin, "Menu");
    TkSetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr);
    if (Tk_InitOptions(interp, (char *) menuPtr,
	    menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin)
	    != TCL_OK) {
    	Tk_DestroyWindow(menuPtr->tkwin);
    	ckfree((char *) menuPtr);
    	return TCL_ERROR;
    }


    menuRefPtr = TkCreateMenuReferences(menuPtr->interp,
	    Tk_PathName(menuPtr->tkwin));
    menuRefPtr->menuPtr = menuPtr;
    menuPtr->menuRefPtr = menuRefPtr;
    if (TCL_OK != TkpNewMenu(menuPtr)) {
    	Tk_DestroyWindow(menuPtr->tkwin);
    	ckfree((char *) menuPtr);
    	return TCL_ERROR;
    }



    Tk_CreateEventHandler(new, ExposureMask|StructureNotifyMask|ActivateMask,
	    TkMenuEventProc, (ClientData) menuPtr);
    if (ConfigureMenu(interp, menuPtr, objc - 2, objv + 2) != TCL_OK) {
    	Tk_DestroyWindow(menuPtr->tkwin);
    	return TCL_ERROR;
    }

    /*
     * If a menu has a parent menu pointing to it as a cascade entry, the
     * parent menu needs to be told that this menu now exists so that
     * the platform-part of the menu is correctly updated.
     *
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
     * to be the cascade entry for the clone of .m1. This is special case
     * #1 listed in the introductory comment.
     */
    
    if (menuRefPtr->parentEntryPtr != NULL) {
        TkMenuEntry *cascadeListPtr = menuRefPtr->parentEntryPtr;
        TkMenuEntry *nextCascadePtr;
        char *newMenuName;
        char *newArgv[2];

        while (cascadeListPtr != NULL) {

	    nextCascadePtr = cascadeListPtr->nextCascadePtr;
     
     	    /*
     	     * If we have a new master menu, and an existing cloned menu
	     * points to this menu in a cascade entry, we have to clone
	     * the new menu and point the entry to the clone instead
	     * of the menu we are creating. Otherwise, ConfigureMenuEntry
	     * will hook up the platform-specific cascade linkages now
	     * that the menu we are creating exists.
     	     */
     	     
     	    if ((menuPtr->masterMenuPtr != menuPtr)
     	    	    || ((menuPtr->masterMenuPtr == menuPtr)
     	    	    && ((cascadeListPtr->menuPtr->masterMenuPtr
		    == cascadeListPtr->menuPtr)))) {
		newArgv[0] = "-menu";
		newArgv[1] = Tk_PathName(menuPtr->tkwin);


     	    	ConfigureMenuEntry(cascadeListPtr, 2, newArgv,
     	    	    TK_CONFIG_ARGV_ONLY);


     	    } else {






      	    	newMenuName = TkNewMenuName(menuPtr->interp,
     	    		Tk_PathName(cascadeListPtr->menuPtr->tkwin),
     	    		menuPtr);

            	CloneMenu(menuPtr, newMenuName, "normal");
    	            
                /*
                 * Now we can set the new menu instance to be the cascade entry
                 * of the parent's instance.
                 */

		newArgv[0] = "-menu";
                newArgv[1] = newMenuName;

                ConfigureMenuEntry(cascadeListPtr, 2, newArgv, 
                	TK_CONFIG_ARGV_ONLY);

	        if (newMenuName != NULL) {
	            ckfree(newMenuName);
	        }

            }
            cascadeListPtr = nextCascadePtr;
        }
    }
    
    /*
     * If there already exist toplevel widgets that refer to this menu,







|
|


















|
|
>
>
|
<
>
>

>
>
>
>
>
>

<
|
>
|






|
|
>
|
<
>
|
|
<
>







566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597

598
599
600
601
602
603
604
605
606
607

608
609
610
611
612
613
614
615
616
617
618
619
620

621
622
623

624
625
626
627
628
629
630
631
     * to be the cascade entry for the clone of .m1. This is special case
     * #1 listed in the introductory comment.
     */
    
    if (menuRefPtr->parentEntryPtr != NULL) {
        TkMenuEntry *cascadeListPtr = menuRefPtr->parentEntryPtr;
        TkMenuEntry *nextCascadePtr;
        Tcl_Obj *newMenuName;
	Tcl_Obj *newObjv[2];

        while (cascadeListPtr != NULL) {

	    nextCascadePtr = cascadeListPtr->nextCascadePtr;
     
     	    /*
     	     * If we have a new master menu, and an existing cloned menu
	     * points to this menu in a cascade entry, we have to clone
	     * the new menu and point the entry to the clone instead
	     * of the menu we are creating. Otherwise, ConfigureMenuEntry
	     * will hook up the platform-specific cascade linkages now
	     * that the menu we are creating exists.
     	     */
     	     
     	    if ((menuPtr->masterMenuPtr != menuPtr)
     	    	    || ((menuPtr->masterMenuPtr == menuPtr)
     	    	    && ((cascadeListPtr->menuPtr->masterMenuPtr
		    == cascadeListPtr->menuPtr)))) {
		newObjv[0] = Tcl_NewStringObj("-menu", -1);
		newObjv[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);
		Tcl_IncrRefCount(newObjv[0]);
		Tcl_IncrRefCount(newObjv[1]);
     	    	ConfigureMenuEntry(cascadeListPtr, 2, newObjv);

		Tcl_DecrRefCount(newObjv[0]);
		Tcl_DecrRefCount(newObjv[1]);
     	    } else {
		Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
		Tcl_Obj *windowNamePtr = Tcl_NewStringObj(
			Tk_PathName(cascadeListPtr->menuPtr->tkwin), -1);

		Tcl_IncrRefCount(normalPtr);
		Tcl_IncrRefCount(windowNamePtr);
      	    	newMenuName = TkNewMenuName(menuPtr->interp,

     	    		windowNamePtr, menuPtr);
		Tcl_IncrRefCount(newMenuName);
            	CloneMenu(menuPtr, newMenuName, normalPtr);
    	            
                /*
                 * Now we can set the new menu instance to be the cascade entry
                 * of the parent's instance.
                 */

		newObjv[0] = Tcl_NewStringObj("-menu", -1);
		newObjv[1] = newMenuName;
		Tcl_IncrRefCount(newObjv[0]);
                ConfigureMenuEntry(cascadeListPtr, 2, newObjv);

		Tcl_DecrRefCount(normalPtr);
		Tcl_DecrRefCount(newObjv[0]);
		Tcl_DecrRefCount(newObjv[1]);

		Tcl_DecrRefCount(windowNamePtr);
            }
            cascadeListPtr = nextCascadePtr;
        }
    }
    
    /*
     * If there already exist toplevel widgets that refer to this menu,
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550



551
552
553
554
555
556
557
558

559
560
561
562
563
564
565
566

567
568
569
570
571
572
573
574

575
576
577
578
579


580
581
582
583
584
585

586
587
588
589
590


591
592
593



594

595
596
597
598
599
600
601


602
603
604
605
606
607
608
609


610
611


612
613

614
615



616




617
618
619

620
621
622

623
624
625
626
627
628









629

630
631
632
633
634
635

636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651


652
653
654

655
656
657
658
659
660
661
662

663
664
665
666
667
668
669
670
671
672
673
674
675






676

677
678
679
680
681
682
683
684

685
686
687
688
689
690
691
692
693
694
695

696
697



698
699


700




701
702
703
704
705
706
707



708
709
710
711
712
713
714
715
716
717




718
719
720
721
722
723
724



725
726
727
728
729
730
731
732
733
734
735


736
737
738
739
740
741
742
743

744
745
746
747
748
749
750
751


752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777


778

779
780
781
782
783

784

785
786
787

788
789
790

791
792



793

794
795
796
797
798
799

800
801
802
803
804
805
806
807
808
809
810
811

812
813
814
815
816
817
818
819
820
821
822
823
824
825
826

827
828
829
830
831
832
833
834


835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
    	    listtkwin = topLevelListPtr->tkwin;
    	    TkSetWindowMenuBar(menuPtr->interp, listtkwin, 
    	    	    Tk_PathName(menuPtr->tkwin), Tk_PathName(menuPtr->tkwin));
    	    topLevelListPtr = nextPtr;
    	}
    }

    interp->result = Tk_PathName(menuPtr->tkwin);
    return TCL_OK;

    error:
    Tk_DestroyWindow(menuPtr->tkwin);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * MenuWidgetCmd --
 *
 *	This procedure is invoked to process the Tcl command
 *	that corresponds to a widget managed by this module.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
MenuWidgetCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Information about menu widget. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    register TkMenu *menuPtr = (TkMenu *) clientData;
    register TkMenuEntry *mePtr;
    int result = TCL_OK;
    size_t length;
    int c;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",



		argv[0], " option ?arg arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    Tcl_Preserve((ClientData) menuPtr);
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)
	    && (length >= 2)) {

	int index;

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " activate index\"", (char *) NULL);
	    goto error;
	}
	if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {

	    goto error;
	}
	if (menuPtr->active == index) {
	    goto done;
	}
	if (index >= 0) {
	    if ((menuPtr->entries[index]->type == SEPARATOR_ENTRY)
		    || (menuPtr->entries[index]->state == tkDisabledUid)) {

		index = -1;
	    }
	}
	result = TkActivateMenuEntry(menuPtr, index);
    } else if ((c == 'a') && (strncmp(argv[1], "add", length) == 0)


	    && (length >= 2)) {
	if (argc < 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " add type ?options?\"", (char *) NULL);
	    goto error;
	}

	if (MenuAddOrInsert(interp, menuPtr, (char *) NULL,
		argc-2, argv+2) != TCL_OK) {
	    goto error;
	}
    } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)


	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",



		    argv[0], " cget option\"",

		    (char *) NULL);
	    goto error;
	}
	result = Tk_ConfigureValue(interp, menuPtr->tkwin, tkMenuConfigSpecs,
		(char *) menuPtr, argv[2], 0);
    } else if ((c == 'c') && (strncmp(argv[1], "clone", length) == 0)
    	    && (length >=2)) {


    	if ((argc < 3) || (argc > 4)) {
    	    Tcl_AppendResult(interp, "wrong # args: should be \"",
    	    	    argv[0], " clone newMenuName ?menuType?\"",
    	    	    (char *) NULL);
    	    goto error;
    	}
    	result = CloneMenu(menuPtr, argv[2], (argc == 3) ? NULL : argv[3]);
    } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)


	    && (length >= 2)) {
	if (argc == 2) {


	    result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
		    tkMenuConfigSpecs, (char *) menuPtr, (char *) NULL, 0);

	} else if (argc == 3) {
	    result = Tk_ConfigureInfo(interp, menuPtr->tkwin,



		    tkMenuConfigSpecs, (char *) menuPtr, argv[2], 0);




	} else {
	    result = ConfigureMenu(interp, menuPtr, argc-2, argv+2,
		    TK_CONFIG_ARGV_ONLY);

	}
    } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
	int first, last;


	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " delete first ?last?\"", (char *) NULL);
	    goto error;
	}









	if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &first) != TCL_OK) {

	    goto error;
	}
	if (argc == 3) {
	    last = first;
	} else {
	    if (TkGetMenuIndex(interp, menuPtr, argv[3], 0, &last) != TCL_OK) {

	        goto error;
	    }
	}
	if (menuPtr->tearOff && (first == 0)) {

	    /*
	     * Sorry, can't delete the tearoff entry;  must reconfigure
	     * the menu.
	     */
	    
	    first = 1;
	}
	if ((first < 0) || (last < first)) {
	    goto done;
	}
	DeleteMenuCloneEntries(menuPtr, first, last);


    } else if ((c == 'e') && (length >= 7)
	    && (strncmp(argv[1], "entrycget", length) == 0)) {
	int index;


	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " entrycget index option\"",
		    (char *) NULL);
	    goto error;
	}
	if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {

	    goto error;
	}
	if (index < 0) {
	    goto done;
	}
	mePtr = menuPtr->entries[index];
	Tcl_Preserve((ClientData) mePtr);
	result = Tk_ConfigureValue(interp, menuPtr->tkwin,
		tkMenuEntryConfigSpecs, (char *) mePtr, argv[3],
		COMMAND_MASK << mePtr->type);
	Tcl_Release((ClientData) mePtr);
    } else if ((c == 'e') && (length >= 7)
	    && (strncmp(argv[1], "entryconfigure", length) == 0)) {






	int index;


	if (argc < 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " entryconfigure index ?option value ...?\"",
		    (char *) NULL);
	    goto error;
	}
	if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {

	    goto error;
	}
	if (index < 0) {
	    goto done;
	}
	mePtr = menuPtr->entries[index];
	Tcl_Preserve((ClientData) mePtr);
	if (argc == 3) {
	    result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
		    tkMenuEntryConfigSpecs, (char *) mePtr, (char *) NULL,
		    COMMAND_MASK << mePtr->type);

	} else if (argc == 4) {
	    result = Tk_ConfigureInfo(interp, menuPtr->tkwin,



		    tkMenuEntryConfigSpecs, (char *) mePtr, argv[3],
		    COMMAND_MASK << mePtr->type);


	} else {




	    result = ConfigureMenuCloneEntries(interp, menuPtr, index, 
	    	    argc-3, argv+3, 
	    	    TK_CONFIG_ARGV_ONLY | COMMAND_MASK << mePtr->type);
	}
	Tcl_Release((ClientData) mePtr);
    } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
	    && (length >= 3)) {



	int index;

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " index string\"", (char *) NULL);
	    goto error;
	}
	if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
	    goto error;
	}




	if (index < 0) {
	    interp->result = "none";
	} else {
	    sprintf(interp->result, "%d", index);
	}
    } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
	    && (length >= 3)) {



	if (argc < 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " insert index type ?options?\"", (char *) NULL);
	    goto error;
	}
	if (MenuAddOrInsert(interp, menuPtr, argv[2],
		argc-3, argv+3) != TCL_OK) {
	    goto error;
	}
    } else if ((c == 'i') && (strncmp(argv[1], "invoke", length) == 0)
	    && (length >= 3)) {


	int index;

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " invoke index\"", (char *) NULL);
	    goto error;
	}
	if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {

	    goto error;
	}
	if (index < 0) {
	    goto done;
	}
	result = TkInvokeMenu(interp, menuPtr, index);
    } else if ((c == 'p') && (strncmp(argv[1], "post", length) == 0)
	    && (length == 4)) {


	int x, y;

	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " post x y\"", (char *) NULL);
	    goto error;
	}
	if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
	    goto error;
	}

	/*
	 * Tearoff menus are posted differently on Mac and Windows than
	 * non-tearoffs. TkpPostMenu does not actually map the menu's
	 * window on those platforms, and popup menus have to be
	 * handled specially.
	 */
	
    	if (menuPtr->menuType != TEAROFF_MENU) {
    	    result = TkpPostMenu(interp, menuPtr, x, y);
    	} else {
    	    result = TkPostTearoffMenu(interp, menuPtr, x, y);
    	}
    } else if ((c == 'p') && (strncmp(argv[1], "postcascade", length) == 0)
	    && (length > 4)) {


	int index;

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " postcascade index\"", (char *) NULL);
	    goto error;
	}

	if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {

	    goto error;
	}
	if ((index < 0) || (menuPtr->entries[index]->type != CASCADE_ENTRY)) {

	    result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
	} else {
	    result = TkPostSubmenu(interp, menuPtr, menuPtr->entries[index]);

	}
    } else if ((c == 't') && (strncmp(argv[1], "type", length) == 0)) {



	int index;

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " type index\"", (char *) NULL);
	    goto error;
	}
	if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {

	    goto error;
	}
	if (index < 0) {
	    goto done;
	}
	mePtr = menuPtr->entries[index];
	switch (mePtr->type) {
	    case COMMAND_ENTRY:
		interp->result = "command";
		break;
	    case SEPARATOR_ENTRY:
		interp->result = "separator";

		break;
	    case CHECK_BUTTON_ENTRY:
		interp->result = "checkbutton";
		break;
	    case RADIO_BUTTON_ENTRY:
		interp->result = "radiobutton";
		break;
	    case CASCADE_ENTRY:
		interp->result = "cascade";
		break;
	    case TEAROFF_ENTRY:
		interp->result = "tearoff";
		break;
	}
    } else if ((c == 'u') && (strncmp(argv[1], "unpost", length) == 0)) {

	if (argc != 2) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " unpost\"", (char *) NULL);
	    goto error;
	}
	Tk_UnmapWindow(menuPtr->tkwin);
	result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
    } else if ((c == 'y') && (strncmp(argv[1], "yposition", length) == 0)) {


	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " yposition index\"", (char *) NULL);
	    goto error;
	}
	result = MenuDoYPosition(interp, menuPtr, argv[2]);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be activate, add, cget, clone, configure, delete, ",
		"entrycget, entryconfigure, index, insert, invoke, ",
		"post, postcascade, type, unpost, or yposition",
		(char *) NULL);
	goto error;
    }
    done:
    Tcl_Release((ClientData) menuPtr);
    return result;

    error:
    Tcl_Release((ClientData) menuPtr);
    return TCL_ERROR;
}


/*
 *----------------------------------------------------------------------
 *
 * TkInvokeMenu --
 *
 *	Given a menu and an index, takes the appropriate action for the







|

<
<
<
<





|















|


|
|




<
|

|
|
>
>
>
|



|
<
<
|
>
|

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


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

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

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

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

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

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

|
|
<
|
|
|
|
|
|

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

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









<







649
650
651
652
653
654
655
656
657




658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687

688
689
690
691
692
693
694
695
696
697
698
699


700
701
702
703
704

705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720

721

722
723
724
725

726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748

749

750
751
752
753
754

755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779

780
781
782

783
784
785


786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824

825
826
827
828

829

830
831
832
833
834
835
836
837
838
839
840

841
842
843
844

845
846
847
848
849
850
851
852
853
854
855
856

857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888

889
890


891
892
893
894
895
896

897
898



899
900
901
902
903
904
905
906
907
908


909
910
911
912
913
914
915
916
917
918
919
920


921
922
923
924
925
926

927
928
929
930
931
932
933
934
935
936
937

938
939
940
941
942
943

944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963

964
965
966
967
968

969
970
971
972
973
974
975
976
977
978
979
980
981
982
983

984
985
986
987
988
989

990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005

1006
1007












1008

1009
1010
1011

1012
1013
1014
1015

1016
1017
1018

1019
1020
1021
1022
1023






1024
1025
1026
1027
1028
1029
1030
1031
1032

1033
1034
1035
1036
1037
1038
1039
    	    listtkwin = topLevelListPtr->tkwin;
    	    TkSetWindowMenuBar(menuPtr->interp, listtkwin, 
    	    	    Tk_PathName(menuPtr->tkwin), Tk_PathName(menuPtr->tkwin));
    	    topLevelListPtr = nextPtr;
    	}
    }

    Tcl_SetResult(interp, Tk_PathName(menuPtr->tkwin), TCL_STATIC);
    return TCL_OK;




}

/*
 *--------------------------------------------------------------
 *
 * MenuWidgetObjCmd --
 *
 *	This procedure is invoked to process the Tcl command
 *	that corresponds to a widget managed by this module.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
MenuWidgetObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Information about menu widget. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument strings. */
{
    register TkMenu *menuPtr = (TkMenu *) clientData;
    register TkMenuEntry *mePtr;
    int result = TCL_OK;

    int option;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], menuOptions, "option", 0,
	    &option) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_Preserve((ClientData) menuPtr);



    switch ((enum options) option) {
	case MENU_ACTIVATE: {
	    int index;

	    if (objc != 3) {

		Tcl_WrongNumArgs(interp, 1, objv, "activate index");
		goto error;
	    }
	    if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
		    != TCL_OK) {
		goto error;
	    }
	    if (menuPtr->active == index) {
		goto done;
	    }
	    if ((index >= 0) 
		    && ((menuPtr->entries[index]->type == SEPARATOR_ENTRY)
			    || (menuPtr->entries[index]->state
				    == ENTRY_DISABLED))) {
		index = -1;
	    }

	    result = TkActivateMenuEntry(menuPtr, index);

	    break;
	}
	case MENU_ADD:
	    if (objc < 3) {

		Tcl_WrongNumArgs(interp, 1, objv, "add type ?options?");
		goto error;
	    }

	    if (MenuAddOrInsert(interp, menuPtr, (Tcl_Obj *) NULL,
		    objc - 2, objv + 2) != TCL_OK) {
		goto error;
	    }
	    break;
	case MENU_CGET: {
	    Tcl_Obj *resultPtr;

	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 1, objv, "cget option");
		goto error;
	    }
	    resultPtr = Tk_GetOptionValue(interp, (char *) menuPtr,
		    menuPtr->optionTablesPtr->menuOptionTable, objv[2],
		    menuPtr->tkwin);
	    if (resultPtr == NULL) {
		goto error;
	    }
	    Tcl_SetObjResult(interp, resultPtr);

	    break;

	}
	case MENU_CLONE:
	    if ((objc < 3) || (objc > 4)) {
		Tcl_WrongNumArgs(interp, 1, objv,
			"clone newMenuName ?menuType?");

		goto error;
	    }
    	    result = CloneMenu(menuPtr, objv[2], (objc == 3) ? NULL : objv[3]);
	    break;
	case MENU_CONFIGURE: {
	    Tcl_Obj *resultPtr;

	    if (objc == 2) {
		resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr,
			menuPtr->optionTablesPtr->menuOptionTable,
			(Tcl_Obj *) NULL, menuPtr->tkwin);
		if (resultPtr == NULL) {
		    result = TCL_ERROR;
		} else {
		    result = TCL_OK;
		    Tcl_SetObjResult(interp, resultPtr);
		}
	    } else if (objc == 3) {
		resultPtr = Tk_GetOptionInfo(interp, (char *) menuPtr,
			menuPtr->optionTablesPtr->menuOptionTable,
			objv[2], menuPtr->tkwin);
		if (resultPtr == NULL) {
		    result = TCL_ERROR;
		} else {
		    result = TCL_OK;

		    Tcl_SetObjResult(interp, resultPtr);
		}
	    } else {

    		result = ConfigureMenu(interp, menuPtr, objc - 2, objv + 2);
	    }
	    if (result != TCL_OK) {


		goto error;
	    }
	    break;
	}
	case MENU_DELETE: {
	    int first, last;
	    
	    if ((objc != 3) && (objc != 4)) {
		Tcl_WrongNumArgs(interp, 1, objv, "delete first ?last?");
		goto error;
	    }
	    if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &first) 
		    != TCL_OK) {
		goto error;
	    }
	    if (objc == 3) {
		last = first;
	    } else {
		if (TkGetMenuIndex(interp, menuPtr, objv[3], 0, &last) 
			!= TCL_OK) {
		    goto error;
		}
	    }
	    if (menuPtr->tearoff && (first == 0)) {

		/*
		 * Sorry, can't delete the tearoff entry;  must reconfigure
		 * the menu.
		 */
		
		first = 1;
	    }
	    if ((first < 0) || (last < first)) {
		goto done;
	    }
	    DeleteMenuCloneEntries(menuPtr, first, last);
	    break;
	}
	case MENU_ENTRYCGET: {

	    int index;
	    Tcl_Obj *resultPtr;

	    if (objc != 4) {

		Tcl_WrongNumArgs(interp, 1, objv, "entrycget index option");

		goto error;
	    }
	    if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) 
		    != TCL_OK) {
		goto error;
	    }
	    if (index < 0) {
		goto done;
	    }
	    mePtr = menuPtr->entries[index];
	    Tcl_Preserve((ClientData) mePtr);

	    resultPtr = Tk_GetOptionValue(interp, (char *) mePtr, 
		    mePtr->optionTable, objv[3], menuPtr->tkwin);
	    Tcl_Release((ClientData) mePtr);
	    if (resultPtr == NULL) {

		goto error;
	    }
	    Tcl_SetObjResult(interp, resultPtr);
	    break;
	}
	case MENU_ENTRYCONFIGURE: {
	    int index;
	    Tcl_Obj *resultPtr;

	    if (objc < 3) {
		Tcl_WrongNumArgs(interp, 1, objv, 
			"entryconfigure index ?option value ...?");

		goto error;
	    }
	    if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
		    != TCL_OK) {
		goto error;
	    }
	    if (index < 0) {
		goto done;
	    }
	    mePtr = menuPtr->entries[index];
	    Tcl_Preserve((ClientData) mePtr);
	    if (objc == 3) {
		resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr,
			mePtr->optionTable, (Tcl_Obj *) NULL, menuPtr->tkwin);
		if (resultPtr == NULL) {
		    result = TCL_ERROR;
		} else {
		    result = TCL_OK;
		    Tcl_SetObjResult(interp, resultPtr);
		}
	    } else if (objc == 4) {
		resultPtr = Tk_GetOptionInfo(interp, (char *) mePtr,
			mePtr->optionTable, objv[3], menuPtr->tkwin);
		if (resultPtr == NULL) {
		    result = TCL_ERROR;
		} else {
		    result = TCL_OK;
		    Tcl_SetObjResult(interp, resultPtr);
		}
	    } else {
		result = ConfigureMenuCloneEntries(interp, menuPtr, index,
			objc - 3, objv + 3);

	    }
	    Tcl_Release((ClientData) mePtr);


	    break;
	}
	case MENU_INDEX: {
	    int index;

	    if (objc != 3) {

		Tcl_WrongNumArgs(interp, 1, objv, "index string");
		goto error;



	    }
	    if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) 
		    != TCL_OK) {
		goto error;
	    }
	    if (index < 0) {
		Tcl_SetResult(interp, "none", TCL_STATIC);
	    } else {
		Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
	    }


	    break;
	}
	case MENU_INSERT:
	    if (objc < 4) {
		Tcl_WrongNumArgs(interp, 1, objv, 
			"insert index type ?options?");
		goto error;
	    }
	    if (MenuAddOrInsert(interp, menuPtr, objv[2], objc - 3,
		    objv + 3) != TCL_OK) {
		goto error;
	    }


	    break;
	case MENU_INVOKE: {
	    int index;

	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 1, objv, "invoke index");

		goto error;
	    }
	    if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
		    != TCL_OK) {
		goto error;
	    }
	    if (index < 0) {
		goto done;
	    }
	    result = TkInvokeMenu(interp, menuPtr, index);
	    break;

	}
	case MENU_POST: {
	    int x, y;

	    if (objc != 4) {
		Tcl_WrongNumArgs(interp, 1, objv, "post x y");

		goto error;
	    }
	    if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
		    || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
		goto error;
	    }

	    /*
	     * Tearoff menus are posted differently on Mac and Windows than
	     * non-tearoffs. TkpPostMenu does not actually map the menu's
	     * window on those platforms, and popup menus have to be
	     * handled specially.
	     */
	    
    	    if (menuPtr->menuType != TEAROFF_MENU) {
    		result = TkpPostMenu(interp, menuPtr, x, y);
    	    } else {
    		result = TkPostTearoffMenu(interp, menuPtr, x, y);
    	    }
	    break;

	}
	case MENU_POSTCASCADE: {
	    int index;

	    if (objc != 3) {

		Tcl_WrongNumArgs(interp, 1, objv, "postcascade index");
		goto error;
	    }

	    if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
		    != TCL_OK) {
		goto error;
	    }
	    if ((index < 0) || (menuPtr->entries[index]->type 
		    != CASCADE_ENTRY)) {
		result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
	    } else {
		result = TkPostSubmenu(interp, menuPtr, 
			menuPtr->entries[index]);
	    }

	    break;
	}
	case MENU_TYPE: {
	    int index;

	    if (objc != 3) {

		Tcl_WrongNumArgs(interp, 1, objv, "type index");
		goto error;
	    }
	    if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) 
		    != TCL_OK) {
		goto error;
	    }
	    if (index < 0) {
		goto done;
	    }
	    if (menuPtr->entries[index]->type == TEAROFF_ENTRY) {
		Tcl_SetResult(interp, "tearoff", TCL_STATIC);
	    } else {
		Tcl_SetResult(interp,
			menuEntryTypeStrings[menuPtr->entries[index]->type],
			TCL_STATIC);

	    }
	    break;












	}

	case MENU_UNPOST:
	    if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "unpost");

		goto error;
	    }
	    Tk_UnmapWindow(menuPtr->tkwin);
	    result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);

	    break;
	case MENU_YPOSITION:
	    if (objc != 3) {

		Tcl_WrongNumArgs(interp, 1, objv, "yposition index");
		goto error;
	    }
	    result = MenuDoYPosition(interp, menuPtr, objv[2]);
	    break;






    }
    done:
    Tcl_Release((ClientData) menuPtr);
    return result;

    error:
    Tcl_Release((ClientData) menuPtr);
    return TCL_ERROR;
}


/*
 *----------------------------------------------------------------------
 *
 * TkInvokeMenu --
 *
 *	Given a menu and an index, takes the appropriate action for the
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903



904
905



906
907
908
909

910
911
912
913




914
915



916
917
918
919

920
921

922



923
924
925
926
927
928
929
930
931
932
933
934
935
936
    int result = TCL_OK;
    TkMenuEntry *mePtr;
    
    if (index < 0) {
    	goto done;
    }
    mePtr = menuPtr->entries[index];
    if (mePtr->state == tkDisabledUid) {
	goto done;
    }
    Tcl_Preserve((ClientData) mePtr);
    if (mePtr->type == TEAROFF_ENTRY) {
    	Tcl_DString commandDString;
    	
    	Tcl_DStringInit(&commandDString);
    	Tcl_DStringAppendElement(&commandDString, "tkTearOffMenu");
    	Tcl_DStringAppendElement(&commandDString, Tk_PathName(menuPtr->tkwin));
    	result = Tcl_Eval(interp, Tcl_DStringValue(&commandDString));
    	Tcl_DStringFree(&commandDString);
    } else if (mePtr->type == CHECK_BUTTON_ENTRY) {



	if (mePtr->entryFlags & ENTRY_SELECTED) {
	    if (Tcl_SetVar(interp, mePtr->name, mePtr->offValue,



		    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
		result = TCL_ERROR;
	    }
	} else {

	    if (Tcl_SetVar(interp, mePtr->name, mePtr->onValue,
		    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
		result = TCL_ERROR;
	    }




	}
    } else if (mePtr->type == RADIO_BUTTON_ENTRY) {



	if (Tcl_SetVar(interp, mePtr->name, mePtr->onValue,
		TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	    result = TCL_ERROR;
	}

    }
    if ((result == TCL_OK) && (mePtr->command != NULL)) {

	result = TkCopyAndGlobalEval(interp, mePtr->command);



    }
    Tcl_Release((ClientData) mePtr);
    done:
    return result; 
}



/*
 *----------------------------------------------------------------------
 *
 * DestroyMenuInstance --
 *
 *	This procedure is invoked by TkDestroyMenu







|




|
<
|
|
|
|
|
|
>
>
>

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



>

|
>
|
>
>
>





<
<







1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071

1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088

1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119


1120
1121
1122
1123
1124
1125
1126
    int result = TCL_OK;
    TkMenuEntry *mePtr;
    
    if (index < 0) {
    	goto done;
    }
    mePtr = menuPtr->entries[index];
    if (mePtr->state == ENTRY_DISABLED) {
	goto done;
    }
    Tcl_Preserve((ClientData) mePtr);
    if (mePtr->type == TEAROFF_ENTRY) {
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, "tkTearOffMenu ", -1);
	Tcl_DStringAppend(&ds, Tk_PathName(menuPtr->tkwin), -1);
	result = Tcl_Eval(interp, Tcl_DStringValue(&ds));
	Tcl_DStringFree(&ds);
    } else if ((mePtr->type == CHECK_BUTTON_ENTRY)
	    && (mePtr->namePtr != NULL)) {
	Tcl_Obj *valuePtr;

	if (mePtr->entryFlags & ENTRY_SELECTED) {
	    valuePtr = mePtr->offValuePtr;
	} else {
	    valuePtr = mePtr->onValuePtr;
	}
	if (valuePtr == NULL) {
	    valuePtr = Tcl_NewObj();
	}

	Tcl_IncrRefCount(valuePtr);
	if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr,
		TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	    result = TCL_ERROR;
	}
	Tcl_DecrRefCount(valuePtr);
    } else if ((mePtr->type == RADIO_BUTTON_ENTRY)
	    && (mePtr->namePtr != NULL)) {
	Tcl_Obj *valuePtr = mePtr->onValuePtr;

	if (valuePtr == NULL) {
	    valuePtr = Tcl_NewObj();
	}
	Tcl_IncrRefCount(valuePtr);
	if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr,
		TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	    result = TCL_ERROR;
	}
	Tcl_DecrRefCount(valuePtr);
    }
    if ((result == TCL_OK) && (mePtr->commandPtr != NULL)) {
	Tcl_Obj *commandPtr = mePtr->commandPtr;

	Tcl_IncrRefCount(commandPtr);
	result = Tcl_EvalObjEx(interp, commandPtr, TCL_EVAL_GLOBAL);
	Tcl_DecrRefCount(commandPtr);
    }
    Tcl_Release((ClientData) mePtr);
    done:
    return result; 
}



/*
 *----------------------------------------------------------------------
 *
 * DestroyMenuInstance --
 *
 *	This procedure is invoked by TkDestroyMenu
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
 *----------------------------------------------------------------------
 */

static void
DestroyMenuInstance(menuPtr)
    TkMenu *menuPtr;	/* Info about menu widget. */
{
    int i, numEntries = menuPtr->numEntries;
    TkMenu *menuInstancePtr;
    TkMenuEntry *cascadePtr, *nextCascadePtr;
    char *newArgv[2];
    TkMenu *parentMasterMenuPtr;
    TkMenuEntry *parentMasterEntryPtr;
    TkMenu *parentMenuPtr;
    
    /*
     * If the menu has any cascade menu entries pointing to it, the cascade
     * entries need to be told that the menu is going away. We need to clear
     * the menu ptr field in the menu reference at this point in the code
     * so that everything else can forget about this menu properly. We also
     * need to reset -menu field of all entries that are not master menus







|


|


<







1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149

1150
1151
1152
1153
1154
1155
1156
 *----------------------------------------------------------------------
 */

static void
DestroyMenuInstance(menuPtr)
    TkMenu *menuPtr;	/* Info about menu widget. */
{
    int i;
    TkMenu *menuInstancePtr;
    TkMenuEntry *cascadePtr, *nextCascadePtr;
    Tcl_Obj *newObjv[2];
    TkMenu *parentMasterMenuPtr;
    TkMenuEntry *parentMasterEntryPtr;

    
    /*
     * If the menu has any cascade menu entries pointing to it, the cascade
     * entries need to be told that the menu is going away. We need to clear
     * the menu ptr field in the menu reference at this point in the code
     * so that everything else can forget about this menu properly. We also
     * need to reset -menu field of all entries that are not master menus
975
976
977
978
979
980
981
982
983
984
985


986
987
988
989
990


991


992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016







1017
1018

1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033

    TkpDestroyMenu(menuPtr);
    cascadePtr = menuPtr->menuRefPtr->parentEntryPtr;
    menuPtr->menuRefPtr->menuPtr = NULL;
    TkFreeMenuReferences(menuPtr->menuRefPtr);

    for (; cascadePtr != NULL; cascadePtr = nextCascadePtr) {
    	parentMenuPtr = cascadePtr->menuPtr;
    	nextCascadePtr = cascadePtr->nextCascadePtr;
    	
    	if (menuPtr->masterMenuPtr != menuPtr) {


	    parentMasterMenuPtr = cascadePtr->menuPtr->masterMenuPtr;
	    parentMasterEntryPtr =
		    parentMasterMenuPtr->entries[cascadePtr->index];
	    newArgv[0] = "-menu";
	    newArgv[1] = parentMasterEntryPtr->name;


    	    ConfigureMenuEntry(cascadePtr, 2, newArgv, TK_CONFIG_ARGV_ONLY);


    	} else {
    	    ConfigureMenuEntry(cascadePtr, 0, (char **) NULL, 0);
    	}
    }
    
    if (menuPtr->masterMenuPtr != menuPtr) {
        for (menuInstancePtr = menuPtr->masterMenuPtr; 
        	menuInstancePtr != NULL;
        	menuInstancePtr = menuInstancePtr->nextInstancePtr) {
            if (menuInstancePtr->nextInstancePtr == menuPtr) {
                menuInstancePtr->nextInstancePtr = 
                	menuInstancePtr->nextInstancePtr->nextInstancePtr;
                break;
            }
        }
   } else if (menuPtr->nextInstancePtr != NULL) {
       panic("Attempting to delete master menu when there are still clones.");
   }

    /*
     * Free up all the stuff that requires special handling, then
     * let Tk_FreeOptions handle all the standard option-related
     * stuff.
     */








    for (i = numEntries - 1; i >= 0; i--) {
	DestroyMenuEntry((char *) menuPtr->entries[i]);

    }
    if (menuPtr->entries != NULL) {
	ckfree((char *) menuPtr->entries);
    }
    TkMenuFreeDrawOptions(menuPtr);
    Tk_FreeOptions(tkMenuConfigSpecs, (char *) menuPtr, menuPtr->display, 0);

    Tcl_EventuallyFree((ClientData) menuPtr, TCL_DYNAMIC);
}

/*
 *----------------------------------------------------------------------
 *
 * TkDestroyMenu --
 *







<



>
>



|
|
>
>
|
>
>

|



















|



>
>
>
>
>
>
>
|

>





|
|
<







1164
1165
1166
1167
1168
1169
1170

1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227

1228
1229
1230
1231
1232
1233
1234

    TkpDestroyMenu(menuPtr);
    cascadePtr = menuPtr->menuRefPtr->parentEntryPtr;
    menuPtr->menuRefPtr->menuPtr = NULL;
    TkFreeMenuReferences(menuPtr->menuRefPtr);

    for (; cascadePtr != NULL; cascadePtr = nextCascadePtr) {

    	nextCascadePtr = cascadePtr->nextCascadePtr;
    	
    	if (menuPtr->masterMenuPtr != menuPtr) {
	    Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1);

	    parentMasterMenuPtr = cascadePtr->menuPtr->masterMenuPtr;
	    parentMasterEntryPtr =
		    parentMasterMenuPtr->entries[cascadePtr->index];
	    newObjv[0] = menuNamePtr;
	    newObjv[1] = parentMasterEntryPtr->namePtr;
	    Tcl_IncrRefCount(newObjv[0]);
	    Tcl_IncrRefCount(newObjv[1]);
    	    ConfigureMenuEntry(cascadePtr, 2, newObjv);
	    Tcl_DecrRefCount(newObjv[0]);
	    Tcl_DecrRefCount(newObjv[1]);
    	} else {
    	    ConfigureMenuEntry(cascadePtr, 0, (Tcl_Obj **) NULL);
    	}
    }
    
    if (menuPtr->masterMenuPtr != menuPtr) {
        for (menuInstancePtr = menuPtr->masterMenuPtr; 
        	menuInstancePtr != NULL;
        	menuInstancePtr = menuInstancePtr->nextInstancePtr) {
            if (menuInstancePtr->nextInstancePtr == menuPtr) {
                menuInstancePtr->nextInstancePtr = 
                	menuInstancePtr->nextInstancePtr->nextInstancePtr;
                break;
            }
        }
   } else if (menuPtr->nextInstancePtr != NULL) {
       panic("Attempting to delete master menu when there are still clones.");
   }

    /*
     * Free up all the stuff that requires special handling, then
     * let Tk_FreeConfigurationOptions handle all the standard option-related
     * stuff.
     */

    for (i = menuPtr->numEntries; --i >= 0; ) {
	/*
	 * As each menu entry is deleted from the end of the array of
	 * entries, decrement menuPtr->numEntries.  Otherwise, the act of
	 * deleting menu entry i will dereference freed memory attempting
	 * to queue a redraw for menu entries (i+1)...numEntries.
	 */
	 
	DestroyMenuEntry((char *) menuPtr->entries[i]);
	menuPtr->numEntries = i;
    }
    if (menuPtr->entries != NULL) {
	ckfree((char *) menuPtr->entries);
    }
    TkMenuFreeDrawOptions(menuPtr);
    Tk_FreeConfigOptions((char *) menuPtr, 
	    menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin);

}

/*
 *----------------------------------------------------------------------
 *
 * TkDestroyMenu --
 *
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217


1218

1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
	 */

	TkPostSubmenu(menuPtr->interp, menuPtr, (TkMenuEntry *) NULL);
    }

    /*
     * Free up all the stuff that requires special handling, then
     * let Tk_FreeOptions handle all the standard option-related
     * stuff.
     */

    if (mePtr->type == CASCADE_ENTRY) {
        UnhookCascadeEntry(mePtr);
    }
    if (mePtr->image != NULL) {
	Tk_FreeImage(mePtr->image);
    }
    if (mePtr->selectImage != NULL) {
	Tk_FreeImage(mePtr->selectImage);
    }


    if (mePtr->name != NULL) {

	Tcl_UntraceVar(menuPtr->interp, mePtr->name,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		MenuVarProc, (ClientData) mePtr);
    }
    TkpDestroyMenuEntry(mePtr);
    TkMenuEntryFreeDrawOptions(mePtr);
    Tk_FreeOptions(tkMenuEntryConfigSpecs, (char *) mePtr, menuPtr->display, 
	    (COMMAND_MASK << mePtr->type));
    ckfree((char *) mePtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * MenuWorldChanged --







|












>
>
|
>
|





|
<







1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429

1430
1431
1432
1433
1434
1435
1436
	 */

	TkPostSubmenu(menuPtr->interp, menuPtr, (TkMenuEntry *) NULL);
    }

    /*
     * Free up all the stuff that requires special handling, then
     * let Tk_FreeConfigurationOptions handle all the standard option-related
     * stuff.
     */

    if (mePtr->type == CASCADE_ENTRY) {
        UnhookCascadeEntry(mePtr);
    }
    if (mePtr->image != NULL) {
	Tk_FreeImage(mePtr->image);
    }
    if (mePtr->selectImage != NULL) {
	Tk_FreeImage(mePtr->selectImage);
    }
    if (((mePtr->type == CHECK_BUTTON_ENTRY) 
	    || (mePtr->type == RADIO_BUTTON_ENTRY))
	    && (mePtr->namePtr != NULL)) {
	char *varName = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
	Tcl_UntraceVar(menuPtr->interp, varName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		MenuVarProc, (ClientData) mePtr);
    }
    TkpDestroyMenuEntry(mePtr);
    TkMenuEntryFreeDrawOptions(mePtr);
    Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, menuPtr->tkwin);

    ckfree((char *) mePtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * MenuWorldChanged --
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294

1295
1296
1297
1298
1299
1300


1301







1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315









1316

1317
1318
1319
1320
1321

1322
1323
1324
1325
1326
1327
1328
1329
1330












1331
1332
1333
1334
1335
1336
1337
1338
1339

1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385







1386
1387
1388

1389
1390
1391
1392
1393
1394
1395
1396

1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420

1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484

1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
    TkMenuConfigureDrawOptions(menuPtr);
    for (i = 0; i < menuPtr->numEntries; i++) {
    	TkMenuConfigureEntryDrawOptions(menuPtr->entries[i],
		menuPtr->entries[i]->index);
	TkpConfigureMenuEntry(menuPtr->entries[i]);	
    }
}


/*
 *----------------------------------------------------------------------
 *
 * ConfigureMenu --
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a menu widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, font, etc. get set
 *	for menuPtr;  old resources get freed, if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureMenu(interp, menuPtr, argc, argv, flags)
    Tcl_Interp *interp;		/* Used for error reporting. */
    register TkMenu *menuPtr;	/* Information about widget;  may or may
				 * not already have values for some fields. */
    int argc;			/* Number of valid entries in argv. */
    char **argv;		/* Arguments. */
    int flags;			/* Flags to pass to Tk_ConfigureWidget. */
{
    int i;
    TkMenu* menuListPtr;

    
    for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
	    menuListPtr = menuListPtr->nextInstancePtr) {
    
	if (Tk_ConfigureWidget(interp, menuListPtr->tkwin,
		tkMenuConfigSpecs, argc, argv, (char *) menuListPtr,


		flags) != TCL_OK) {







	    return TCL_ERROR;
	}

	/*
	 * When a menu is created, the type is in all of the arguments
	 * to the menu command. Let Tk_ConfigureWidget take care of
	 * parsing them, and then set the type after we can look at
	 * the type string. Once set, a menu's type cannot be changed
	 */
	
	if (menuListPtr->menuType == UNKNOWN_TYPE) {
	    if (strcmp(menuListPtr->menuTypeName, "menubar") == 0) {
	    	menuListPtr->menuType = MENUBAR;
	    } else if (strcmp(menuListPtr->menuTypeName, "tearoff") == 0) {









	    	menuListPtr->menuType = TEAROFF_MENU;

	    } else {
	    	menuListPtr->menuType = MASTER_MENU;
	    }
	}
	

	/*
	 * Depending on the -tearOff option, make sure that there is or
	 * isn't an initial tear-off entry at the beginning of the menu.
	 */
	
	if (menuListPtr->tearOff) {
	    if ((menuListPtr->numEntries == 0)
		    || (menuListPtr->entries[0]->type != TEAROFF_ENTRY)) {
		if (MenuNewEntry(menuListPtr, 0, TEAROFF_ENTRY) == NULL) {












		    return TCL_ERROR;
		}
	    }
	} else if ((menuListPtr->numEntries > 0)
		&& (menuListPtr->entries[0]->type == TEAROFF_ENTRY)) {
	    int i;

	    Tcl_EventuallyFree((ClientData) menuListPtr->entries[0],
	    	    DestroyMenuEntry);

	    for (i = 0; i < menuListPtr->numEntries - 1; i++) {
		menuListPtr->entries[i] = menuListPtr->entries[i + 1];
		menuListPtr->entries[i]->index = i;
	    }
	    menuListPtr->numEntries--;
	    if (menuListPtr->numEntries == 0) {
		ckfree((char *) menuListPtr->entries);
		menuListPtr->entries = NULL;
	    }
	}

	TkMenuConfigureDrawOptions(menuListPtr);

	/*
	 * Configure the new window to be either a pop-up menu
	 * or a tear-off menu.
	 * We don't do this for menubars since they are not toplevel
	 * windows. Also, since this gets called before CloneMenu has
	 * a chance to set the menuType field, we have to look at the
	 * menuTypeName field to tell that this is a menu bar.
	 */
	
	if (strcmp(menuListPtr->menuTypeName, "normal") == 0) {
	    TkpMakeMenuWindow(menuListPtr->tkwin, 1);
	} else if (strcmp(menuListPtr->menuTypeName, "tearoff") == 0) {
	    TkpMakeMenuWindow(menuListPtr->tkwin, 0);
	}
	
	/*
	 * After reconfiguring a menu, we need to reconfigure all of the
	 * entries in the menu, since some of the things in the children
	 * (such as graphics contexts) may have to change to reflect changes
	 * in the parent.
	 */
	
	for (i = 0; i < menuListPtr->numEntries; i++) {
	    TkMenuEntry *mePtr;
	
	    mePtr = menuListPtr->entries[i];
	    ConfigureMenuEntry(mePtr, 0,
	    	    (char **) NULL, TK_CONFIG_ARGV_ONLY 
	    	    | COMMAND_MASK << mePtr->type);
	}
	
	TkEventuallyRecomputeMenu(menuListPtr);
    }








    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * ConfigureMenuEntry --
 *
 *	This procedure is called to process an argv/argc list in order
 *	to configure (or reconfigure) one entry in a menu.

 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information such as label and accelerator get
 *	set for mePtr;  old resources get freed, if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureMenuEntry(mePtr, argc, argv, flags)
    register TkMenuEntry *mePtr;		/* Information about menu entry;  may
					 * or may not already have values for
					 * some fields. */
    int argc;				/* Number of valid entries in argv. */
    char **argv;			/* Arguments. */
    int flags;				/* Additional flags to pass to
					 * Tk_ConfigureWidget. */
{
    TkMenu *menuPtr = mePtr->menuPtr;
    int index = mePtr->index;

    Tk_Image image;

    /*
     * If this entry is a check button or radio button, then remove
     * its old trace procedure.
     */

    if ((mePtr->name != NULL)
    	    && ((mePtr->type == CHECK_BUTTON_ENTRY)
	    || (mePtr->type == RADIO_BUTTON_ENTRY))) {
	Tcl_UntraceVar(menuPtr->interp, mePtr->name,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		MenuVarProc, (ClientData) mePtr);
    }
    
    if (menuPtr->tkwin != NULL) {
	if (Tk_ConfigureWidget(menuPtr->interp, menuPtr->tkwin, 
		tkMenuEntryConfigSpecs, argc, argv, (char *) mePtr,
		flags | (COMMAND_MASK << mePtr->type)) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    /*
     * The code below handles special configuration stuff not taken
     * care of by Tk_ConfigureWidget, such as special processing for
     * defaults, sizing strings, graphics contexts, etc.
     */

    if (mePtr->label == NULL) {
	mePtr->labelLength = 0;
    } else {
	mePtr->labelLength = strlen(mePtr->label);
    }
    if (mePtr->accel == NULL) {
	mePtr->accelLength = 0;
    } else {
	mePtr->accelLength = strlen(mePtr->accel);
    }

    /*
     * If this is a cascade entry, the platform-specific data of the child
     * menu has to be updated. Also, the links that point to parents and
     * cascades have to be updated.
     */

    if ((mePtr->type == CASCADE_ENTRY) && (mePtr->name != NULL)) {
 	TkMenuEntry *cascadeEntryPtr;
 	TkMenu *cascadeMenuPtr;
	int alreadyThere;
	TkMenuReferences *menuRefPtr;
	char *oldHashKey = NULL;	/* Initialization only needed to
					 * prevent compiler warning. */

	/*
	 * This is a cascade entry. If the menu that the cascade entry
	 * is pointing to has changed, we need to remove this entry
	 * from the list of entries pointing to the old menu, and add a
	 * cascade reference to the list of entries pointing to the
	 * new menu.
	 *
	 * BUG: We are not recloning for special case #3 yet.
	 */
	

	if (mePtr->childMenuRefPtr != NULL) {
	    oldHashKey = Tcl_GetHashKey(TkGetMenuHashTable(menuPtr->interp),
		    mePtr->childMenuRefPtr->hashEntryPtr);
	    if (strcmp(oldHashKey, mePtr->name) != 0) {
		UnhookCascadeEntry(mePtr);
	    }
	}

	if ((mePtr->childMenuRefPtr == NULL) 
		|| (strcmp(oldHashKey, mePtr->name) != 0)) {
	    menuRefPtr = TkCreateMenuReferences(menuPtr->interp,
		    mePtr->name);
	    cascadeMenuPtr = menuRefPtr->menuPtr;
	    mePtr->childMenuRefPtr = menuRefPtr;

	    if (menuRefPtr->parentEntryPtr == NULL) {
		menuRefPtr->parentEntryPtr = mePtr;
	    } else {
		alreadyThere = 0;
		for (cascadeEntryPtr = menuRefPtr->parentEntryPtr;







<












|









|



|
|
<


|
>



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











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


|
>





|



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






|


>












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












|
<
<




>
>
>
>
>
>
>



>




|

|
|
>



|









|
|
<
<
<
<
<
<



>


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






|


|

|


|








|

<















>



|





|
|
<
<







1458
1459
1460
1461
1462
1463
1464

1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492

1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586















1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599


1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638






1639
1640
1641
1642
1643
1644





















1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669

1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696


1697
1698
1699
1700
1701
1702
1703
    TkMenuConfigureDrawOptions(menuPtr);
    for (i = 0; i < menuPtr->numEntries; i++) {
    	TkMenuConfigureEntryDrawOptions(menuPtr->entries[i],
		menuPtr->entries[i]->index);
	TkpConfigureMenuEntry(menuPtr->entries[i]);	
    }
}


/*
 *----------------------------------------------------------------------
 *
 * ConfigureMenu --
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a menu widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, font, etc. get set
 *	for menuPtr;  old resources get freed, if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureMenu(interp, menuPtr, objc, objv)
    Tcl_Interp *interp;		/* Used for error reporting. */
    register TkMenu *menuPtr;	/* Information about widget;  may or may
				 * not already have values for some fields. */
    int objc;			/* Number of valid entries in argv. */
    Tcl_Obj *CONST objv[];	/* Arguments. */

{
    int i;
    TkMenu *menuListPtr, *cleanupPtr;
    int result;
    
    for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
	    menuListPtr = menuListPtr->nextInstancePtr) {
	menuListPtr->errorStructPtr = (Tk_SavedOptions *)
		ckalloc(sizeof(Tk_SavedOptions));
	result = Tk_SetOptions(interp, (char *) menuListPtr,
		menuListPtr->optionTablesPtr->menuOptionTable, objc, objv, 
		menuListPtr->tkwin, menuListPtr->errorStructPtr, (int *) NULL);
	if (result != TCL_OK) {
	    for (cleanupPtr = menuPtr->masterMenuPtr;
		    cleanupPtr != menuListPtr;
		    cleanupPtr = cleanupPtr->nextInstancePtr) {
		Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
		ckfree((char *) cleanupPtr->errorStructPtr);
		cleanupPtr->errorStructPtr = NULL;
	    }
	    return TCL_ERROR;
	}

	/*
	 * When a menu is created, the type is in all of the arguments
	 * to the menu command. Let Tk_ConfigureWidget take care of
	 * parsing them, and then set the type after we can look at
	 * the type string. Once set, a menu's type cannot be changed
	 */
	
	if (menuListPtr->menuType == UNKNOWN_TYPE) {
	    Tcl_GetIndexFromObj(NULL, menuListPtr->menuTypePtr,
		    menuTypeStrings, NULL, 0, &menuListPtr->menuType);

	    /*
	     * Configure the new window to be either a pop-up menu
	     * or a tear-off menu.
	     * We don't do this for menubars since they are not toplevel
	     * windows. Also, since this gets called before CloneMenu has
	     * a chance to set the menuType field, we have to look at the
	     * menuTypeName field to tell that this is a menu bar.
	     */
	    
	    if (menuListPtr->menuType == MASTER_MENU) {
		TkpMakeMenuWindow(menuListPtr->tkwin, 1);
	    } else if (menuListPtr->menuType == TEAROFF_MENU) {
		TkpMakeMenuWindow(menuListPtr->tkwin, 0);
	    }
	}


	/*
	 * Depending on the -tearOff option, make sure that there is or
	 * isn't an initial tear-off entry at the beginning of the menu.
	 */
	
	if (menuListPtr->tearoff) {
	    if ((menuListPtr->numEntries == 0)
		    || (menuListPtr->entries[0]->type != TEAROFF_ENTRY)) {
		if (MenuNewEntry(menuListPtr, 0, TEAROFF_ENTRY) == NULL) {
		    if (menuListPtr->errorStructPtr != NULL) {
			for (cleanupPtr = menuPtr->masterMenuPtr;
				cleanupPtr != menuListPtr;
				cleanupPtr = cleanupPtr->nextInstancePtr) {
			    Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
			    ckfree((char *) cleanupPtr->errorStructPtr);
			    cleanupPtr->errorStructPtr = NULL;
			}
			Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
			ckfree((char *) cleanupPtr->errorStructPtr);
			cleanupPtr->errorStructPtr = NULL;
		    }
		    return TCL_ERROR;
		}
	    }
	} else if ((menuListPtr->numEntries > 0)
		&& (menuListPtr->entries[0]->type == TEAROFF_ENTRY)) {
	    int i;
	    
	    Tcl_EventuallyFree((ClientData) menuListPtr->entries[0],
	    	    DestroyMenuEntry);

	    for (i = 0; i < menuListPtr->numEntries - 1; i++) {
		menuListPtr->entries[i] = menuListPtr->entries[i + 1];
		menuListPtr->entries[i]->index = i;
	    }
	    menuListPtr->numEntries--;
	    if (menuListPtr->numEntries == 0) {
		ckfree((char *) menuListPtr->entries);
		menuListPtr->entries = NULL;
	    }
	}

	TkMenuConfigureDrawOptions(menuListPtr);















	
	/*
	 * After reconfiguring a menu, we need to reconfigure all of the
	 * entries in the menu, since some of the things in the children
	 * (such as graphics contexts) may have to change to reflect changes
	 * in the parent.
	 */
	
	for (i = 0; i < menuListPtr->numEntries; i++) {
	    TkMenuEntry *mePtr;
	
	    mePtr = menuListPtr->entries[i];
	    ConfigureMenuEntry(mePtr, 0, (Tcl_Obj **) NULL);


	}
	
	TkEventuallyRecomputeMenu(menuListPtr);
    }

    for (cleanupPtr = menuPtr->masterMenuPtr; cleanupPtr != NULL;
	    cleanupPtr = cleanupPtr->nextInstancePtr) {
	Tk_FreeSavedOptions(cleanupPtr->errorStructPtr);
	ckfree((char *) cleanupPtr->errorStructPtr);
	cleanupPtr->errorStructPtr = NULL;
    }

    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * PostProcessEntry --
 *
 *	This is called by ConfigureMenuEntry to do all of the configuration
 *	after Tk_SetOptions is called. This is separate
 *	so that error handling is easier.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information such as label and accelerator get
 *	set for mePtr;  old resources get freed, if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
PostProcessEntry(mePtr)
    TkMenuEntry *mePtr;			/* The entry we are configuring. */






{
    TkMenu *menuPtr = mePtr->menuPtr;
    int index = mePtr->index;
    char *name;
    Tk_Image image;






















    /*
     * The code below handles special configuration stuff not taken
     * care of by Tk_ConfigureWidget, such as special processing for
     * defaults, sizing strings, graphics contexts, etc.
     */

    if (mePtr->labelPtr == NULL) {
	mePtr->labelLength = 0;
    } else {
	Tcl_GetStringFromObj(mePtr->labelPtr, &mePtr->labelLength);
    }
    if (mePtr->accelPtr == NULL) {
	mePtr->accelLength = 0;
    } else {
	Tcl_GetStringFromObj(mePtr->accelPtr, &mePtr->accelLength);
    }

    /*
     * If this is a cascade entry, the platform-specific data of the child
     * menu has to be updated. Also, the links that point to parents and
     * cascades have to be updated.
     */

    if ((mePtr->type == CASCADE_ENTRY) && (mePtr->namePtr != NULL)) {
 	TkMenuEntry *cascadeEntryPtr;

	int alreadyThere;
	TkMenuReferences *menuRefPtr;
	char *oldHashKey = NULL;	/* Initialization only needed to
					 * prevent compiler warning. */

	/*
	 * This is a cascade entry. If the menu that the cascade entry
	 * is pointing to has changed, we need to remove this entry
	 * from the list of entries pointing to the old menu, and add a
	 * cascade reference to the list of entries pointing to the
	 * new menu.
	 *
	 * BUG: We are not recloning for special case #3 yet.
	 */
	
	name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
	if (mePtr->childMenuRefPtr != NULL) {
	    oldHashKey = Tcl_GetHashKey(TkGetMenuHashTable(menuPtr->interp),
		    mePtr->childMenuRefPtr->hashEntryPtr);
	    if (strcmp(oldHashKey, name) != 0) {
		UnhookCascadeEntry(mePtr);
	    }
	}

	if ((mePtr->childMenuRefPtr == NULL) 
		|| (strcmp(oldHashKey, name) != 0)) {
	    menuRefPtr = TkCreateMenuReferences(menuPtr->interp, name);


	    mePtr->childMenuRefPtr = menuRefPtr;

	    if (menuRefPtr->parentEntryPtr == NULL) {
		menuRefPtr->parentEntryPtr = mePtr;
	    } else {
		alreadyThere = 0;
		for (cascadeEntryPtr = menuRefPtr->parentEntryPtr;
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578

1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591


1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604































































































































1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643


1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656


1657
1658

1659
1660
1661
1662










1663










1664

1665


1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697




1698

1699
1700
1701


1702
1703
1704
1705
1706

1707
1708



1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746

1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788

1789

1790
1791
1792
1793
1794
1795

1796
1797
1798
1799
1800
1801



1802
1803
1804
1805
1806
1807
1808
    	return TCL_ERROR;
    }

    if (TkpConfigureMenuEntry(mePtr) != TCL_OK) {
    	return TCL_ERROR;
    }
    
    if ((mePtr->type == CHECK_BUTTON_ENTRY)
	    || (mePtr->type == RADIO_BUTTON_ENTRY)) {
	char *value;

	if (mePtr->name == NULL) {
	    mePtr->name =
		    (char *) ckalloc((unsigned) (mePtr->labelLength + 1));
	    strcpy(mePtr->name, (mePtr->label == NULL) ? "" : mePtr->label);
	}
	if (mePtr->onValue == NULL) {
	    mePtr->onValue = (char *) ckalloc((unsigned)
		    (mePtr->labelLength + 1));
	    strcpy(mePtr->onValue, (mePtr->label == NULL) ? "" : mePtr->label);
	}

	/*
	 * Select the entry if the associated variable has the
	 * appropriate value, initialize the variable if it doesn't
	 * exist, then set a trace on the variable to monitor future
	 * changes to its value.
	 */

	value = Tcl_GetVar(menuPtr->interp, mePtr->name, TCL_GLOBAL_ONLY);
	mePtr->entryFlags &= ~ENTRY_SELECTED;
	if (value != NULL) {
	    if (strcmp(value, mePtr->onValue) == 0) {
		mePtr->entryFlags |= ENTRY_SELECTED;
	    }
	} else {
	    Tcl_SetVar(menuPtr->interp, mePtr->name,
		    (mePtr->type == CHECK_BUTTON_ENTRY) ? mePtr->offValue : "",
		    TCL_GLOBAL_ONLY);
	}
	Tcl_TraceVar(menuPtr->interp, mePtr->name,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		MenuVarProc, (ClientData) mePtr);
    }

    /*
     * Get the images for the entry, if there are any.  Allocate the
     * new images before freeing the old ones, so that the reference
     * counts don't go to zero and cause image data to be discarded.
     */

    if (mePtr->imageString != NULL) {

	image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, mePtr->imageString,
		TkMenuImageProc, (ClientData) mePtr);
	if (image == NULL) {
	    return TCL_ERROR;
	}
    } else {
	image = NULL;
    }
    if (mePtr->image != NULL) {
	Tk_FreeImage(mePtr->image);
    }
    mePtr->image = image;
    if (mePtr->selectImageString != NULL) {


	image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, mePtr->selectImageString,
		TkMenuSelectImageProc, (ClientData) mePtr);
	if (image == NULL) {
	    return TCL_ERROR;
	}
    } else {
	image = NULL;
    }
    if (mePtr->selectImage != NULL) {
	Tk_FreeImage(mePtr->selectImage);
    }
    mePtr->selectImage = image;
































































































































    TkEventuallyRecomputeMenu(menuPtr);
    
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureMenuCloneEntries --
 *
 *	Calls ConfigureMenuEntry for each menu in the clone chain.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information such as label and accelerator get
 *	set for mePtr;  old resources get freed, if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
    Tcl_Interp *interp;			/* Used for error reporting. */
    TkMenu *menuPtr;			/* Information about whole menu. */
    int index;				/* Index of mePtr within menuPtr's
					 * entries. */
    int argc;				/* Number of valid entries in argv. */
    char **argv;			/* Arguments. */
    int flags;				/* Additional flags to pass to
					 * Tk_ConfigureWidget. */
{
    TkMenuEntry *mePtr;
    TkMenu *menuListPtr;
    char *oldCascadeName = NULL, *newMenuName = NULL;
    int cascadeEntryChanged;
    TkMenuReferences *oldCascadeMenuRefPtr, *cascadeMenuRefPtr = NULL; 


    
    /*
     * Cascades are kind of tricky here. This is special case #3 in the comment
     * at the top of this file. Basically, if a menu is the master menu of a
     * clone chain, and has an entry with a cascade menu, the clones of
     * the menu will point to clones of the cascade menu. We have
     * to destroy the clones of the cascades, clone the new cascade
     * menu, and configure the entry to point to the new clone.
     */

    mePtr = menuPtr->masterMenuPtr->entries[index];
    if (mePtr->type == CASCADE_ENTRY) {
	oldCascadeName = mePtr->name;


    }


    if (ConfigureMenuEntry(mePtr, argc, argv, flags) != TCL_OK) {
	return TCL_ERROR;
    }











    cascadeEntryChanged = (mePtr->type == CASCADE_ENTRY)










	    && (oldCascadeName != mePtr->name);




    if (cascadeEntryChanged) {
	newMenuName = mePtr->name;
	if (newMenuName != NULL) {
	    cascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp,
		    mePtr->name);
	}
    }

    for (menuListPtr = menuPtr->masterMenuPtr->nextInstancePtr; 
    	    menuListPtr != NULL;
	    menuListPtr = menuListPtr->nextInstancePtr) {
  	
    	mePtr = menuListPtr->entries[index];

	if (cascadeEntryChanged && (mePtr->name != NULL)) {
	    oldCascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp, 
		    mePtr->name);

	    if ((oldCascadeMenuRefPtr != NULL)
		    && (oldCascadeMenuRefPtr->menuPtr != NULL)) {
		RecursivelyDeleteMenu(oldCascadeMenuRefPtr->menuPtr);
	    }
	}

    	if (ConfigureMenuEntry(mePtr, argc, argv, flags) != TCL_OK) {
    	    return TCL_ERROR;
    	}
	
	if (cascadeEntryChanged && (newMenuName != NULL)) {
	    if (cascadeMenuRefPtr->menuPtr != NULL) {
		char *newArgV[2];
		char *newCloneName;






		newCloneName = TkNewMenuName(menuPtr->interp,
			Tk_PathName(menuListPtr->tkwin), 
			cascadeMenuRefPtr->menuPtr);


		CloneMenu(cascadeMenuRefPtr->menuPtr, newCloneName,
			"normal");

		newArgV[0] = "-menu";
		newArgV[1] = newCloneName;

		ConfigureMenuEntry(mePtr, 2, newArgV, flags);
		ckfree(newCloneName);



	    }
	}
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * TkGetMenuIndex --
 *
 *	Parse a textual index into a menu and return the numerical
 *	index of the indicated entry.
 *
 * Results:
 *	A standard Tcl result.  If all went well, then *indexPtr is
 *	filled in with the entry index corresponding to string
 *	(ranges from -1 to the number of entries in the menu minus
 *	one).  Otherwise an error message is left in interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

int
TkGetMenuIndex(interp, menuPtr, string, lastOK, indexPtr)
    Tcl_Interp *interp;		/* For error messages. */
    TkMenu *menuPtr;		/* Menu for which the index is being
				 * specified. */
    char *string;		/* Specification of an entry in menu.  See
				 * manual entry for valid .*/
    int lastOK;			/* Non-zero means its OK to return index
				 * just *after* last entry. */
    int *indexPtr;		/* Where to store converted relief. */
{
    int i;


    if ((string[0] == 'a') && (strcmp(string, "active") == 0)) {
	*indexPtr = menuPtr->active;
	return TCL_OK;
    }

    if (((string[0] == 'l') && (strcmp(string, "last") == 0))
	    || ((string[0] == 'e') && (strcmp(string, "end") == 0))) {
	*indexPtr = menuPtr->numEntries - ((lastOK) ? 0 : 1);
	return TCL_OK;
    }

    if ((string[0] == 'n') && (strcmp(string, "none") == 0)) {
	*indexPtr = -1;
	return TCL_OK;
    }

    if (string[0] == '@') {
	if (GetIndexFromCoords(interp, menuPtr, string, indexPtr)
		== TCL_OK) {
	    return TCL_OK;
	}
    }

    if (isdigit(UCHAR(string[0]))) {
	if (Tcl_GetInt(interp, string,  &i) == TCL_OK) {
	    if (i >= menuPtr->numEntries) {
		if (lastOK) {
		    i = menuPtr->numEntries;
		} else {
		    i = menuPtr->numEntries-1;
		}
	    } else if (i < 0) {
		i = -1;
	    }
	    *indexPtr = i;
	    return TCL_OK;
	}
	Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
    }

    for (i = 0; i < menuPtr->numEntries; i++) {

	char *label;


	label = menuPtr->entries[i]->label;
	if ((label != NULL)
		&& (Tcl_StringMatch(menuPtr->entries[i]->label, string))) {
	    *indexPtr = i;
	    return TCL_OK;

	}
    }

    Tcl_AppendResult(interp, "bad menu entry index \"",
	    string, "\"", (char *) NULL);
    return TCL_ERROR;



}

/*
 *----------------------------------------------------------------------
 *
 * MenuCmdDeletedProc --
 *







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






|
>
|











|
>
>
|












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


|











|









|




|
|
<
<



<
|

>
>
|











|
>
>
|
|
>
|



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

|
|

|









|
|
|







|



|

|
|
>
>
>
>

>
|
|

>
>
|
|

|
|
>
|
|
>
>
>


















|








|



|



|


>



|





|




|





|















|





>
|
>
|
<

|

<
>






>
>
>







1726
1727
1728
1729
1730
1731
1732






































1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926


1927
1928
1929

1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120

2121
2122
2123

2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
    	return TCL_ERROR;
    }

    if (TkpConfigureMenuEntry(mePtr) != TCL_OK) {
    	return TCL_ERROR;
    }
    






































    /*
     * Get the images for the entry, if there are any.  Allocate the
     * new images before freeing the old ones, so that the reference
     * counts don't go to zero and cause image data to be discarded.
     */

    if (mePtr->imagePtr != NULL) {
	char *imageString = Tcl_GetStringFromObj(mePtr->imagePtr, NULL);
	image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, imageString,
		TkMenuImageProc, (ClientData) mePtr);
	if (image == NULL) {
	    return TCL_ERROR;
	}
    } else {
	image = NULL;
    }
    if (mePtr->image != NULL) {
	Tk_FreeImage(mePtr->image);
    }
    mePtr->image = image;
    if (mePtr->selectImagePtr != NULL) {
	char *selectImageString = Tcl_GetStringFromObj(
		mePtr->selectImagePtr, NULL);
	image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, selectImageString,
		TkMenuSelectImageProc, (ClientData) mePtr);
	if (image == NULL) {
	    return TCL_ERROR;
	}
    } else {
	image = NULL;
    }
    if (mePtr->selectImage != NULL) {
	Tk_FreeImage(mePtr->selectImage);
    }
    mePtr->selectImage = image;

    if ((mePtr->type == CHECK_BUTTON_ENTRY)
	    || (mePtr->type == RADIO_BUTTON_ENTRY)) {
	Tcl_Obj *valuePtr;
	char *name;

	if (mePtr->namePtr == NULL) {
	    if (mePtr->labelPtr == NULL) {
		mePtr->namePtr = NULL;
	    } else {
		mePtr->namePtr = Tcl_DuplicateObj(mePtr->labelPtr);
		Tcl_IncrRefCount(mePtr->namePtr);
	    }
	}
	if (mePtr->onValuePtr == NULL) {
	    if (mePtr->labelPtr == NULL) {
		mePtr->onValuePtr = NULL;
	    } else {
		mePtr->onValuePtr = Tcl_DuplicateObj(mePtr->labelPtr);
		Tcl_IncrRefCount(mePtr->onValuePtr);
	    }
	}

	/*
	 * Select the entry if the associated variable has the
	 * appropriate value, initialize the variable if it doesn't
	 * exist, then set a trace on the variable to monitor future
	 * changes to its value.
	 */
	
	if (mePtr->namePtr != NULL) {
	    valuePtr = Tcl_ObjGetVar2(menuPtr->interp, mePtr->namePtr, NULL,
		    TCL_GLOBAL_ONLY);
	} else {
	    valuePtr = NULL;
	}
	mePtr->entryFlags &= ~ENTRY_SELECTED;
	if (valuePtr != NULL) {
	    if (mePtr->onValuePtr != NULL) {
		char *value = Tcl_GetStringFromObj(valuePtr, NULL);
		char *onValue = Tcl_GetStringFromObj(mePtr->onValuePtr,
			NULL);


		if (strcmp(value, onValue) == 0) {
		    mePtr->entryFlags |= ENTRY_SELECTED;
		}
	    }
	} else {
	    if (mePtr->namePtr != NULL) {
		Tcl_ObjSetVar2(menuPtr->interp, mePtr->namePtr, NULL,
			(mePtr->type == CHECK_BUTTON_ENTRY)
			? mePtr->offValuePtr
			: Tcl_NewObj(),
			TCL_GLOBAL_ONLY);
	    }
	}
	if (mePtr->namePtr != NULL) {
	    name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
	    Tcl_TraceVar(menuPtr->interp, name,
		    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		    MenuVarProc, (ClientData) mePtr);
	}
    }
    
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureMenuEntry --
 *
 *	This procedure is called to process an argv/argc list in order
 *	to configure (or reconfigure) one entry in a menu.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information such as label and accelerator get
 *	set for mePtr;  old resources get freed, if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureMenuEntry(mePtr, objc, objv)
    register TkMenuEntry *mePtr;	/* Information about menu entry;  may
					 * or may not already have values for
					 * some fields. */
    int objc;				/* Number of valid entries in argv. */
    Tcl_Obj *CONST objv[];		/* Arguments. */
{
    TkMenu *menuPtr = mePtr->menuPtr;
    Tk_SavedOptions errorStruct;
    int result;

    /*
     * If this entry is a check button or radio button, then remove
     * its old trace procedure.
     */

    if ((mePtr->namePtr != NULL)
    	    && ((mePtr->type == CHECK_BUTTON_ENTRY)
	    || (mePtr->type == RADIO_BUTTON_ENTRY))) {
	char *name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
	Tcl_UntraceVar(menuPtr->interp, name,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		MenuVarProc, (ClientData) mePtr);
    }

    result = TCL_OK;
    if (menuPtr->tkwin != NULL) {
	if (Tk_SetOptions(menuPtr->interp, (char *) mePtr,
		mePtr->optionTable, objc, objv, menuPtr->tkwin,
		&errorStruct, (int *) NULL) != TCL_OK) {
	    return TCL_ERROR;
	}
	result = PostProcessEntry(mePtr);
	if (result != TCL_OK) {
	    Tk_RestoreSavedOptions(&errorStruct);
	    PostProcessEntry(mePtr);
	}
	Tk_FreeSavedOptions(&errorStruct);
    }

    TkEventuallyRecomputeMenu(menuPtr);
    
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureMenuCloneEntries --
 *
 *	Calls ConfigureMenuEntry for each menu in the clone chain.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information such as label and accelerator get
 *	set for mePtr;  old resources get freed, if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureMenuCloneEntries(interp, menuPtr, index, objc, objv)
    Tcl_Interp *interp;			/* Used for error reporting. */
    TkMenu *menuPtr;			/* Information about whole menu. */
    int index;				/* Index of mePtr within menuPtr's
					 * entries. */
    int objc;				/* Number of valid entries in argv. */
    Tcl_Obj *CONST objv[];		/* Arguments. */


{
    TkMenuEntry *mePtr;
    TkMenu *menuListPtr;

    int cascadeEntryChanged = 0;
    TkMenuReferences *oldCascadeMenuRefPtr, *cascadeMenuRefPtr = NULL; 
    Tcl_Obj *oldCascadePtr = NULL;
    char *newCascadeName;

    /*
     * Cascades are kind of tricky here. This is special case #3 in the comment
     * at the top of this file. Basically, if a menu is the master menu of a
     * clone chain, and has an entry with a cascade menu, the clones of
     * the menu will point to clones of the cascade menu. We have
     * to destroy the clones of the cascades, clone the new cascade
     * menu, and configure the entry to point to the new clone.
     */

    mePtr = menuPtr->masterMenuPtr->entries[index];
    if (mePtr->type == CASCADE_ENTRY) {
	oldCascadePtr = mePtr->namePtr;
	if (oldCascadePtr != NULL) {
	    Tcl_IncrRefCount(oldCascadePtr);
	}
    }

    if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) {
	return TCL_ERROR;
    }

    if (mePtr->type == CASCADE_ENTRY) {
	char *oldCascadeName;

	if (mePtr->namePtr != NULL) {
	    newCascadeName = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
	} else {
	    newCascadeName = NULL;
	}
 
	if ((oldCascadePtr == NULL) && (mePtr->namePtr == NULL)) {
	    cascadeEntryChanged = 0;
	} else if (((oldCascadePtr == NULL) && (mePtr->namePtr != NULL))
		|| ((oldCascadePtr != NULL) 
		&& (mePtr->namePtr == NULL))) {
	    cascadeEntryChanged = 1;
	} else {
	    oldCascadeName = Tcl_GetStringFromObj(oldCascadePtr,
		    NULL);
	    cascadeEntryChanged = (strcmp(oldCascadeName, newCascadeName) 
		    == 0);
	}
	if (oldCascadePtr != NULL) {
	    Tcl_DecrRefCount(oldCascadePtr);
	}
    }

    if (cascadeEntryChanged) {
	if (mePtr->namePtr != NULL) {
	    newCascadeName = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
	    cascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp,
		    newCascadeName);
	}
    }

    for (menuListPtr = menuPtr->masterMenuPtr->nextInstancePtr; 
    	    menuListPtr != NULL;
	    menuListPtr = menuListPtr->nextInstancePtr) {
  	
    	mePtr = menuListPtr->entries[index];

	if (cascadeEntryChanged && (mePtr->namePtr != NULL)) {
	    oldCascadeMenuRefPtr = TkFindMenuReferencesObj(menuPtr->interp, 
		    mePtr->namePtr);

	    if ((oldCascadeMenuRefPtr != NULL)
		    && (oldCascadeMenuRefPtr->menuPtr != NULL)) {
		RecursivelyDeleteMenu(oldCascadeMenuRefPtr->menuPtr);
	    }
	}

    	if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) {
    	    return TCL_ERROR;
    	}
	
	if (cascadeEntryChanged && (mePtr->namePtr != NULL)) {
	    if (cascadeMenuRefPtr->menuPtr != NULL) {
		Tcl_Obj *newObjv[2];
		Tcl_Obj *newCloneNamePtr;
		Tcl_Obj *pathNamePtr = Tcl_NewStringObj(
			Tk_PathName(menuListPtr->tkwin), -1);
		Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
		Tcl_Obj *menuObjPtr = Tcl_NewStringObj("-menu", -1);

		Tcl_IncrRefCount(pathNamePtr);
		newCloneNamePtr = TkNewMenuName(menuPtr->interp,
			pathNamePtr, 
			cascadeMenuRefPtr->menuPtr);
		Tcl_IncrRefCount(newCloneNamePtr);
		Tcl_IncrRefCount(normalPtr);
		CloneMenu(cascadeMenuRefPtr->menuPtr, newCloneNamePtr,
			normalPtr);

		newObjv[0] = menuObjPtr;
		newObjv[1] = newCloneNamePtr;
		Tcl_IncrRefCount(menuObjPtr);
		ConfigureMenuEntry(mePtr, 2, newObjv);
		Tcl_DecrRefCount(newCloneNamePtr);
		Tcl_DecrRefCount(pathNamePtr);
		Tcl_DecrRefCount(normalPtr);
		Tcl_DecrRefCount(menuObjPtr);
	    }
	}
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * TkGetMenuIndex --
 *
 *	Parse a textual index into a menu and return the numerical
 *	index of the indicated entry.
 *
 * Results:
 *	A standard Tcl result.  If all went well, then *indexPtr is
 *	filled in with the entry index corresponding to string
 *	(ranges from -1 to the number of entries in the menu minus
 *	one).  Otherwise an error message is left in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

int
TkGetMenuIndex(interp, menuPtr, objPtr, lastOK, indexPtr)
    Tcl_Interp *interp;		/* For error messages. */
    TkMenu *menuPtr;		/* Menu for which the index is being
				 * specified. */
    Tcl_Obj *objPtr;		/* Specification of an entry in menu.  See
				 * manual entry for valid .*/
    int lastOK;			/* Non-zero means its OK to return index
				 * just *after* last entry. */
    int *indexPtr;		/* Where to store converted index. */
{
    int i;
    char *string = Tcl_GetStringFromObj(objPtr, NULL);

    if ((string[0] == 'a') && (strcmp(string, "active") == 0)) {
	*indexPtr = menuPtr->active;
	goto success;
    }

    if (((string[0] == 'l') && (strcmp(string, "last") == 0))
	    || ((string[0] == 'e') && (strcmp(string, "end") == 0))) {
	*indexPtr = menuPtr->numEntries - ((lastOK) ? 0 : 1);
	goto success;
    }

    if ((string[0] == 'n') && (strcmp(string, "none") == 0)) {
	*indexPtr = -1;
	goto success;
    }

    if (string[0] == '@') {
	if (GetIndexFromCoords(interp, menuPtr, string, indexPtr)
		== TCL_OK) {
	    goto success;
	}
    }

    if (isdigit(UCHAR(string[0]))) {
	if (Tcl_GetInt(interp, string,  &i) == TCL_OK) {
	    if (i >= menuPtr->numEntries) {
		if (lastOK) {
		    i = menuPtr->numEntries;
		} else {
		    i = menuPtr->numEntries-1;
		}
	    } else if (i < 0) {
		i = -1;
	    }
	    *indexPtr = i;
	    goto success;
	}
	Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
    }

    for (i = 0; i < menuPtr->numEntries; i++) {
	Tcl_Obj *labelPtr = menuPtr->entries[i]->labelPtr;
	char *label = (labelPtr == NULL) ? NULL
	        : Tcl_GetStringFromObj(labelPtr, NULL);
	

	if ((label != NULL)
		&& (Tcl_StringMatch(label, string))) {
	    *indexPtr = i;

	    goto success;
	}
    }

    Tcl_AppendResult(interp, "bad menu entry index \"",
	    string, "\"", (char *) NULL);
    return TCL_ERROR;

success:
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * MenuCmdDeletedProc --
 *
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
     * This procedure could be invoked either because the window was
     * destroyed and the command was then deleted (in which case tkwin
     * is NULL) or because the command was deleted, and then this procedure
     * destroys the widget.
     */

    if (tkwin != NULL) {
	menuPtr->tkwin = NULL;
	Tk_DestroyWindow(tkwin);
    }
}

/*
 *----------------------------------------------------------------------
 *







<







2162
2163
2164
2165
2166
2167
2168

2169
2170
2171
2172
2173
2174
2175
     * This procedure could be invoked either because the window was
     * destroyed and the command was then deleted (in which case tkwin
     * is NULL) or because the command was deleted, and then this procedure
     * destroys the widget.
     */

    if (tkwin != NULL) {

	Tk_DestroyWindow(tkwin);
    }
}

/*
 *----------------------------------------------------------------------
 *
1886
1887
1888
1889
1890
1891
1892

1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921





1922
1923


1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
	ckfree((char *) menuPtr->entries);
    }
    menuPtr->entries = newEntries;
    menuPtr->numEntries++;
    mePtr = (TkMenuEntry *) ckalloc(sizeof(TkMenuEntry));
    menuPtr->entries[index] = mePtr;
    mePtr->type = type;

    mePtr->menuPtr = menuPtr;
    mePtr->label = NULL;
    mePtr->labelLength = 0;
    mePtr->underline = -1;
    mePtr->bitmap = None;
    mePtr->imageString = NULL;
    mePtr->image = NULL;
    mePtr->selectImageString  = NULL;
    mePtr->selectImage = NULL;
    mePtr->accel = NULL;
    mePtr->accelLength = 0;
    mePtr->state = tkNormalUid;
    mePtr->border = NULL;
    mePtr->fg = NULL;
    mePtr->activeBorder = NULL;
    mePtr->activeFg = NULL;
    mePtr->tkfont = NULL;
    mePtr->indicatorOn = 1;
    mePtr->indicatorFg = NULL;
    mePtr->columnBreak = 0;
    mePtr->hideMargin = 0;
    mePtr->command = NULL;
    mePtr->name = NULL;
    mePtr->childMenuRefPtr = NULL;
    mePtr->onValue = NULL;
    mePtr->offValue = NULL;
    mePtr->entryFlags = 0;
    mePtr->index = index;
    mePtr->nextCascadePtr = NULL;





    TkMenuInitializeEntryDrawingFields(mePtr);
    if (TkpMenuNewEntry(mePtr) != TCL_OK) {


    	ckfree((char *) mePtr);
    	return NULL;
    }
    
    return mePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * MenuAddOrInsert --







>

|


|
|

|

|

|
|
|
|
|
|
|
|


|
|

|
|



>
>
>
>
>


>
>



|







2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
	ckfree((char *) menuPtr->entries);
    }
    menuPtr->entries = newEntries;
    menuPtr->numEntries++;
    mePtr = (TkMenuEntry *) ckalloc(sizeof(TkMenuEntry));
    menuPtr->entries[index] = mePtr;
    mePtr->type = type;
    mePtr->optionTable = menuPtr->optionTablesPtr->entryOptionTables[type];
    mePtr->menuPtr = menuPtr;
    mePtr->labelPtr = NULL;
    mePtr->labelLength = 0;
    mePtr->underline = -1;
    mePtr->bitmapPtr = NULL;
    mePtr->imagePtr = NULL;
    mePtr->image = NULL;
    mePtr->selectImagePtr = NULL;
    mePtr->selectImage = NULL;
    mePtr->accelPtr = NULL;
    mePtr->accelLength = 0;
    mePtr->state = ENTRY_DISABLED;
    mePtr->borderPtr = NULL;
    mePtr->fgPtr = NULL;
    mePtr->activeBorderPtr = NULL;
    mePtr->activeFgPtr = NULL;
    mePtr->fontPtr = NULL;
    mePtr->indicatorOn = 0;
    mePtr->indicatorFgPtr = NULL;
    mePtr->columnBreak = 0;
    mePtr->hideMargin = 0;
    mePtr->commandPtr = NULL;
    mePtr->namePtr = NULL;
    mePtr->childMenuRefPtr = NULL;
    mePtr->onValuePtr = NULL;
    mePtr->offValuePtr = NULL;
    mePtr->entryFlags = 0;
    mePtr->index = index;
    mePtr->nextCascadePtr = NULL;
    if (Tk_InitOptions(menuPtr->interp, (char *) mePtr,
	    mePtr->optionTable, menuPtr->tkwin) != TCL_OK) {
	ckfree((char *) mePtr);
	return NULL;
    }
    TkMenuInitializeEntryDrawingFields(mePtr);
    if (TkpMenuNewEntry(mePtr) != TCL_OK) {
	Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable,
		menuPtr->tkwin);
    	ckfree((char *) mePtr);
    	return NULL;
    }

    return mePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * MenuAddOrInsert --
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974

1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
 * Side effects:
 *	A new menu entry is created in menuPtr.
 *
 *----------------------------------------------------------------------
 */

static int
MenuAddOrInsert(interp, menuPtr, indexString, argc, argv)
    Tcl_Interp *interp;			/* Used for error reporting. */
    TkMenu *menuPtr;			/* Widget in which to create new
					 * entry. */
    char *indexString;			/* String describing index at which
					 * to insert.  NULL means insert at
					 * end. */
    int argc;				/* Number of elements in argv. */
    char **argv;			/* Arguments to command:  first arg
					 * is type of entry, others are
					 * config options. */
{
    int c, type, index;
    size_t length;
    TkMenuEntry *mePtr;
    TkMenu *menuListPtr;

    if (indexString != NULL) {
	if (TkGetMenuIndex(interp, menuPtr, indexString, 1, &index)
		!= TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	index = menuPtr->numEntries;
    }
    if (index < 0) {

	Tcl_AppendResult(interp, "bad index \"", indexString, "\"",
		 (char *) NULL);
	return TCL_ERROR;
    }
    if (menuPtr->tearOff && (index == 0)) {
	index = 1;
    }

    /*
     * Figure out the type of the new entry.
     */

    c = argv[0][0];
    length = strlen(argv[0]);
    if ((c == 'c') && (strncmp(argv[0], "cascade", length) == 0)
	    && (length >= 2)) {
	type = CASCADE_ENTRY;
    } else if ((c == 'c') && (strncmp(argv[0], "checkbutton", length) == 0)
	    && (length >= 2)) {
	type = CHECK_BUTTON_ENTRY;
    } else if ((c == 'c') && (strncmp(argv[0], "command", length) == 0)
	    && (length >= 2)) {
	type = COMMAND_ENTRY;
    } else if ((c == 'r')
	    && (strncmp(argv[0], "radiobutton", length) == 0)) {
	type = RADIO_BUTTON_ENTRY;
    } else if ((c == 's')
	    && (strncmp(argv[0], "separator", length) == 0)) {
	type = SEPARATOR_ENTRY;
    } else {
	Tcl_AppendResult(interp, "bad menu entry type \"",
		argv[0], "\": must be cascade, checkbutton, ",
		"command, radiobutton, or separator", (char *) NULL);
	return TCL_ERROR;
    }
    
    /*
     * Now we have to add an entry for every instance related to this menu.
     */

    for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL; 
    	    menuListPtr = menuListPtr->nextInstancePtr) {
    	
    	mePtr = MenuNewEntry(menuListPtr, index, type);
    	if (mePtr == NULL) {
    	    return TCL_ERROR;
    	}
    	if (ConfigureMenuEntry(mePtr, argc-1, argv+1, 0) != TCL_OK) {
	    TkMenu *errorMenuPtr;
	    int i; 

	    for (errorMenuPtr = menuPtr->masterMenuPtr;
		    errorMenuPtr != NULL;
		    errorMenuPtr = errorMenuPtr->nextInstancePtr) {
    		Tcl_EventuallyFree((ClientData) errorMenuPtr->entries[index],
    	    		DestroyMenuEntry);
		for (i = index; i < errorMenuPtr->numEntries - 1; i++) {







|



|


|
|



|
<



|
|







>




|







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


|











|

|







2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300

2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325















2326


2327


2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
 * Side effects:
 *	A new menu entry is created in menuPtr.
 *
 *----------------------------------------------------------------------
 */

static int
MenuAddOrInsert(interp, menuPtr, indexPtr, objc, objv)
    Tcl_Interp *interp;			/* Used for error reporting. */
    TkMenu *menuPtr;			/* Widget in which to create new
					 * entry. */
    Tcl_Obj *indexPtr;			/* Object describing index at which
					 * to insert.  NULL means insert at
					 * end. */
    int objc;				/* Number of elements in objv. */
    Tcl_Obj *CONST objv[];		/* Arguments to command:  first arg
					 * is type of entry, others are
					 * config options. */
{
    int type, index;

    TkMenuEntry *mePtr;
    TkMenu *menuListPtr;

    if (indexPtr != NULL) {
	if (TkGetMenuIndex(interp, menuPtr, indexPtr, 1, &index)
		!= TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	index = menuPtr->numEntries;
    }
    if (index < 0) {
	char *indexString = Tcl_GetStringFromObj(indexPtr, NULL);
	Tcl_AppendResult(interp, "bad index \"", indexString, "\"",
		 (char *) NULL);
	return TCL_ERROR;
    }
    if (menuPtr->tearoff && (index == 0)) {
	index = 1;
    }

    /*
     * Figure out the type of the new entry.
     */
















    if (Tcl_GetIndexFromObj(interp, objv[0], menuEntryTypeStrings,


	    "menu entry type", 0, &type) != TCL_OK) {


	return TCL_ERROR;
    }

    /*
     * Now we have to add an entry for every instance related to this menu.
     */

    for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL; 
    	    menuListPtr = menuListPtr->nextInstancePtr) {
    	
    	mePtr = MenuNewEntry(menuListPtr, index, type);
    	if (mePtr == NULL) {
    	    return TCL_ERROR;
    	}
    	if (ConfigureMenuEntry(mePtr, objc - 1, objv + 1) != TCL_OK) {
	    TkMenu *errorMenuPtr;
	    int i;

	    for (errorMenuPtr = menuPtr->masterMenuPtr;
		    errorMenuPtr != NULL;
		    errorMenuPtr = errorMenuPtr->nextInstancePtr) {
    		Tcl_EventuallyFree((ClientData) errorMenuPtr->entries[index],
    	    		DestroyMenuEntry);
		for (i = index; i < errorMenuPtr->numEntries - 1; i++) {
2050
2051
2052
2053
2054
2055
2056

2057
2058
2059
2060
2061




2062
2063
2064

2065
2066
2067


2068
2069
2070
2071
2072
2073
2074
2075
2076


2077
2078



2079
2080
2081
2082
2083
2084
2085
	 * entry to a menu with clones means that the menu that the
	 * entry points to has to be cloned for every clone the
	 * master menu has. This is special case #2 in the comment
	 * at the top of this file.
    	 */
 
    	if ((menuPtr != menuListPtr) && (type == CASCADE_ENTRY)) {    	    

    	    if ((mePtr->name != NULL)  && (mePtr->childMenuRefPtr != NULL)
    	    	    && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
    	        TkMenu *cascadeMenuPtr =
			mePtr->childMenuRefPtr->menuPtr->masterMenuPtr;
    	        char *newCascadeName;




  		char *newArgv[2];
		TkMenuReferences *menuRefPtr;
    	            

		newCascadeName = TkNewMenuName(menuListPtr->interp,
			Tk_PathName(menuListPtr->tkwin),
			cascadeMenuPtr);


		CloneMenu(cascadeMenuPtr, newCascadeName, "normal");
		
		menuRefPtr = TkFindMenuReferences(menuListPtr->interp,
			newCascadeName);
		if (menuRefPtr == NULL) {
		    panic("CloneMenu failed inside of MenuAddOrInsert.");
		}
		newArgv[0] = "-menu";
		newArgv[1] = newCascadeName;


    	        ConfigureMenuEntry(mePtr, 2, newArgv, 0);
    	        ckfree(newCascadeName);



    	    }
    	}
    }
    return TCL_OK;
}

/*







>
|



|
>
>
>
>
|

|
>
|
<
|
>
>
|

|
|



|
|
>
>
|
|
>
>
>







2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391

2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
	 * entry to a menu with clones means that the menu that the
	 * entry points to has to be cloned for every clone the
	 * master menu has. This is special case #2 in the comment
	 * at the top of this file.
    	 */
 
    	if ((menuPtr != menuListPtr) && (type == CASCADE_ENTRY)) {    	    
    	    if ((mePtr->namePtr != NULL)
		    && (mePtr->childMenuRefPtr != NULL)
    	    	    && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
    	        TkMenu *cascadeMenuPtr =
			mePtr->childMenuRefPtr->menuPtr->masterMenuPtr;
    	        Tcl_Obj *newCascadePtr;
		Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1);
		Tcl_Obj *windowNamePtr = 
			Tcl_NewStringObj(Tk_PathName(menuListPtr->tkwin), -1);
		Tcl_Obj *normalPtr = Tcl_NewStringObj("normal", -1);
  		Tcl_Obj *newObjv[2];
		TkMenuReferences *menuRefPtr;
    	          
		Tcl_IncrRefCount(windowNamePtr);
		newCascadePtr = TkNewMenuName(menuListPtr->interp,

			windowNamePtr, cascadeMenuPtr);
		Tcl_IncrRefCount(newCascadePtr);
		Tcl_IncrRefCount(normalPtr);
		CloneMenu(cascadeMenuPtr, newCascadePtr, normalPtr);
		
		menuRefPtr = TkFindMenuReferencesObj(menuListPtr->interp,
			newCascadePtr);
		if (menuRefPtr == NULL) {
		    panic("CloneMenu failed inside of MenuAddOrInsert.");
		}
		newObjv[0] = menuNamePtr;
		newObjv[1] = newCascadePtr;
		Tcl_IncrRefCount(menuNamePtr);
		Tcl_IncrRefCount(newCascadePtr);
    	        ConfigureMenuEntry(mePtr, 2, newObjv);
    	        Tcl_DecrRefCount(newCascadePtr);
		Tcl_DecrRefCount(menuNamePtr);
		Tcl_DecrRefCount(windowNamePtr);
		Tcl_DecrRefCount(normalPtr);
    	    }
    	}
    }
    return TCL_OK;
}

/*
2108
2109
2110
2111
2112
2113
2114


2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143


2144
2145
2146
2147
2148
2149
2150



2151
2152
2153
2154
2155
2156
2157
    char *name1;		/* First part of variable's name. */
    char *name2;		/* Second part of variable's name. */
    int flags;			/* Describes what just happened. */
{
    TkMenuEntry *mePtr = (TkMenuEntry *) clientData;
    TkMenu *menuPtr;
    char *value;



    menuPtr = mePtr->menuPtr;

    /*
     * If the variable is being unset, then re-establish the
     * trace unless the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	mePtr->entryFlags &= ~ENTRY_SELECTED;
	if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
	    Tcl_TraceVar(interp, mePtr->name,
		    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		    MenuVarProc, clientData);
	}
	TkpConfigureMenuEntry(mePtr);
	TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
	return (char *) NULL;
    }

    /*
     * Use the value of the variable to update the selected status of
     * the menu entry.
     */

    value = Tcl_GetVar(interp, mePtr->name, TCL_GLOBAL_ONLY);
    if (value == NULL) {
	value = "";
    }


    if (strcmp(value, mePtr->onValue) == 0) {
	if (mePtr->entryFlags & ENTRY_SELECTED) {
	    return (char *) NULL;
	}
	mePtr->entryFlags |= ENTRY_SELECTED;
    } else if (mePtr->entryFlags & ENTRY_SELECTED) {
	mePtr->entryFlags &= ~ENTRY_SELECTED;



    } else {
	return (char *) NULL;
    }
    TkpConfigureMenuEntry(mePtr);
    TkEventuallyRedrawMenu(menuPtr, mePtr);
    return (char *) NULL;
}







>
>











|













|



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







2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
    char *name1;		/* First part of variable's name. */
    char *name2;		/* Second part of variable's name. */
    int flags;			/* Describes what just happened. */
{
    TkMenuEntry *mePtr = (TkMenuEntry *) clientData;
    TkMenu *menuPtr;
    char *value;
    char *name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
    char *onValue;

    menuPtr = mePtr->menuPtr;

    /*
     * If the variable is being unset, then re-establish the
     * trace unless the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	mePtr->entryFlags &= ~ENTRY_SELECTED;
	if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
	    Tcl_TraceVar(interp, name,
		    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		    MenuVarProc, clientData);
	}
	TkpConfigureMenuEntry(mePtr);
	TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
	return (char *) NULL;
    }

    /*
     * Use the value of the variable to update the selected status of
     * the menu entry.
     */

    value = Tcl_GetVar(interp, name, TCL_GLOBAL_ONLY);
    if (value == NULL) {
	value = "";
    }
    if (mePtr->onValuePtr != NULL) {
	onValue = Tcl_GetStringFromObj(mePtr->onValuePtr, NULL);
	if (strcmp(value, onValue) == 0) {
	    if (mePtr->entryFlags & ENTRY_SELECTED) {
		return (char *) NULL;
	    }
	    mePtr->entryFlags |= ENTRY_SELECTED;
	} else if (mePtr->entryFlags & ENTRY_SELECTED) {
	    mePtr->entryFlags &= ~ENTRY_SELECTED;
	} else {
	    return (char *) NULL;
	}
    } else {
	return (char *) NULL;
    }
    TkpConfigureMenuEntry(mePtr);
    TkEventuallyRedrawMenu(menuPtr, mePtr);
    return (char *) NULL;
}
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
	mePtr = menuPtr->entries[menuPtr->active];

	/*
	 * Don't change the state unless it's currently active (state
	 * might already have been changed to disabled).
	 */

	if (mePtr->state == tkActiveUid) {
	    mePtr->state = tkNormalUid;
	}
	TkEventuallyRedrawMenu(menuPtr, menuPtr->entries[menuPtr->active]);
    }
    menuPtr->active = index;
    if (index >= 0) {
	mePtr = menuPtr->entries[index];
	mePtr->state = tkActiveUid;
	TkEventuallyRedrawMenu(menuPtr, mePtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------







|
|






|







2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
	mePtr = menuPtr->entries[menuPtr->active];

	/*
	 * Don't change the state unless it's currently active (state
	 * might already have been changed to disabled).
	 */

	if (mePtr->state == ENTRY_ACTIVE) {
	    mePtr->state = ENTRY_NORMAL;
	}
	TkEventuallyRedrawMenu(menuPtr, menuPtr->entries[menuPtr->active]);
    }
    menuPtr->active = index;
    if (index >= 0) {
	mePtr = menuPtr->entries[index];
	mePtr->state = ENTRY_ACTIVE;
	TkEventuallyRedrawMenu(menuPtr, mePtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
2233
2234
2235
2236
2237
2238
2239
2240



2241

2242
2243
2244
2245
2246
2247
2248
2249

    /*
     * If there is a command for the menu, execute it.  This
     * may change the size of the menu, so be sure to recompute
     * the menu's geometry if needed.
     */

    if (menuPtr->postCommand != NULL) {



    	result = TkCopyAndGlobalEval(menuPtr->interp,

	        menuPtr->postCommand);
	if (result != TCL_OK) {
	    return result;
	}
	TkRecomputeMenu(menuPtr);
    }
    return TCL_OK;
}







|
>
>
>
|
>
|







2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592

    /*
     * If there is a command for the menu, execute it.  This
     * may change the size of the menu, so be sure to recompute
     * the menu's geometry if needed.
     */

    if (menuPtr->postCommandPtr != NULL) {
	Tcl_Obj *postCommandPtr = menuPtr->postCommandPtr;

	Tcl_IncrRefCount(postCommandPtr);
	result = Tcl_EvalObjEx(menuPtr->interp, postCommandPtr,
		TCL_EVAL_GLOBAL);
	Tcl_DecrRefCount(postCommandPtr);
	if (result != TCL_OK) {
	    return result;
	}
	TkRecomputeMenu(menuPtr);
    }
    return TCL_OK;
}
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315

2316

2317
2318

2319

2320
2321
2322
2323
2324
2325
2326
2327
2328
2329

2330
2331
2332
2333
2334
2335
2336
 *	configuration done with this menu or any related one
 *	will be reflected in all of them.
 *
 *--------------------------------------------------------------
 */

static int
CloneMenu(menuPtr, newMenuName, newMenuTypeString)
    TkMenu *menuPtr;		/* The menu we are going to clone */
    char *newMenuName;		/* The name to give the new menu */
    char *newMenuTypeString;	/* What kind of menu is this, a normal menu
    				 * a menubar, or a tearoff? */
{
    int returnResult;
    int menuType;
    size_t length;
    TkMenuReferences *menuRefPtr;
    Tcl_Obj *commandObjPtr;
    
    if (newMenuTypeString == NULL) {
    	menuType = MASTER_MENU;
    } else {
    	length = strlen(newMenuTypeString);
    	if (strncmp(newMenuTypeString, "normal", length) == 0) {
            menuType = MASTER_MENU;
    	} else if (strncmp(newMenuTypeString, "tearoff", length) == 0) {
            menuType = TEAROFF_MENU;
    	} else if (strncmp(newMenuTypeString, "menubar", length) == 0) {
            menuType = MENUBAR;
    	} else {
            Tcl_AppendResult(menuPtr->interp, 
            	    "bad menu type - must be normal, tearoff, or menubar",
        	    (char *) NULL);
            return TCL_ERROR;
    	}
    }

    commandObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
    Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
    	    Tcl_NewStringObj("tkMenuDup", -1));
    Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
    	    Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1));
    Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
    	    Tcl_NewStringObj(newMenuName, -1));
    if ((newMenuTypeString == NULL) || (newMenuTypeString[0] == '\0')) {
    	Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
    		Tcl_NewStringObj("normal", -1));
    } else {
    	Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
    		Tcl_NewStringObj(newMenuTypeString, -1));
    }

    Tcl_IncrRefCount(commandObjPtr);

    Tcl_Preserve((ClientData) menuPtr);
    returnResult = Tcl_EvalObj(menuPtr->interp, commandObjPtr);

    Tcl_DecrRefCount(commandObjPtr);


    /*
     * Make sure the tcl command actually created the clone.
     */
    
    if ((returnResult == TCL_OK) &&
    	    ((menuRefPtr = TkFindMenuReferences(menuPtr->interp, newMenuName))
	    != (TkMenuReferences *) NULL)
	    && (menuPtr->numEntries == menuRefPtr->menuPtr->numEntries)) {
    	TkMenu *newMenuPtr = menuRefPtr->menuPtr;

	char *newArgv[3];
	int i, numElements;

	/*
	 * Now put this newly created menu into the parent menu's instance
	 * chain.
	 */







|

|
|



|
<

|

|


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


<
<
|
<
|
<
|
|
<
|

<
|

>
|
>

|
>
|
>






|
|


>







2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622

2623
2624
2625
2626
2627
2628








2629
2630

2631
2632
2633
2634


2635

2636

2637
2638

2639
2640

2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
 *	configuration done with this menu or any related one
 *	will be reflected in all of them.
 *
 *--------------------------------------------------------------
 */

static int
CloneMenu(menuPtr, newMenuNamePtr, newMenuTypePtr)
    TkMenu *menuPtr;		/* The menu we are going to clone */
    Tcl_Obj *newMenuNamePtr;	/* The name to give the new menu */
    Tcl_Obj *newMenuTypePtr;	/* What kind of menu is this, a normal menu
    				 * a menubar, or a tearoff? */
{
    int returnResult;
    int menuType, i;

    TkMenuReferences *menuRefPtr;
    Tcl_Obj *menuDupCommandArray[4];
    
    if (newMenuTypePtr == NULL) {
    	menuType = MASTER_MENU;
    } else {








	if (Tcl_GetIndexFromObj(menuPtr->interp, newMenuTypePtr, 
		menuTypeStrings, "menu type", 0, &menuType) != TCL_OK) {

	    return TCL_ERROR;
	}
    }



    menuDupCommandArray[0] = Tcl_NewStringObj("tkMenuDup", -1);

    menuDupCommandArray[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);

    menuDupCommandArray[2] = newMenuNamePtr;
    if (newMenuTypePtr == NULL) {

	menuDupCommandArray[3] = Tcl_NewStringObj("normal", -1);
    } else {

	menuDupCommandArray[3] = newMenuTypePtr;
    }
    for (i = 0; i < 4; i++) {
	Tcl_IncrRefCount(menuDupCommandArray[i]);
    }
    Tcl_Preserve((ClientData) menuPtr);
    returnResult = Tcl_EvalObjv(menuPtr->interp, 4, menuDupCommandArray, 0);
    for (i = 0; i < 4; i++) {
	Tcl_DecrRefCount(menuDupCommandArray[i]);
    }

    /*
     * Make sure the tcl command actually created the clone.
     */
    
    if ((returnResult == TCL_OK) &&
    	    ((menuRefPtr = TkFindMenuReferencesObj(menuPtr->interp, 
	    newMenuNamePtr)) != (TkMenuReferences *) NULL)
	    && (menuPtr->numEntries == menuRefPtr->menuPtr->numEntries)) {
    	TkMenu *newMenuPtr = menuRefPtr->menuPtr;
	Tcl_Obj *newObjv[3];
	char *newArgv[3];
	int i, numElements;

	/*
	 * Now put this newly created menu into the parent menu's instance
	 * chain.
	 */
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374

2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401

2402


2403
2404
2405
2406
2407
2408

2409
2410
2411
2412

2413
2414

2415

2416
2417
2418
2419
2420
2421
2422
   	 */
   	
   	newArgv[0] = "bindtags";
   	newArgv[1] = Tk_PathName(newMenuPtr->tkwin);
   	if (Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin, 
   		newMenuPtr->interp, 2, newArgv) == TCL_OK) {
   	    char *windowName;
   	    Tcl_Obj *bindingsPtr = 
   	    		Tcl_NewStringObj(newMenuPtr->interp->result, -1);
   	    Tcl_Obj *elementPtr;
     
   	    Tcl_ListObjLength(newMenuPtr->interp, bindingsPtr, &numElements);
   	    for (i = 0; i < numElements; i++) {
   	    	Tcl_ListObjIndex(newMenuPtr->interp, bindingsPtr, i,
			&elementPtr);
   	    	windowName = Tcl_GetStringFromObj(elementPtr, NULL);
   	    	if (strcmp(windowName, Tk_PathName(newMenuPtr->tkwin))
   	    		== 0) {
   	    	    Tcl_Obj *newElementPtr = Tcl_NewStringObj(
   	    	    	    Tk_PathName(newMenuPtr->masterMenuPtr->tkwin), -1);

   	    	    Tcl_ListObjReplace(menuPtr->interp, bindingsPtr,
   	    	    	    i + 1, 0, 1, &newElementPtr);
   	    	    newArgv[2] = Tcl_GetStringFromObj(bindingsPtr, NULL);
   	    	    Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin,
   	    	    	    menuPtr->interp, 3, newArgv);
   	    	    break;
   	    	}
   	    }
   	    Tcl_DecrRefCount(bindingsPtr);   	    
   	}
   	Tcl_ResetResult(menuPtr->interp);
      	
   	/*
   	 * Clone all of the cascade menus that this menu points to.
   	 */
   	
   	for (i = 0; i < menuPtr->numEntries; i++) {
   	    char *newCascadeName;
   	    TkMenuReferences *cascadeRefPtr;
   	    TkMenu *oldCascadePtr;
   	    
   	    if ((menuPtr->entries[i]->type == CASCADE_ENTRY)
		&& (menuPtr->entries[i]->name != NULL)) {
   	    	cascadeRefPtr =
			TkFindMenuReferences(menuPtr->interp,
			menuPtr->entries[i]->name);
   	    	if ((cascadeRefPtr != NULL) && (cascadeRefPtr->menuPtr)) {

   	    	    char *nameString;


		    
   	    	    oldCascadePtr = cascadeRefPtr->menuPtr;

		    nameString = Tk_PathName(newMenuPtr->tkwin);
   	    	    newCascadeName = TkNewMenuName(menuPtr->interp,
   	    	     	    nameString, oldCascadePtr);

		    CloneMenu(oldCascadePtr, newCascadeName, NULL);

		    newArgv[0] = "-menu";
		    newArgv[1] = newCascadeName;

		    ConfigureMenuEntry(newMenuPtr->entries[i], 2, newArgv, 
		    	    TK_CONFIG_ARGV_ONLY);

		    ckfree(newCascadeName);

   	    	}
   	    }
   	}
   	
    	returnResult = TCL_OK;
    } else {
    	returnResult = TCL_ERROR;







|
|











>



|
|












<




|

|
|

>
|
>
>



|
|
|
>
|

|
|
>
|
<
>
|
>







2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724

2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750

2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
   	 */
   	
   	newArgv[0] = "bindtags";
   	newArgv[1] = Tk_PathName(newMenuPtr->tkwin);
   	if (Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin, 
   		newMenuPtr->interp, 2, newArgv) == TCL_OK) {
   	    char *windowName;
   	    Tcl_Obj *bindingsPtr =
		    Tcl_DuplicateObj(Tcl_GetObjResult(newMenuPtr->interp));
   	    Tcl_Obj *elementPtr;
     
   	    Tcl_ListObjLength(newMenuPtr->interp, bindingsPtr, &numElements);
   	    for (i = 0; i < numElements; i++) {
   	    	Tcl_ListObjIndex(newMenuPtr->interp, bindingsPtr, i,
			&elementPtr);
   	    	windowName = Tcl_GetStringFromObj(elementPtr, NULL);
   	    	if (strcmp(windowName, Tk_PathName(newMenuPtr->tkwin))
   	    		== 0) {
   	    	    Tcl_Obj *newElementPtr = Tcl_NewStringObj(
   	    	    	    Tk_PathName(newMenuPtr->masterMenuPtr->tkwin), -1);
		    Tcl_IncrRefCount(newElementPtr);
   	    	    Tcl_ListObjReplace(menuPtr->interp, bindingsPtr,
   	    	    	    i + 1, 0, 1, &newElementPtr);
   	    	    newArgv[2] = Tcl_GetStringFromObj(bindingsPtr, NULL);
		    Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin,
			    menuPtr->interp, 3, newArgv);
   	    	    break;
   	    	}
   	    }
   	    Tcl_DecrRefCount(bindingsPtr);   	    
   	}
   	Tcl_ResetResult(menuPtr->interp);
      	
   	/*
   	 * Clone all of the cascade menus that this menu points to.
   	 */
   	
   	for (i = 0; i < menuPtr->numEntries; i++) {

   	    TkMenuReferences *cascadeRefPtr;
   	    TkMenu *oldCascadePtr;
   	    
   	    if ((menuPtr->entries[i]->type == CASCADE_ENTRY)
		&& (menuPtr->entries[i]->namePtr != NULL)) {
   	    	cascadeRefPtr =
			TkFindMenuReferencesObj(menuPtr->interp,
			menuPtr->entries[i]->namePtr);
   	    	if ((cascadeRefPtr != NULL) && (cascadeRefPtr->menuPtr)) {
		    Tcl_Obj *windowNamePtr = 
			    Tcl_NewStringObj(Tk_PathName(newMenuPtr->tkwin),
			    -1);
		    Tcl_Obj *newCascadePtr;
		    
   	    	    oldCascadePtr = cascadeRefPtr->menuPtr;

		    Tcl_IncrRefCount(windowNamePtr);
   	    	    newCascadePtr = TkNewMenuName(menuPtr->interp,
   	    	     	    windowNamePtr, oldCascadePtr);
		    Tcl_IncrRefCount(newCascadePtr);
		    CloneMenu(oldCascadePtr, newCascadePtr, NULL);

		    newObjv[0] = Tcl_NewStringObj("-menu", -1);
		    newObjv[1] = newCascadePtr;
		    Tcl_IncrRefCount(newObjv[0]);
		    ConfigureMenuEntry(newMenuPtr->entries[i], 2, newObjv);

		    Tcl_DecrRefCount(newObjv[0]);
		    Tcl_DecrRefCount(newCascadePtr);
		    Tcl_DecrRefCount(windowNamePtr);
   	    	}
   	    }
   	}
   	
    	returnResult = TCL_OK;
    } else {
    	returnResult = TCL_ERROR;
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455

2456
2457
2458
2459
2460

2461
2462
2463
2464
2465
2466
2467
 * Side effects:
 *	yPosition is set to the Y-position of the menu entry.
 *
 *----------------------------------------------------------------------
 */
    
static int
MenuDoYPosition(interp, menuPtr, arg)
    Tcl_Interp *interp;
    TkMenu *menuPtr;
    char *arg;
{
    int index;
    
    TkRecomputeMenu(menuPtr);
    if (TkGetMenuIndex(interp, menuPtr, arg, 0, &index) != TCL_OK) {
    	goto error;
    }

    if (index < 0) {
        interp->result = "0";
    } else {
    	sprintf(interp->result, "%d", menuPtr->entries[index]->y);
    }

    return TCL_OK;
    
error:
    return TCL_ERROR;
}

/*







|


|




|


>

|

|

>







2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
 * Side effects:
 *	yPosition is set to the Y-position of the menu entry.
 *
 *----------------------------------------------------------------------
 */
    
static int
MenuDoYPosition(interp, menuPtr, objPtr)
    Tcl_Interp *interp;
    TkMenu *menuPtr;
    Tcl_Obj *objPtr;
{
    int index;
    
    TkRecomputeMenu(menuPtr);
    if (TkGetMenuIndex(interp, menuPtr, objPtr, 0, &index) != TCL_OK) {
    	goto error;
    }
    Tcl_ResetResult(interp);
    if (index < 0) {
	Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
    } else {
	Tcl_SetObjResult(interp, Tcl_NewIntObj(menuPtr->entries[index]->y));
    }

    return TCL_OK;
    
error:
    return TCL_ERROR;
}

/*
2503
2504
2505
2506
2507
2508
2509

2510
2511
2512
2513
2514
2515
2516
2517
	x = y;
	p = end + 1;
	y = strtol(p, &end, 0);
	if (end == p) {
	    goto error;
	}
    } else {

	x = menuPtr->borderWidth;
    }
    
    for (i = 0; i < menuPtr->numEntries; i++) {
	if ((x >= menuPtr->entries[i]->x) && (y >= menuPtr->entries[i]->y)
		&& (x < (menuPtr->entries[i]->x + menuPtr->entries[i]->width))
		&& (y < (menuPtr->entries[i]->y
		+ menuPtr->entries[i]->height))) {







>
|







2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
	x = y;
	p = end + 1;
	y = strtol(p, &end, 0);
	if (end == p) {
	    goto error;
	}
    } else {
	Tk_GetPixelsFromObj(interp, menuPtr->tkwin, 
		menuPtr->borderWidthPtr, &x);
    }
    
    for (i = 0; i < menuPtr->numEntries; i++) {
	if ((x >= menuPtr->entries[i]->x) && (y >= menuPtr->entries[i]->y)
		&& (x < (menuPtr->entries[i]->x + menuPtr->entries[i]->width))
		&& (y < (menuPtr->entries[i]->y
		+ menuPtr->entries[i]->height))) {
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592

2593
2594
2595
2596
2597
2598
2599
2600


2601
2602
2603
2604

2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626

2627
2628
2629

2630
2631



2632
2633

2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
 *
 * Side effects:
 *	Memory is allocated.
 *
 *----------------------------------------------------------------------
 */

char *
TkNewMenuName(interp, parentName, menuPtr)
    Tcl_Interp *interp;		/* The interp the new name has to live in.*/
    char *parentName;		/* The prefix path of the new name. */
    TkMenu *menuPtr;		/* The menu we are cloning. */
{
    Tcl_DString resultDString;

    Tcl_DString childDString;
    char *destString;
    int offset, i;
    int doDot = parentName[strlen(parentName) - 1] != '.';
    Tcl_CmdInfo cmdInfo;
    char *returnString;
    Tcl_HashTable *nameTablePtr = NULL;
    TkWindow *winPtr = (TkWindow *) menuPtr->tkwin;


    if (winPtr->mainPtr != NULL) {
	nameTablePtr = &(winPtr->mainPtr->nameTable);
    }
    

    Tcl_DStringInit(&childDString);
    Tcl_DStringAppend(&childDString, Tk_PathName(menuPtr->tkwin), -1);
    for (destString = Tcl_DStringValue(&childDString);
    	    *destString != '\0'; destString++) {
    	if (*destString == '.') {
    	    *destString = '#';
    	}
    }
    
    offset = 0;
    
    for (i = 0; ; i++) {
    	if (i == 0) {
    	    Tcl_DStringInit(&resultDString);
    	    Tcl_DStringAppend(&resultDString, parentName, -1);
    	    if (doDot) {
    	    	Tcl_DStringAppend(&resultDString, ".", -1);
    	    }
    	    Tcl_DStringAppend(&resultDString,
    	    	    Tcl_DStringValue(&childDString), -1);
    	    destString = Tcl_DStringValue(&resultDString);
    	} else {

    	    if (i == 1) {
    	    	offset = Tcl_DStringLength(&resultDString);
    	    	Tcl_DStringSetLength(&resultDString, offset + 10);

    	    	destString = Tcl_DStringValue(&resultDString);
    	    }



    	    sprintf(destString + offset, "%d", i);
    	}

    	if ((Tcl_GetCommandInfo(interp, destString, &cmdInfo) == 0)
		&& ((nameTablePtr == NULL)
		|| (Tcl_FindHashEntry(nameTablePtr, destString) == NULL))) {
    	    break;
    	}
    }
    returnString = ckalloc(strlen(destString) + 1);
    strcpy(returnString, destString);
    Tcl_DStringFree(&resultDString);
    Tcl_DStringFree(&childDString);
    return returnString;    	   
}

/*
 *----------------------------------------------------------------------
 *
 * TkSetWindowMenuBar --
 *







|
|

|


|
>
|

|
|

<


>
>



|
>
|
|
|






<
<


|
<

|

|
<
<

>
|
|
|
>
|
|
>
>
>
|

>






<
<
|
<
|







2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939

2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957


2958
2959
2960

2961
2962
2963
2964


2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984


2985

2986
2987
2988
2989
2990
2991
2992
2993
 *
 * Side effects:
 *	Memory is allocated.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TkNewMenuName(interp, parentPtr, menuPtr)
    Tcl_Interp *interp;		/* The interp the new name has to live in.*/
    Tcl_Obj *parentPtr;		/* The prefix path of the new name. */
    TkMenu *menuPtr;		/* The menu we are cloning. */
{
    Tcl_Obj *resultPtr = NULL;	/* Initialization needed only to prevent
				 * compiler warning. */
    Tcl_Obj *childPtr;
    char *destString;
    int i;
    int doDot;
    Tcl_CmdInfo cmdInfo;

    Tcl_HashTable *nameTablePtr = NULL;
    TkWindow *winPtr = (TkWindow *) menuPtr->tkwin;
    char *parentName = Tcl_GetStringFromObj(parentPtr, NULL);

    if (winPtr->mainPtr != NULL) {
	nameTablePtr = &(winPtr->mainPtr->nameTable);
    }

    doDot = parentName[strlen(parentName) - 1] != '.';

    childPtr = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);
    for (destString = Tcl_GetStringFromObj(childPtr, NULL);
    	    *destString != '\0'; destString++) {
    	if (*destString == '.') {
    	    *destString = '#';
    	}
    }
    


    for (i = 0; ; i++) {
    	if (i == 0) {
	    resultPtr = Tcl_DuplicateObj(parentPtr);

    	    if (doDot) {
		Tcl_AppendToObj(resultPtr, ".", -1);
    	    }
	    Tcl_AppendObjToObj(resultPtr, childPtr);


    	} else {
	    Tcl_Obj *intPtr;

	    Tcl_DecrRefCount(resultPtr);
	    resultPtr = Tcl_DuplicateObj(parentPtr);
	    if (doDot) {
		Tcl_AppendToObj(resultPtr, ".", -1);
	    }
	    Tcl_AppendObjToObj(resultPtr, childPtr);
	    intPtr = Tcl_NewIntObj(i);
	    Tcl_AppendObjToObj(resultPtr, intPtr);
	    Tcl_DecrRefCount(intPtr);
    	}
	destString = Tcl_GetStringFromObj(resultPtr, NULL);
    	if ((Tcl_GetCommandInfo(interp, destString, &cmdInfo) == 0)
		&& ((nameTablePtr == NULL)
		|| (Tcl_FindHashEntry(nameTablePtr, destString) == NULL))) {
    	    break;
    	}
    }


    Tcl_DecrRefCount(childPtr);

    return resultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TkSetWindowMenuBar --
 *
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761



2762
2763
2764
2765
2766

2767
2768


2769
2770
2771
2772
2773


2774
2775
2776
2777


2778
2779


2780
2781
2782
2783

2784
2785
2786
2787
2788
2789
2790
2791
    if (menuName != NULL && menuName[0] != 0) {
    	TkMenu *menuBarPtr = NULL;

	menuRefPtr = TkCreateMenuReferences(interp, menuName);    	
    	
    	menuPtr = menuRefPtr->menuPtr;
    	if (menuPtr != NULL) {
   	    char *cloneMenuName;
   	    TkMenuReferences *cloneMenuRefPtr;
	    char *newArgv[4];



    	
            /*
             * Clone the menu and all of the cascades underneath it.
             */


    	    cloneMenuName = TkNewMenuName(interp, Tk_PathName(tkwin),
    	    	    menuPtr);


            CloneMenu(menuPtr, cloneMenuName, "menubar");
	    
            cloneMenuRefPtr = TkFindMenuReferences(interp, cloneMenuName);
            if ((cloneMenuRefPtr != NULL)
		    && (cloneMenuRefPtr->menuPtr != NULL)) {


            	cloneMenuRefPtr->menuPtr->parentTopLevelPtr = tkwin;
            	menuBarPtr = cloneMenuRefPtr->menuPtr;
		newArgv[0] = "-cursor";
		newArgv[1] = "";


		ConfigureMenu(menuPtr->interp, cloneMenuRefPtr->menuPtr,
			2, newArgv, TK_CONFIG_ARGV_ONLY);


            }

	    TkpSetWindowMenuBar(tkwin, menuBarPtr);
		        

            ckfree(cloneMenuName);
        } else {
    	    TkpSetWindowMenuBar(tkwin, NULL);
	}

        
        /*
         * Add this window to the menu's list of windows that refer







|

|
>
>
>





>
|

>
>
|

|


>
>


|
|
>
>

|
>
>



|
>
|







3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
    if (menuName != NULL && menuName[0] != 0) {
    	TkMenu *menuBarPtr = NULL;

	menuRefPtr = TkCreateMenuReferences(interp, menuName);    	
    	
    	menuPtr = menuRefPtr->menuPtr;
    	if (menuPtr != NULL) {
   	    Tcl_Obj *cloneMenuPtr;
   	    TkMenuReferences *cloneMenuRefPtr;
	    Tcl_Obj *newObjv[4];
	    Tcl_Obj *windowNamePtr = Tcl_NewStringObj(Tk_PathName(tkwin), 
		    -1);
	    Tcl_Obj *menubarPtr = Tcl_NewStringObj("menubar", -1);
    	
            /*
             * Clone the menu and all of the cascades underneath it.
             */

	    Tcl_IncrRefCount(windowNamePtr);
    	    cloneMenuPtr = TkNewMenuName(interp, windowNamePtr,
    	    	    menuPtr);
	    Tcl_IncrRefCount(cloneMenuPtr);
	    Tcl_IncrRefCount(menubarPtr);
            CloneMenu(menuPtr, cloneMenuPtr, menubarPtr);
	    
            cloneMenuRefPtr = TkFindMenuReferencesObj(interp, cloneMenuPtr);
            if ((cloneMenuRefPtr != NULL)
		    && (cloneMenuRefPtr->menuPtr != NULL)) {
		Tcl_Obj *cursorPtr = Tcl_NewStringObj("-cursor", -1);
		Tcl_Obj *nullPtr = Tcl_NewObj();
            	cloneMenuRefPtr->menuPtr->parentTopLevelPtr = tkwin;
            	menuBarPtr = cloneMenuRefPtr->menuPtr;
		newObjv[0] = cursorPtr;
		newObjv[1] = nullPtr;
		Tcl_IncrRefCount(cursorPtr);
		Tcl_IncrRefCount(nullPtr);
		ConfigureMenu(menuPtr->interp, cloneMenuRefPtr->menuPtr,
			2, newObjv);
		Tcl_DecrRefCount(cursorPtr);
		Tcl_DecrRefCount(nullPtr);
            }

	    TkpSetWindowMenuBar(tkwin, menuBarPtr);
	    Tcl_DecrRefCount(cloneMenuPtr);
	    Tcl_DecrRefCount(menubarPtr);
	    Tcl_DecrRefCount(windowNamePtr);
        } else {
    	    TkpSetWindowMenuBar(tkwin, NULL);
	}

        
        /*
         * Add this window to the menu's list of windows that refer
2944
2945
2946
2947
2948
2949
2950





























2951
2952
2953
2954
2955
2956
2957
    }
    return menuRefPtr;
}

/*
 *----------------------------------------------------------------------
 *





























 * TkFreeMenuReferences --
 *
 *	This is called after one of the fields in a menu reference
 *	is cleared. It cleans up the ref if it is now empty.
 *
 * Results:
 *	None.







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







3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
    }
    return menuRefPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TkFindMenuReferencesObj --
 *
 *	Given a pathname, gives back a pointer to the TkMenuReferences
 *	structure.
 *
 * Results:
 *	Returns a pointer to a menu reference structure. Should not
 *	be freed by calller; when a field of the reference is cleared,
 *	TkFreeMenuReferences should be called. Returns NULL if no reference
 *	with this pathname exists.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

TkMenuReferences *
TkFindMenuReferencesObj(interp, objPtr)
    Tcl_Interp *interp;		/* The interp the menu is living in. */
    Tcl_Obj *objPtr;		/* The path of the menu widget */
{
    char *pathName = Tcl_GetStringFromObj(objPtr, NULL);
    return TkFindMenuReferences(interp, pathName);
}

/*
 *----------------------------------------------------------------------
 *
 * TkFreeMenuReferences --
 *
 *	This is called after one of the fields in a menu reference
 *	is cleared. It cleans up the ref if it is now empty.
 *
 * Results:
 *	None.
3046
3047
3048
3049
3050
3051
3052



3053


3054
3055
3056

3057





 *
 *----------------------------------------------------------------------
 */

void
TkMenuInit()
{



    if (!menusInitialized) {


    	TkpMenuInit();
    	menusInitialized = 1;
    }

}












>
>
>

>
>
|
|
|
>
|
>
>
>
>
>
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
 *
 *----------------------------------------------------------------------
 */

void
TkMenuInit()
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    
    if (!menusInitialized) {
	Tcl_MutexLock(&menuMutex);
	if (!menusInitialized) {
	    TkpMenuInit();
	    menusInitialized = 1;
	}
	Tcl_MutexUnlock(&menuMutex);
    }
    if (!tsdPtr->menusInitialized) {
	TkpMenuThreadInit();
	tsdPtr->menusInitialized = 1;
    }
}

Changes to generic/tkMenu.h.

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
/*
 * tkMenu.h --
 *
 *	Declarations shared among all of the files that implement menu widgets.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMenu.h 1.60 97/06/20 14:43:21
 */

#ifndef _TKMENU
#define _TKMENU

#ifndef _TK
#include "tk.h"
#endif

#ifndef _TKINT
#include "tkInt.h"
#endif

#ifndef _DEFAULT
#include "default.h"
#endif






/*
 * Dummy types used by the platform menu code.
 */

typedef struct TkMenuPlatformData_ *TkMenuPlatformData;
typedef struct TkMenuPlatformEntryData_ *TkMenuPlatformEntryData;

/*
 * One of the following data structures is kept for each entry of each
 * menu managed by this file:
 */

typedef struct TkMenuEntry {
    int type;			/* Type of menu entry;  see below for
				 * valid types. */
    struct TkMenu *menuPtr;	/* Menu with which this entry is associated. */

    char *label;		/* Main text label displayed in entry (NULL
				 * if no label).  Malloc'ed. */
    int labelLength;		/* Number of non-NULL characters in label. */
    Tk_Uid state;		/* State of button for display purposes:
				 * normal, active, or disabled. */



    int underline;		/* Index of character to underline. */
    Pixmap bitmap;		/* Bitmap to display in menu entry, or None.
				 * If not None then label is ignored. */
    char *imageString;		/* Name of image to display (malloc'ed), or
				 * NULL.  If non-NULL, bitmap, text, and
				 * textVarName are ignored. */
    Tk_Image image;		/* Image to display in menu entry, or NULL if
				 * none. */
    char *selectImageString;	/* Name of image to display when selected
				 * (malloc'ed), or NULL. */
    Tk_Image selectImage;	/* Image to display in entry when selected,
				 * or NULL if none.  Ignored if image is
				 * NULL. */
    char *accel;		/* Accelerator string displayed at right
				 * of menu entry.  NULL means no such
				 * accelerator.  Malloc'ed. */
    int accelLength;		/* Number of non-NULL characters in
				 * accelerator. */
    int indicatorOn;		/* True means draw indicator, false means
				 * don't draw it. */

    /*
     * Display attributes
     */

    Tk_3DBorder border;		/* Structure used to draw background for
				 * entry.  NULL means use overall border
				 * for menu. */
    XColor *fg;			/* Foreground color to use for entry.  NULL
				 * means use foreground color from menu. */
    Tk_3DBorder activeBorder;	/* Used to draw background and border when
				 * element is active.  NULL means use
				 * activeBorder from menu. */
    XColor *activeFg;		/* Foreground color to use when entry is
				 * active.  NULL means use active foreground
				 * from menu. */
    XColor *indicatorFg;	/* Color for indicators in radio and check
				 * button entries.  NULL means use indicatorFg
				 * GC from menu. */
    Tk_Font tkfont;		/* Text font for menu entries.  NULL means
				 * use overall font for menu. */
    int columnBreak;		/* If this is 0, this item appears below
				 * the item in front of it. If this is
				 * 1, this item starts a new column. */


    int hideMargin;		/* If this is 0, then the item has enough
    				 * margin to accomodate a standard check
    				 * mark and a default right margin. If this 
    				 * is 1, then the item has no such margins.
    				 * and checkbuttons and radiobuttons with
    				 * this set will have a rectangle drawn
    				 * in the indicator around the item if
    				 * the item is checked.
    				 * This is useful palette menus.*/ 

    int indicatorSpace;		/* The width of the indicator space for this
				 * entry.
				 */
    int labelWidth;		/* Number of pixels to allow for displaying
				 * labels in menu entries. */

    /*
     * Information used to implement this entry's action:
     */

    char *command;		/* Command to invoke when entry is invoked.
				 * Malloc'ed. */
    char *name;			/* Name of variable (for check buttons and
				 * radio buttons) or menu (for cascade
				 * entries).  Malloc'ed.*/
    char *onValue;		/* Value to store in variable when selected
				 * (only for radio and check buttons).
				 * Malloc'ed. */
    char *offValue;		/* Value to store in variable when not
				 * selected (only for check buttons).
				 * Malloc'ed. */
    
    /*
     * Information used for drawing this menu entry.
     */
     





|




|
















>
>
>
>
>

















>
|
|

|

>
>
>
|
|

|




|
|



|





|
>




|


|

|


|


|


|



|
>
>

|
|
|
|
|
|
<
|
>

|
<







|

|


|


|







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
/*
 * tkMenu.h --
 *
 *	Declarations shared among all of the files that implement menu widgets.
 *
 * Copyright (c) 1996-1998 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMenu.h,v 1.1.4.5 1999/03/10 07:13:44 stanton Exp $
 */

#ifndef _TKMENU
#define _TKMENU

#ifndef _TK
#include "tk.h"
#endif

#ifndef _TKINT
#include "tkInt.h"
#endif

#ifndef _DEFAULT
#include "default.h"
#endif

#ifdef BUILD_tk
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * Dummy types used by the platform menu code.
 */

typedef struct TkMenuPlatformData_ *TkMenuPlatformData;
typedef struct TkMenuPlatformEntryData_ *TkMenuPlatformEntryData;

/*
 * One of the following data structures is kept for each entry of each
 * menu managed by this file:
 */

typedef struct TkMenuEntry {
    int type;			/* Type of menu entry;  see below for
				 * valid types. */
    struct TkMenu *menuPtr;	/* Menu with which this entry is associated. */
    Tk_OptionTable optionTable;	/* Option table for this menu entry. */
    Tcl_Obj *labelPtr;		/* Main text label displayed in entry (NULL
				 * if no label). */
    int labelLength;		/* Number of non-NULL characters in label. */
    int state;			/* State of button for display purposes:
				 * normal, active, or disabled. */
    int underline;		/* Value of -underline option: specifies index
				 * of character to underline (<0 means don't
				 * underline anything). */
    Tcl_Obj *underlinePtr;	/* Index of character to underline. */
    Tcl_Obj *bitmapPtr;		/* Bitmap to display in menu entry, or None.
				 * If not None then label is ignored. */
    Tcl_Obj *imagePtr;		/* Name of image to display, or
				 * NULL.  If non-NULL, bitmap, text, and
				 * textVarName are ignored. */
    Tk_Image image;		/* Image to display in menu entry, or NULL if
				 * none. */
    Tcl_Obj *selectImagePtr;	/* Name of image to display when selected, or 
				 * NULL. */
    Tk_Image selectImage;	/* Image to display in entry when selected,
				 * or NULL if none.  Ignored if image is
				 * NULL. */
    Tcl_Obj *accelPtr;		/* Accelerator string displayed at right
				 * of menu entry.  NULL means no such
				 * accelerator.  Malloc'ed. */
    int accelLength;		/* Number of non-NULL characters in
				 * accelerator. */
    int indicatorOn;		/* True means draw indicator, false means
				 * don't draw it. This field is ignored unless
				 * the entry is a radio or check button. */
    /*
     * Display attributes
     */

    Tcl_Obj *borderPtr;		/* Structure used to draw background for
				 * entry.  NULL means use overall border
				 * for menu. */
    Tcl_Obj *fgPtr;		/* Foreground color to use for entry.  NULL
				 * means use foreground color from menu. */
    Tcl_Obj *activeBorderPtr;	/* Used to draw background and border when
				 * element is active.  NULL means use
				 * activeBorder from menu. */
    Tcl_Obj *activeFgPtr;	/* Foreground color to use when entry is
				 * active.  NULL means use active foreground
				 * from menu. */
    Tcl_Obj *indicatorFgPtr;	/* Color for indicators in radio and check
				 * button entries.  NULL means use indicatorFg
				 * GC from menu. */
    Tcl_Obj *fontPtr;		/* Text font for menu entries.  NULL means
				 * use overall font for menu. */
    int columnBreak;		/* If this is 0, this item appears below
				 * the item in front of it. If this is
				 * 1, this item starts a new column. This
				 * field is always 0 for tearoff and separator
				 * entries. */
    int hideMargin;		/* If this is 0, then the item has enough
    				 * margin to accomodate a standard check mark
    				 * and a default right margin. If this is 1,
    				 * then the item has no such margins.  and
    				 * checkbuttons and radiobuttons with this set
    				 * will have a rectangle drawn in the indicator
    				 * around the item if the item is checked. This

    				 * is useful for palette menus.  This field is
    				 * ignored for separators and tearoffs. */
    int indicatorSpace;		/* The width of the indicator space for this
				 * entry. */

    int labelWidth;		/* Number of pixels to allow for displaying
				 * labels in menu entries. */

    /*
     * Information used to implement this entry's action:
     */

    Tcl_Obj *commandPtr;	/* Command to invoke when entry is invoked.
				 * Malloc'ed. */
    Tcl_Obj *namePtr;		/* Name of variable (for check buttons and
				 * radio buttons) or menu (for cascade
				 * entries).  Malloc'ed.*/
    Tcl_Obj *onValuePtr;	/* Value to store in variable when selected
				 * (only for radio and check buttons).
				 * Malloc'ed. */
    Tcl_Obj *offValuePtr;	/* Value to store in variable when not
				 * selected (only for check buttons).
				 * Malloc'ed. */
    
    /*
     * Information used for drawing this menu entry.
     */
     
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211

212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
    				/* The next cascade entry that is a parent of
    				 * this entry's child cascade menu. NULL
    				 * end of list, this is not a cascade entry,
    				 * or the menu that this entry point to
    				 * does not yet exist. */
    TkMenuPlatformEntryData platformEntryData;
    				/* The data for the specific type of menu.
  				 * Depends on platform and menu type what
  				 * kind of options are in this structure.
  				 */
} TkMenuEntry;

/*
 * Flag values defined for menu entries:
 *
 * ENTRY_SELECTED:		Non-zero means this is a radio or check
 *				button and that it should be drawn in
 *				the "selected" state.
 * ENTRY_NEEDS_REDISPLAY:	Non-zero means the entry should be redisplayed.
 * ENTRY_LAST_COLUMN:		Used by the drawing code. If the entry is in the
 *				last column, the space to its right needs to
 *				be filled.
 * ENTRY_PLATFORM_FLAG1 - 4	These flags are reserved for use by the
 *				platform-dependent implementation of menus
 *				and should not be used by anything else.
 */

#define ENTRY_SELECTED		1
#define ENTRY_NEEDS_REDISPLAY	2
#define ENTRY_LAST_COLUMN	4
#define ENTRY_PLATFORM_FLAG1	(1 << 30)
#define ENTRY_PLATFORM_FLAG2	(1 << 29)
#define ENTRY_PLATFORM_FLAG3	(1 << 28)
#define ENTRY_PLATFORM_FLAG4	(1 << 27)

/*
 * Types defined for MenuEntries:
 */

#define COMMAND_ENTRY		0
#define SEPARATOR_ENTRY		1
#define CHECK_BUTTON_ENTRY	2

#define RADIO_BUTTON_ENTRY	3
#define CASCADE_ENTRY		4
#define TEAROFF_ENTRY		5

/*
 * Mask bits for above types:
 */

#define COMMAND_MASK		TK_CONFIG_USER_BIT
#define SEPARATOR_MASK		(TK_CONFIG_USER_BIT << 1)
#define CHECK_BUTTON_MASK	(TK_CONFIG_USER_BIT << 2)
#define RADIO_BUTTON_MASK	(TK_CONFIG_USER_BIT << 3)
#define CASCADE_MASK		(TK_CONFIG_USER_BIT << 4)
#define TEAROFF_MASK		(TK_CONFIG_USER_BIT << 5)
#define ALL_MASK		(COMMAND_MASK | SEPARATOR_MASK \
	| CHECK_BUTTON_MASK | RADIO_BUTTON_MASK | CASCADE_MASK | TEAROFF_MASK)

/*
 * A data structure of the following type is kept for each
 * menu widget:
 */

typedef struct TkMenu {







|











|
|
|

















|
<
|
>
|
|
|


|


|
|
|
<
|
|
<
<







181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220

221
222
223
224
225
226
227
228
229
230
231
232
233

234
235


236
237
238
239
240
241
242
    				/* The next cascade entry that is a parent of
    				 * this entry's child cascade menu. NULL
    				 * end of list, this is not a cascade entry,
    				 * or the menu that this entry point to
    				 * does not yet exist. */
    TkMenuPlatformEntryData platformEntryData;
    				/* The data for the specific type of menu.
				 * Depends on platform and menu type what
  				 * kind of options are in this structure.
  				 */
} TkMenuEntry;

/*
 * Flag values defined for menu entries:
 *
 * ENTRY_SELECTED:		Non-zero means this is a radio or check
 *				button and that it should be drawn in
 *				the "selected" state.
 * ENTRY_NEEDS_REDISPLAY:	Non-zero means the entry should be redisplayed.
 * ENTRY_LAST_COLUMN:		Used by the drawing code. If the entry is in
 *				the last column, the space to its right needs
 *				to be filled.
 * ENTRY_PLATFORM_FLAG1 - 4	These flags are reserved for use by the
 *				platform-dependent implementation of menus
 *				and should not be used by anything else.
 */

#define ENTRY_SELECTED		1
#define ENTRY_NEEDS_REDISPLAY	2
#define ENTRY_LAST_COLUMN	4
#define ENTRY_PLATFORM_FLAG1	(1 << 30)
#define ENTRY_PLATFORM_FLAG2	(1 << 29)
#define ENTRY_PLATFORM_FLAG3	(1 << 28)
#define ENTRY_PLATFORM_FLAG4	(1 << 27)

/*
 * Types defined for MenuEntries:
 */

#define CASCADE_ENTRY 0

#define CHECK_BUTTON_ENTRY 1
#define COMMAND_ENTRY 2
#define RADIO_BUTTON_ENTRY 3
#define SEPARATOR_ENTRY 4
#define TEAROFF_ENTRY 5

/*
 * Menu states
 */

EXTERN char *tkMenuStateStrings[];

#define ENTRY_ACTIVE 0

#define ENTRY_NORMAL 1
#define ENTRY_DISABLED 2



/*
 * A data structure of the following type is kept for each
 * menu widget:
 */

typedef struct TkMenu {
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263

264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
    TkMenuEntry **entries;	/* Array of pointers to all the entries
				 * in the menu.  NULL means no entries. */
    int numEntries;		/* Number of elements in entries. */
    int active;			/* Index of active entry.  -1 means
				 * nothing active. */
    int menuType;		/* MASTER_MENU, TEAROFF_MENU, or MENUBAR.
    				 * See below for definitions. */
    char *menuTypeName;		/* Used to control whether created tkwin
				 * is a toplevel or not. "normal", "menubar",
				 * or "toplevel" */

    /*
     * Information used when displaying widget:
     */

    Tk_3DBorder border;		/* Structure used to draw 3-D
				 * border and background for menu. */
    int borderWidth;		/* Width of border around whole menu. */
    Tk_3DBorder activeBorder;	/* Used to draw background and border for
				 * active element (if any). */

    int activeBorderWidth;	/* Width of border around active element. */
    int relief;			/* 3-d effect: TK_RELIEF_RAISED, etc. */
    Tk_Font tkfont;		/* Text font for menu entries. */
    XColor *fg;			/* Foreground color for entries. */
    XColor *disabledFg;		/* Foreground color when disabled.  NULL
				 * means use normalFg with a 50% stipple
				 * instead. */
    XColor *activeFg;		/* Foreground color for active entry. */
    XColor *indicatorFg;	/* Color for indicators in radio and check
				 * button entries. */
    Pixmap gray;		/* Bitmap for drawing disabled entries in
				 * a stippled fashion.  None means not
				 * allocated yet. */
    GC textGC;			/* GC for drawing text and other features
				 * of menu entries. */
    GC disabledGC;		/* Used to produce disabled effect.  If







|







|

|
|

>
|
|
|
|
|


|
|







252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
    TkMenuEntry **entries;	/* Array of pointers to all the entries
				 * in the menu.  NULL means no entries. */
    int numEntries;		/* Number of elements in entries. */
    int active;			/* Index of active entry.  -1 means
				 * nothing active. */
    int menuType;		/* MASTER_MENU, TEAROFF_MENU, or MENUBAR.
    				 * See below for definitions. */
    Tcl_Obj *menuTypePtr;	/* Used to control whether created tkwin
				 * is a toplevel or not. "normal", "menubar",
				 * or "toplevel" */

    /*
     * Information used when displaying widget:
     */

    Tcl_Obj *borderPtr;		/* Structure used to draw 3-D
				 * border and background for menu. */
    Tcl_Obj *borderWidthPtr;	/* Width of border around whole menu. */
    Tcl_Obj *activeBorderPtr;	/* Used to draw background and border for
				 * active element (if any). */
    Tcl_Obj *activeBorderWidthPtr;
				/* Width of border around active element. */
    Tcl_Obj *reliefPtr;		/* 3-d effect: TK_RELIEF_RAISED, etc. */
    Tcl_Obj *fontPtr;		/* Text font for menu entries. */
    Tcl_Obj *fgPtr;		/* Foreground color for entries. */
    Tcl_Obj *disabledFgPtr;	/* Foreground color when disabled.  NULL
				 * means use normalFg with a 50% stipple
				 * instead. */
    Tcl_Obj *activeFgPtr;	/* Foreground color for active entry. */
    Tcl_Obj *indicatorFgPtr;	/* Color for indicators in radio and check
				 * button entries. */
    Pixmap gray;		/* Bitmap for drawing disabled entries in
				 * a stippled fashion.  None means not
				 * allocated yet. */
    GC textGC;			/* GC for drawing text and other features
				 * of menu entries. */
    GC disabledGC;		/* Used to produce disabled effect.  If
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338



339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357







358
359
360
361
362
363
364
    int totalWidth;		/* Width of entire menu */
    int totalHeight;		/* Height of entire menu */
   
    /*
     * Miscellaneous information:
     */

    int tearOff;		/* 1 means this menu can be torn off. On some
    				 * platforms, the user can drag an outline
    				 * of the menu by just dragging outside of
    				 * the menu, and the tearoff is created where
    				 * the mouse is released. On others, an
				 * indicator (such as a dashed stripe) is
				 * drawn, and when the menu is selected, the
				 * tearoff is created. */
    char *title;		/* The title to use when this menu is torn
    				 * off. If this is NULL, a default scheme
    				 * will be used to generate a title for
    				 * tearoff. */
    char *tearOffCommand;	/* If non-NULL, points to a command to
				 * run whenever the menu is torn-off. */
    char *takeFocus;		/* Value of -takefocus option;  not used in
				 * the C code, but used by keyboard traversal
				 * scripts.  Malloc'ed, but may be NULL. */
    Tk_Cursor cursor;		/* Current cursor for window, or None. */
    char *postCommand;		/* Used to detect cycles in cascade hierarchy
    				 * trees when preprocessing postcommands
    				 * on some platforms. See PostMenu for
    				 * more details. */
    int postCommandGeneration;	/* Need to do pre-invocation post command
				 * traversal */
    int menuFlags;		/* Flags for use by X; see below for
				   definition */
    TkMenuEntry *postedCascade;	/* Points to menu entry for cascaded submenu
				 * that is currently posted or NULL if no
				 * submenu posted. */
    struct TkMenu *nextInstancePtr;	
    				/* The next instance of this menu in the
    				 * chain. */
    struct TkMenu *masterMenuPtr;
    				/* A pointer to the original menu for this
    				 * clone chain. Points back to this structure
    				 * if this menu is a master menu. */



    Tk_Window parentTopLevelPtr;/* If this menu is a menubar, this is the
    				 * toplevel that owns the menu. Only applicable
    				 * for menubar clones.
    				 */
    struct TkMenuReferences *menuRefPtr;	
    				/* Each menu is hashed into a table with the
    				 * name of the menu's window as the key.
    				 * The information in this hash table includes
    				 * a pointer to the menu (so that cascades
    				 * can find this menu), a pointer to the
    				 * list of toplevel widgets that have this
    				 * menu as its menubar, and a list of menu
    				 * entries that have this menu specified
    				 * as a cascade. */    
    TkMenuPlatformData platformData;
				/* The data for the specific type of menu.
  				 * Depends on platform and menu type what
  				 * kind of options are in this structure.
  				 */







} TkMenu;

/*
 * When the toplevel configure -menu command is executed, the menu may not
 * exist yet. We need to keep a linked list of windows that reference
 * a particular menu.
 */







|







|



|

|


|
|

















>
>
>



















>
>
>
>
>
>
>







305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
    int totalWidth;		/* Width of entire menu */
    int totalHeight;		/* Height of entire menu */
   
    /*
     * Miscellaneous information:
     */

    int tearoff;		/* 1 means this menu can be torn off. On some
    				 * platforms, the user can drag an outline
    				 * of the menu by just dragging outside of
    				 * the menu, and the tearoff is created where
    				 * the mouse is released. On others, an
				 * indicator (such as a dashed stripe) is
				 * drawn, and when the menu is selected, the
				 * tearoff is created. */
    Tcl_Obj *titlePtr;		/* The title to use when this menu is torn
    				 * off. If this is NULL, a default scheme
    				 * will be used to generate a title for
    				 * tearoff. */
    Tcl_Obj *tearoffCommandPtr;	/* If non-NULL, points to a command to
				 * run whenever the menu is torn-off. */
    Tcl_Obj *takeFocusPtr;	/* Value of -takefocus option;  not used in
				 * the C code, but used by keyboard traversal
				 * scripts.  Malloc'ed, but may be NULL. */
    Tcl_Obj *cursorPtr;		/* Current cursor for window, or None. */
    Tcl_Obj *postCommandPtr;	/* Used to detect cycles in cascade hierarchy
    				 * trees when preprocessing postcommands
    				 * on some platforms. See PostMenu for
    				 * more details. */
    int postCommandGeneration;	/* Need to do pre-invocation post command
				 * traversal */
    int menuFlags;		/* Flags for use by X; see below for
				   definition */
    TkMenuEntry *postedCascade;	/* Points to menu entry for cascaded submenu
				 * that is currently posted or NULL if no
				 * submenu posted. */
    struct TkMenu *nextInstancePtr;	
    				/* The next instance of this menu in the
    				 * chain. */
    struct TkMenu *masterMenuPtr;
    				/* A pointer to the original menu for this
    				 * clone chain. Points back to this structure
    				 * if this menu is a master menu. */
    struct TkMenuOptionTables *optionTablesPtr;
				/* A pointer to the collection of option tables
				 * that work with menus and menu entries. */
    Tk_Window parentTopLevelPtr;/* If this menu is a menubar, this is the
    				 * toplevel that owns the menu. Only applicable
    				 * for menubar clones.
    				 */
    struct TkMenuReferences *menuRefPtr;	
    				/* Each menu is hashed into a table with the
    				 * name of the menu's window as the key.
    				 * The information in this hash table includes
    				 * a pointer to the menu (so that cascades
    				 * can find this menu), a pointer to the
    				 * list of toplevel widgets that have this
    				 * menu as its menubar, and a list of menu
    				 * entries that have this menu specified
    				 * as a cascade. */    
    TkMenuPlatformData platformData;
				/* The data for the specific type of menu.
  				 * Depends on platform and menu type what
  				 * kind of options are in this structure.
  				 */
    Tk_OptionSpec *extensionPtr;
				/* Needed by the configuration package for
				 * this widget to be extended. */
    Tk_SavedOptions *errorStructPtr;
				/* We actually have to allocate these because
				 * multiple menus get changed during one
				 * ConfigureMenu call. */
} TkMenu;

/*
 * When the toplevel configure -menu command is executed, the menu may not
 * exist yet. We need to keep a linked list of windows that reference
 * a particular menu.
 */
397
398
399
400
401
402
403










404
405
406
407
408
409
410
    				 * NULL means no cascade entries. */
    Tcl_HashEntry *hashEntryPtr;/* This is needed because the pathname of the
    				 * window (which is what we hash on) may not
    				 * be around when we are deleting.
    				 */
} TkMenuReferences;











/*
 * Flag bits for menus:
 *
 * REDRAW_PENDING:		Non-zero means a DoWhenIdle handler
 *				has already been queued to redraw
 *				this window.
 * RESIZE_PENDING:		Non-zero means a call to ComputeMenuGeometry







>
>
>
>
>
>
>
>
>
>







416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
    				 * NULL means no cascade entries. */
    Tcl_HashEntry *hashEntryPtr;/* This is needed because the pathname of the
    				 * window (which is what we hash on) may not
    				 * be around when we are deleting.
    				 */
} TkMenuReferences;

/*
 * This structure contains all of the option tables that are needed
 * by menus.
 */

typedef struct TkMenuOptionTables {
    Tk_OptionTable menuOptionTable;	/* The option table for menus. */
    Tk_OptionTable entryOptionTables[6];/* The tables for menu entries. */
} TkMenuOptionTables;

/*
 * Flag bits for menus:
 *
 * REDRAW_PENDING:		Non-zero means a DoWhenIdle handler
 *				has already been queued to redraw
 *				this window.
 * RESIZE_PENDING:		Non-zero means a call to ComputeMenuGeometry
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
 * Various geometry definitions:
 */

#define CASCADE_ARROW_HEIGHT 10
#define CASCADE_ARROW_WIDTH 8
#define DECORATION_BORDER_WIDTH 2

/*
 * Configuration specs. Needed for platform-specific default initializations.
 */

EXTERN Tk_ConfigSpec tkMenuEntryConfigSpecs[];
EXTERN Tk_ConfigSpec tkMenuConfigSpecs[];

/*
 * Menu-related procedures that are shared among Tk modules but not exported
 * to the outside world:
 */

EXTERN int		TkActivateMenuEntry _ANSI_ARGS_((TkMenu *menuPtr,
			    int index));
EXTERN void		TkBindMenu _ANSI_ARGS_((
			    Tk_Window tkwin, TkMenu *menuPtr));
EXTERN TkMenuReferences *
			TkCreateMenuReferences _ANSI_ARGS_((Tcl_Interp *interp,
			    char *pathName));
EXTERN void		TkDestroyMenu _ANSI_ARGS_((TkMenu *menuPtr));
EXTERN void             TkEventuallyRecomputeMenu _ANSI_ARGS_((TkMenu *menuPtr));

EXTERN void		TkEventuallyRedrawMenu _ANSI_ARGS_((
    			    TkMenu *menuPtr, TkMenuEntry *mePtr));
EXTERN TkMenuReferences *
			TkFindMenuReferences _ANSI_ARGS_((Tcl_Interp *interp,
			    char *pathName));



EXTERN void		TkFreeMenuReferences _ANSI_ARGS_((
			    TkMenuReferences *menuRefPtr));
EXTERN Tcl_HashTable *	TkGetMenuHashTable _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int		TkGetMenuIndex _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, char *string, int lastOK,
			    int *indexPtr));
EXTERN void		TkMenuInitializeDrawingFields _ANSI_ARGS_((TkMenu *menuPtr));

EXTERN void		TkMenuInitializeEntryDrawingFields _ANSI_ARGS_((
			    TkMenuEntry *mePtr));
EXTERN int		TkInvokeMenu _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, int index));
EXTERN void		TkMenuConfigureDrawOptions _ANSI_ARGS_((
			    TkMenu *menuPtr));
EXTERN int		TkMenuConfigureEntryDrawOptions _ANSI_ARGS_((







<
<
<
<
<
<
<











|

|
>




|
>
>
>




|

|
>







472
473
474
475
476
477
478







479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
 * Various geometry definitions:
 */

#define CASCADE_ARROW_HEIGHT 10
#define CASCADE_ARROW_WIDTH 8
#define DECORATION_BORDER_WIDTH 2








/*
 * Menu-related procedures that are shared among Tk modules but not exported
 * to the outside world:
 */

EXTERN int		TkActivateMenuEntry _ANSI_ARGS_((TkMenu *menuPtr,
			    int index));
EXTERN void		TkBindMenu _ANSI_ARGS_((
			    Tk_Window tkwin, TkMenu *menuPtr));
EXTERN TkMenuReferences *
			TkCreateMenuReferences _ANSI_ARGS_((Tcl_Interp *interp,
			    char *name));
EXTERN void		TkDestroyMenu _ANSI_ARGS_((TkMenu *menuPtr));
EXTERN void             TkEventuallyRecomputeMenu _ANSI_ARGS_((
			    TkMenu *menuPtr));
EXTERN void		TkEventuallyRedrawMenu _ANSI_ARGS_((
    			    TkMenu *menuPtr, TkMenuEntry *mePtr));
EXTERN TkMenuReferences *
			TkFindMenuReferences _ANSI_ARGS_((Tcl_Interp *interp,
			    char *name));
EXTERN TkMenuReferences *
			TkFindMenuReferencesObj _ANSI_ARGS_((
			    Tcl_Interp *interp, Tcl_Obj *namePtr));
EXTERN void		TkFreeMenuReferences _ANSI_ARGS_((
			    TkMenuReferences *menuRefPtr));
EXTERN Tcl_HashTable *	TkGetMenuHashTable _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int		TkGetMenuIndex _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, Tcl_Obj *objPtr, int lastOK,
			    int *indexPtr));
EXTERN void		TkMenuInitializeDrawingFields _ANSI_ARGS_((
			    TkMenu *menuPtr));
EXTERN void		TkMenuInitializeEntryDrawingFields _ANSI_ARGS_((
			    TkMenuEntry *mePtr));
EXTERN int		TkInvokeMenu _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, int index));
EXTERN void		TkMenuConfigureDrawOptions _ANSI_ARGS_((
			    TkMenu *menuPtr));
EXTERN int		TkMenuConfigureEntryDrawOptions _ANSI_ARGS_((
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519

520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539



540
541
    			    ClientData clientData, int x, int y, int width,
			    int height, int imgWidth, int imgHeight));
EXTERN void		TkMenuInit _ANSI_ARGS_((void));
EXTERN void		TkMenuSelectImageProc _ANSI_ARGS_
			    ((ClientData clientData, int x, int y,
			    int width, int height, int imgWidth,
			    int imgHeight));
EXTERN char *		TkNewMenuName _ANSI_ARGS_((Tcl_Interp *interp, 
			    char *parentName, TkMenu *menuPtr));
EXTERN int		TkPostCommand _ANSI_ARGS_((TkMenu *menuPtr));
EXTERN int		TkPostSubmenu _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, TkMenuEntry *mePtr));
EXTERN int		TkPostTearoffMenu _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, int x, int y));
EXTERN int		TkPreprocessMenu _ANSI_ARGS_((TkMenu *menuPtr));
EXTERN void             TkRecomputeMenu _ANSI_ARGS_((TkMenu *menuPtr));

/*
 * These routines are the platform-dependent routines called by the
 * common code.
 */

EXTERN void		TkpComputeMenubarGeometry _ANSI_ARGS_((TkMenu *menuPtr));

EXTERN void		TkpComputeStandardMenuGeometry _ANSI_ARGS_
			    ((TkMenu *menuPtr));
EXTERN int		TkpConfigureMenuEntry
                            _ANSI_ARGS_((TkMenuEntry *mePtr));
EXTERN void		TkpDestroyMenu _ANSI_ARGS_((TkMenu *menuPtr));
EXTERN void		TkpDestroyMenuEntry
			    _ANSI_ARGS_((TkMenuEntry *mEntryPtr));
EXTERN void		TkpDrawMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr,
			    Drawable d, Tk_Font tkfont, 
			    CONST Tk_FontMetrics *menuMetricsPtr, int x,
			    int y, int width, int height, int strictMotif,
			    int drawArrow));
EXTERN void		TkpMenuInit _ANSI_ARGS_((void));
EXTERN int		TkpMenuNewEntry _ANSI_ARGS_((TkMenuEntry *mePtr));
EXTERN int		TkpNewMenu _ANSI_ARGS_((TkMenu *menuPtr));
EXTERN int		TkpPostMenu _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, int x, int y));
EXTERN void		TkpSetWindowMenuBar _ANSI_ARGS_((Tk_Window tkwin,
			    TkMenu *menuPtr));




#endif /* _TKMENU */








|
|













|
>




















>
>
>


524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
    			    ClientData clientData, int x, int y, int width,
			    int height, int imgWidth, int imgHeight));
EXTERN void		TkMenuInit _ANSI_ARGS_((void));
EXTERN void		TkMenuSelectImageProc _ANSI_ARGS_
			    ((ClientData clientData, int x, int y,
			    int width, int height, int imgWidth,
			    int imgHeight));
EXTERN Tcl_Obj *	TkNewMenuName _ANSI_ARGS_((Tcl_Interp *interp, 
			    Tcl_Obj *parentNamePtr, TkMenu *menuPtr));
EXTERN int		TkPostCommand _ANSI_ARGS_((TkMenu *menuPtr));
EXTERN int		TkPostSubmenu _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, TkMenuEntry *mePtr));
EXTERN int		TkPostTearoffMenu _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, int x, int y));
EXTERN int		TkPreprocessMenu _ANSI_ARGS_((TkMenu *menuPtr));
EXTERN void             TkRecomputeMenu _ANSI_ARGS_((TkMenu *menuPtr));

/*
 * These routines are the platform-dependent routines called by the
 * common code.
 */

EXTERN void		TkpComputeMenubarGeometry _ANSI_ARGS_((
			    TkMenu *menuPtr));
EXTERN void		TkpComputeStandardMenuGeometry _ANSI_ARGS_
			    ((TkMenu *menuPtr));
EXTERN int		TkpConfigureMenuEntry
                            _ANSI_ARGS_((TkMenuEntry *mePtr));
EXTERN void		TkpDestroyMenu _ANSI_ARGS_((TkMenu *menuPtr));
EXTERN void		TkpDestroyMenuEntry
			    _ANSI_ARGS_((TkMenuEntry *mEntryPtr));
EXTERN void		TkpDrawMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr,
			    Drawable d, Tk_Font tkfont, 
			    CONST Tk_FontMetrics *menuMetricsPtr, int x,
			    int y, int width, int height, int strictMotif,
			    int drawArrow));
EXTERN void		TkpMenuInit _ANSI_ARGS_((void));
EXTERN int		TkpMenuNewEntry _ANSI_ARGS_((TkMenuEntry *mePtr));
EXTERN int		TkpNewMenu _ANSI_ARGS_((TkMenu *menuPtr));
EXTERN int		TkpPostMenu _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenu *menuPtr, int x, int y));
EXTERN void		TkpSetWindowMenuBar _ANSI_ARGS_((Tk_Window tkwin,
			    TkMenu *menuPtr));

# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TKMENU */

Changes to generic/tkMenuDraw.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkMenuDraw.c --
 *
 *	This module implements the platform-independent drawing and
 *	geometry calculations of menu widgets.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMenuDraw.c 1.46 97/10/28 14:26:00
 */

#include "tkMenu.h"

/*
 * Forward declarations for procedures defined later in this file:
 */











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkMenuDraw.c --
 *
 *	This module implements the platform-independent drawing and
 *	geometry calculations of menu widgets.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMenuDraw.c,v 1.1.4.3 1998/11/24 21:42:43 stanton Exp $
 */

#include "tkMenu.h"

/*
 * Forward declarations for procedures defined later in this file:
 */
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

/*
 *----------------------------------------------------------------------
 *
 * TkMenuInitializeDrawingFields --
 *
 *	Fills in drawing fields of a new menu. Called when new menu is
 *	created by Tk_MenuCmd.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	menuPtr fields are initialized.
 *







|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

/*
 *----------------------------------------------------------------------
 *
 * TkMenuInitializeDrawingFields --
 *
 *	Fills in drawing fields of a new menu. Called when new menu is
 *	created by MenuCmd.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	menuPtr fields are initialized.
 *
184
185
186
187
188
189
190



191
192
193
194
195
196
197

198
199

200

201
202
203
204
205
206
207
208
209
210
211
212




213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250

251


252
253
254
255
256
257
258
259
260


261
262
263
264
265
266
267
268
269
void
TkMenuConfigureDrawOptions(menuPtr)
    TkMenu *menuPtr;		/* The menu we are configuring. */
{
    XGCValues gcValues;
    GC newGC;
    unsigned long mask;



 
    /*
     * A few options need special processing, such as setting the
     * background from a 3-D border, or filling in complicated
     * defaults that couldn't be specified to Tk_ConfigureWidget.
     */


    Tk_SetBackgroundFromBorder(menuPtr->tkwin, menuPtr->border);


    gcValues.font = Tk_FontId(menuPtr->tkfont);

    gcValues.foreground = menuPtr->fg->pixel;
    gcValues.background = Tk_3DBorderColor(menuPtr->border)->pixel;
    newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
	    &gcValues);
    if (menuPtr->textGC != None) {
	Tk_FreeGC(menuPtr->display, menuPtr->textGC);
    }
    menuPtr->textGC = newGC;

    gcValues.font = Tk_FontId(menuPtr->tkfont);
    gcValues.background = Tk_3DBorderColor(menuPtr->border)->pixel;
    if (menuPtr->disabledFg != NULL) {




	gcValues.foreground = menuPtr->disabledFg->pixel;
	mask = GCForeground|GCBackground|GCFont;
    } else {
	gcValues.foreground = gcValues.background;
	mask = GCForeground;
	if (menuPtr->gray == None) {
	    menuPtr->gray = Tk_GetBitmap(menuPtr->interp, menuPtr->tkwin,
		    Tk_GetUid("gray50"));
	}
	if (menuPtr->gray != None) {
	    gcValues.fill_style = FillStippled;
	    gcValues.stipple = menuPtr->gray;
	    mask = GCForeground|GCFillStyle|GCStipple;
	}
    }
    newGC = Tk_GetGC(menuPtr->tkwin, mask, &gcValues);
    if (menuPtr->disabledGC != None) {
	Tk_FreeGC(menuPtr->display, menuPtr->disabledGC);
    }
    menuPtr->disabledGC = newGC;

    gcValues.foreground = Tk_3DBorderColor(menuPtr->border)->pixel;
    if (menuPtr->gray == None) {
	menuPtr->gray = Tk_GetBitmap(menuPtr->interp, menuPtr->tkwin,
		Tk_GetUid("gray50"));
    }
    if (menuPtr->gray != None) {
	gcValues.fill_style = FillStippled;
	gcValues.stipple = menuPtr->gray;
	newGC = Tk_GetGC(menuPtr->tkwin, 
	    GCForeground|GCFillStyle|GCStipple, &gcValues);
    }
    if (menuPtr->disabledImageGC != None) {
	Tk_FreeGC(menuPtr->display, menuPtr->disabledImageGC);
    }
    menuPtr->disabledImageGC = newGC;

    gcValues.font = Tk_FontId(menuPtr->tkfont);

    gcValues.foreground = menuPtr->activeFg->pixel;


    gcValues.background =
	    Tk_3DBorderColor(menuPtr->activeBorder)->pixel;
    newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
	    &gcValues);
    if (menuPtr->activeGC != None) {
	Tk_FreeGC(menuPtr->display, menuPtr->activeGC);
    }
    menuPtr->activeGC = newGC;



    gcValues.foreground = menuPtr->indicatorFg->pixel;
    gcValues.background = Tk_3DBorderColor(menuPtr->border)->pixel;
    newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
	    &gcValues);
    if (menuPtr->indicatorGC != None) {
	Tk_FreeGC(menuPtr->display, menuPtr->indicatorGC);
    }
    menuPtr->indicatorGC = newGC;
}







>
>
>







>
|

>
|
>
|
|







|
|
|
>
>
>
>
|






|













|


|












|
>
|
>
>
|
<







>
>
|
|







184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265

266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
void
TkMenuConfigureDrawOptions(menuPtr)
    TkMenu *menuPtr;		/* The menu we are configuring. */
{
    XGCValues gcValues;
    GC newGC;
    unsigned long mask;
    Tk_3DBorder border, activeBorder;
    Tk_Font tkfont;
    XColor *fg, *activeFg, *indicatorFg;
 
    /*
     * A few options need special processing, such as setting the
     * background from a 3-D border, or filling in complicated
     * defaults that couldn't be specified to Tk_ConfigureWidget.
     */

    border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
    Tk_SetBackgroundFromBorder(menuPtr->tkwin, border);

    tkfont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
    gcValues.font = Tk_FontId(tkfont);
    fg = Tk_GetColorFromObj(menuPtr->tkwin, menuPtr->fgPtr);
    gcValues.foreground = fg->pixel;
    gcValues.background = Tk_3DBorderColor(border)->pixel;
    newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
	    &gcValues);
    if (menuPtr->textGC != None) {
	Tk_FreeGC(menuPtr->display, menuPtr->textGC);
    }
    menuPtr->textGC = newGC;

    gcValues.font = Tk_FontId(tkfont);
    gcValues.background = Tk_3DBorderColor(border)->pixel;
    if (menuPtr->disabledFgPtr != NULL) {
	XColor *disabledFg;

	disabledFg = Tk_GetColorFromObj(menuPtr->tkwin, 
		menuPtr->disabledFgPtr);
	gcValues.foreground = disabledFg->pixel;
	mask = GCForeground|GCBackground|GCFont;
    } else {
	gcValues.foreground = gcValues.background;
	mask = GCForeground;
	if (menuPtr->gray == None) {
	    menuPtr->gray = Tk_GetBitmap(menuPtr->interp, menuPtr->tkwin,
		    "gray50");
	}
	if (menuPtr->gray != None) {
	    gcValues.fill_style = FillStippled;
	    gcValues.stipple = menuPtr->gray;
	    mask = GCForeground|GCFillStyle|GCStipple;
	}
    }
    newGC = Tk_GetGC(menuPtr->tkwin, mask, &gcValues);
    if (menuPtr->disabledGC != None) {
	Tk_FreeGC(menuPtr->display, menuPtr->disabledGC);
    }
    menuPtr->disabledGC = newGC;

    gcValues.foreground = Tk_3DBorderColor(border)->pixel;
    if (menuPtr->gray == None) {
	menuPtr->gray = Tk_GetBitmap(menuPtr->interp, menuPtr->tkwin,
		"gray50");
    }
    if (menuPtr->gray != None) {
	gcValues.fill_style = FillStippled;
	gcValues.stipple = menuPtr->gray;
	newGC = Tk_GetGC(menuPtr->tkwin, 
	    GCForeground|GCFillStyle|GCStipple, &gcValues);
    }
    if (menuPtr->disabledImageGC != None) {
	Tk_FreeGC(menuPtr->display, menuPtr->disabledImageGC);
    }
    menuPtr->disabledImageGC = newGC;

    gcValues.font = Tk_FontId(tkfont);
    activeFg = Tk_GetColorFromObj(menuPtr->tkwin, menuPtr->activeFgPtr);
    gcValues.foreground = activeFg->pixel;
    activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin, 
	    menuPtr->activeBorderPtr);
    gcValues.background = Tk_3DBorderColor(activeBorder)->pixel;

    newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
	    &gcValues);
    if (menuPtr->activeGC != None) {
	Tk_FreeGC(menuPtr->display, menuPtr->activeGC);
    }
    menuPtr->activeGC = newGC;

    indicatorFg = Tk_GetColorFromObj(menuPtr->tkwin, 
	    menuPtr->indicatorFgPtr);
    gcValues.foreground = indicatorFg->pixel;
    gcValues.background = Tk_3DBorderColor(border)->pixel;
    newGC = Tk_GetGC(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
	    &gcValues);
    if (menuPtr->indicatorGC != None) {
	Tk_FreeGC(menuPtr->display, menuPtr->indicatorGC);
    }
    menuPtr->indicatorGC = newGC;
}
293
294
295
296
297
298
299

300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325


326

327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357




358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373


374
375
376
377
378
379
380
381

    XGCValues gcValues;
    GC newGC, newActiveGC, newDisabledGC, newIndicatorGC;
    unsigned long mask;
    Tk_Font tkfont;
    TkMenu *menuPtr = mePtr->menuPtr;


    tkfont = (mePtr->tkfont == NULL) ? menuPtr->tkfont : mePtr->tkfont;
    
    if (mePtr->state == tkActiveUid) {
	if (index != menuPtr->active) {
	    TkActivateMenuEntry(menuPtr, index);
	}
    } else {
	if (index == menuPtr->active) {
	    TkActivateMenuEntry(menuPtr, -1);
	}
	if ((mePtr->state != tkNormalUid)
		&& (mePtr->state != tkDisabledUid)) {
	    Tcl_AppendResult(menuPtr->interp, "bad state value \"",
		    mePtr->state,
		    "\": must be normal, active, or disabled", (char *) NULL);
	    mePtr->state = tkNormalUid;
	    return TCL_ERROR;
	}
    }

    if ((mePtr->tkfont != NULL)
	    || (mePtr->border != NULL)
	    || (mePtr->fg != NULL)
	    || (mePtr->activeBorder != NULL)
	    || (mePtr->activeFg != NULL)
	    || (mePtr->indicatorFg != NULL)) {


	gcValues.foreground = (mePtr->fg != NULL)

	        ? mePtr->fg->pixel
		: menuPtr->fg->pixel;
	gcValues.background = Tk_3DBorderColor(
		(mePtr->border != NULL)
		? mePtr->border
		: menuPtr->border)
		->pixel;

	gcValues.font = Tk_FontId(tkfont);

	/*
	 * Note: disable GraphicsExpose events;  we know there won't be
	 * obscured areas when copying from an off-screen pixmap to the
	 * screen and this gets rid of unnecessary events.
	 */

	gcValues.graphics_exposures = False;
	newGC = Tk_GetGC(menuPtr->tkwin,
		GCForeground|GCBackground|GCFont|GCGraphicsExposures,
		&gcValues);

	if (mePtr->indicatorFg != NULL) {
	    gcValues.foreground = mePtr->indicatorFg->pixel;
	} else if (menuPtr->indicatorFg != NULL) {
	    gcValues.foreground = menuPtr->indicatorFg->pixel;
	}
	newIndicatorGC = Tk_GetGC(menuPtr->tkwin,
		GCForeground|GCBackground|GCGraphicsExposures,
		&gcValues);

	if ((menuPtr->disabledFg != NULL) || (mePtr->image != NULL)) {




	    gcValues.foreground = menuPtr->disabledFg->pixel;
	    mask = GCForeground|GCBackground|GCFont|GCGraphicsExposures;
	} else {
	    gcValues.foreground = gcValues.background;
	    gcValues.fill_style = FillStippled;
	    gcValues.stipple = menuPtr->gray;
	    mask = GCForeground|GCFillStyle|GCStipple;
	}
	newDisabledGC = Tk_GetGC(menuPtr->tkwin, mask, &gcValues);

	gcValues.foreground = (mePtr->activeFg != NULL)
		? mePtr->activeFg->pixel
	        : menuPtr->activeFg->pixel;
	gcValues.background = Tk_3DBorderColor(
		(mePtr->activeBorder != NULL)
		? mePtr->activeBorder


		: menuPtr->activeBorder)->pixel;
	newActiveGC = Tk_GetGC(menuPtr->tkwin,
		GCForeground|GCBackground|GCFont|GCGraphicsExposures,
		&gcValues);
    } else {
	newGC = None;
	newActiveGC = None;
	newDisabledGC = None;







>
|

|







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














|
|
|
|
<




|
>
>
>
>
|









|
|
|
|
|
|
>
>
|







307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324







325
326

327
328
329
330
331
332
333
334
335
336
337
338
339
340

341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360

361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395

    XGCValues gcValues;
    GC newGC, newActiveGC, newDisabledGC, newIndicatorGC;
    unsigned long mask;
    Tk_Font tkfont;
    TkMenu *menuPtr = mePtr->menuPtr;

    tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
	    (mePtr->fontPtr != NULL) ? mePtr->fontPtr : menuPtr->fontPtr);
    
    if (mePtr->state == ENTRY_ACTIVE) {
	if (index != menuPtr->active) {
	    TkActivateMenuEntry(menuPtr, index);
	}
    } else {
	if (index == menuPtr->active) {
	    TkActivateMenuEntry(menuPtr, -1);
	}







    }


    if ((mePtr->fontPtr != NULL)
	    || (mePtr->borderPtr != NULL)
	    || (mePtr->fgPtr != NULL)
	    || (mePtr->activeBorderPtr != NULL)
	    || (mePtr->activeFgPtr != NULL)
	    || (mePtr->indicatorFgPtr != NULL)) {
	XColor *fg, *indicatorFg, *activeFg;
	Tk_3DBorder border, activeBorder;
    
	fg = Tk_GetColorFromObj(menuPtr->tkwin, (mePtr->fgPtr != NULL)
		? mePtr->fgPtr : menuPtr->fgPtr);
	gcValues.foreground = fg->pixel;
	border = Tk_Get3DBorderFromObj(menuPtr->tkwin, 
		(mePtr->borderPtr != NULL) ? mePtr->borderPtr 

		: menuPtr->borderPtr);
	gcValues.background = Tk_3DBorderColor(border)->pixel;

	gcValues.font = Tk_FontId(tkfont);

	/*
	 * Note: disable GraphicsExpose events;  we know there won't be
	 * obscured areas when copying from an off-screen pixmap to the
	 * screen and this gets rid of unnecessary events.
	 */

	gcValues.graphics_exposures = False;
	newGC = Tk_GetGC(menuPtr->tkwin,
		GCForeground|GCBackground|GCFont|GCGraphicsExposures,
		&gcValues);

	indicatorFg = Tk_GetColorFromObj(menuPtr->tkwin, 
		(mePtr->indicatorFgPtr != NULL) ? mePtr->indicatorFgPtr
		: menuPtr->indicatorFgPtr);
	gcValues.foreground = indicatorFg->pixel;

	newIndicatorGC = Tk_GetGC(menuPtr->tkwin,
		GCForeground|GCBackground|GCGraphicsExposures,
		&gcValues);

	if ((menuPtr->disabledFgPtr != NULL) || (mePtr->image != NULL)) {
	    XColor *disabledFg;

	    disabledFg = Tk_GetColorFromObj(menuPtr->tkwin, 
		    menuPtr->disabledFgPtr);
	    gcValues.foreground = disabledFg->pixel;
	    mask = GCForeground|GCBackground|GCFont|GCGraphicsExposures;
	} else {
	    gcValues.foreground = gcValues.background;
	    gcValues.fill_style = FillStippled;
	    gcValues.stipple = menuPtr->gray;
	    mask = GCForeground|GCFillStyle|GCStipple;
	}
	newDisabledGC = Tk_GetGC(menuPtr->tkwin, mask, &gcValues);

	activeFg = Tk_GetColorFromObj(menuPtr->tkwin, 
		(mePtr->activeFgPtr != NULL) ? mePtr->activeFgPtr
		: menuPtr->activeFgPtr);
	activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin, 
		(mePtr->activeBorderPtr != NULL) ? mePtr->activeBorderPtr 
		: menuPtr->activeBorderPtr);
		
	gcValues.foreground = activeFg->pixel;
	gcValues.background = Tk_3DBorderColor(activeBorder)->pixel;
	newActiveGC = Tk_GetGC(menuPtr->tkwin,
		GCForeground|GCBackground|GCFont|GCGraphicsExposures,
		&gcValues);
    } else {
	newGC = None;
	newActiveGC = None;
	newDisabledGC = None;
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
 *
 *----------------------------------------------------------------------
 */

void
TkEventuallyRedrawMenu(menuPtr, mePtr)
    register TkMenu *menuPtr;	/* Information about menu to redraw. */
    register TkMenuEntry *mePtr;	/* Entry to redraw.  NULL means redraw
				 * all the entries in the menu. */
{
    int i;
    
    if (menuPtr->tkwin == NULL) {
	return;
    }







|







485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
 *
 *----------------------------------------------------------------------
 */

void
TkEventuallyRedrawMenu(menuPtr, mePtr)
    register TkMenu *menuPtr;	/* Information about menu to redraw. */
    register TkMenuEntry *mePtr;/* Entry to redraw.  NULL means redraw
				 * all the entries in the menu. */
{
    int i;
    
    if (menuPtr->tkwin == NULL) {
	return;
    }
612
613
614
615
616
617
618
619
620
621





622
623
624
625
626
627






628
629
630
631
632
633
634
635
636
637
638
639
640
641
642

643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705

706
707
708
709
710
711
712
713
714
715
DisplayMenu(clientData)
    ClientData clientData;	/* Information about widget. */
{
    register TkMenu *menuPtr = (TkMenu *) clientData;
    register TkMenuEntry *mePtr;
    register Tk_Window tkwin = menuPtr->tkwin;
    int index, strictMotif;
    Tk_Font tkfont = menuPtr->tkfont;
    Tk_FontMetrics menuMetrics;
    int width;






    menuPtr->menuFlags &= ~REDRAW_PENDING;
    if ((menuPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
	return;
    }







    if (menuPtr->menuType == MENUBAR) {
	Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), menuPtr->border,
		menuPtr->borderWidth, menuPtr->borderWidth,
		Tk_Width(tkwin) - 2 * menuPtr->borderWidth,
		Tk_Height(tkwin) - 2 * menuPtr->borderWidth, 0,
		TK_RELIEF_FLAT);
    }

    strictMotif = Tk_StrictMotif(menuPtr->tkwin);

    /*
     * See note in ComputeMenuGeometry. We don't want to be doing font metrics
     * all of the time.
     */


    Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics);

    /*
     * Loop through all of the entries, drawing them one at a time.
     */

    for (index = 0; index < menuPtr->numEntries; index++) {
	mePtr = menuPtr->entries[index];
	if (menuPtr->menuType != MENUBAR) {
	    if (!(mePtr->entryFlags & ENTRY_NEEDS_REDISPLAY)) {
		continue;
	    }
	}
	mePtr->entryFlags &= ~ENTRY_NEEDS_REDISPLAY;

	if (menuPtr->menuType == MENUBAR) {
	    width = mePtr->width;
	} else {
	    if (mePtr->entryFlags & ENTRY_LAST_COLUMN) {
		width = Tk_Width(menuPtr->tkwin) - mePtr->x
			- menuPtr->activeBorderWidth;
	    } else {
		width = mePtr->width + menuPtr->borderWidth;
	    }
	}
	TkpDrawMenuEntry(mePtr, Tk_WindowId(menuPtr->tkwin), tkfont,
		&menuMetrics, mePtr->x, mePtr->y, width, 
		mePtr->height, strictMotif, 1);
	if ((index > 0) && (menuPtr->menuType != MENUBAR) 
		&& mePtr->columnBreak) {
	    mePtr = menuPtr->entries[index - 1];
	    Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), menuPtr->border,
		mePtr->x, mePtr->y + mePtr->height, 
		mePtr->width,
		Tk_Height(tkwin) - mePtr->y - mePtr->height 
		- menuPtr->activeBorderWidth, 0,
		TK_RELIEF_FLAT);
	}
    }

    if (menuPtr->menuType != MENUBAR) {
	int x, y, height;

	if (menuPtr->numEntries == 0) {
	    x = y = menuPtr->borderWidth;
	    width = Tk_Width(tkwin) - 2 * menuPtr->activeBorderWidth;
	    height = Tk_Height(tkwin) - 2 * menuPtr->activeBorderWidth;
	} else {
	    mePtr = menuPtr->entries[menuPtr->numEntries - 1];
	    Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin),
		menuPtr->border, mePtr->x, mePtr->y + mePtr->height,
		mePtr->width, Tk_Height(tkwin) - mePtr->y - mePtr->height
		- menuPtr->activeBorderWidth, 0,
		TK_RELIEF_FLAT);
	    x = mePtr->x + mePtr->width;
	    y = mePtr->y + mePtr->height;
	    width = Tk_Width(tkwin) - x - menuPtr->activeBorderWidth;
	    height = Tk_Height(tkwin) - y - menuPtr->activeBorderWidth;
	}
	Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), menuPtr->border, x, y, 
		width, height, 0, TK_RELIEF_FLAT);
    }


    Tk_Draw3DRectangle(menuPtr->tkwin, Tk_WindowId(tkwin),
	    menuPtr->border, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin),
	    menuPtr->borderWidth, menuPtr->relief);
}

/*
 *--------------------------------------------------------------
 *
 * TkMenuEventProc --
 *







|


>
>
>
>
>






>
>
>
>
>
>

|
<
|
<
|









>
|



















|

|





|


|


|
|








|
|
|



|
|
|



|
|

|



>

|
|







626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654

655

656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
DisplayMenu(clientData)
    ClientData clientData;	/* Information about widget. */
{
    register TkMenu *menuPtr = (TkMenu *) clientData;
    register TkMenuEntry *mePtr;
    register Tk_Window tkwin = menuPtr->tkwin;
    int index, strictMotif;
    Tk_Font tkfont;
    Tk_FontMetrics menuMetrics;
    int width;
    int borderWidth;
    Tk_3DBorder border;
    int activeBorderWidth;
    int relief;


    menuPtr->menuFlags &= ~REDRAW_PENDING;
    if ((menuPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
	return;
    }

    Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
	    &borderWidth);
    border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
    Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
	    menuPtr->activeBorderWidthPtr, &activeBorderWidth);

    if (menuPtr->menuType == MENUBAR) {
	Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, borderWidth, 

		borderWidth, Tk_Width(tkwin) - 2 * borderWidth,	

		Tk_Height(tkwin) - 2 * borderWidth, 0, TK_RELIEF_FLAT);
    }

    strictMotif = Tk_StrictMotif(menuPtr->tkwin);

    /*
     * See note in ComputeMenuGeometry. We don't want to be doing font metrics
     * all of the time.
     */

    tkfont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
    Tk_GetFontMetrics(tkfont, &menuMetrics);

    /*
     * Loop through all of the entries, drawing them one at a time.
     */

    for (index = 0; index < menuPtr->numEntries; index++) {
	mePtr = menuPtr->entries[index];
	if (menuPtr->menuType != MENUBAR) {
	    if (!(mePtr->entryFlags & ENTRY_NEEDS_REDISPLAY)) {
		continue;
	    }
	}
	mePtr->entryFlags &= ~ENTRY_NEEDS_REDISPLAY;

	if (menuPtr->menuType == MENUBAR) {
	    width = mePtr->width;
	} else {
	    if (mePtr->entryFlags & ENTRY_LAST_COLUMN) {
		width = Tk_Width(menuPtr->tkwin) - mePtr->x
			- activeBorderWidth;
	    } else {
		width = mePtr->width + borderWidth;
	    }
	}
	TkpDrawMenuEntry(mePtr, Tk_WindowId(menuPtr->tkwin), tkfont,
		&menuMetrics, mePtr->x, mePtr->y, width, 
		mePtr->height, strictMotif, 1);
	if ((index > 0) && (menuPtr->menuType != MENUBAR)
		&& mePtr->columnBreak) {
	    mePtr = menuPtr->entries[index - 1];
	    Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border,
		mePtr->x, mePtr->y + mePtr->height, 
		mePtr->width,
		Tk_Height(tkwin) - mePtr->y - mePtr->height - 
		activeBorderWidth, 0,
		TK_RELIEF_FLAT);
	}
    }

    if (menuPtr->menuType != MENUBAR) {
	int x, y, height;

	if (menuPtr->numEntries == 0) {
	    x = y = borderWidth;
	    width = Tk_Width(tkwin) - 2 * activeBorderWidth;
	    height = Tk_Height(tkwin) - 2 * activeBorderWidth;
	} else {
	    mePtr = menuPtr->entries[menuPtr->numEntries - 1];
	    Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin),
		border, mePtr->x, mePtr->y + mePtr->height, mePtr->width, 
		Tk_Height(tkwin) - mePtr->y - mePtr->height
		- activeBorderWidth, 0,
		TK_RELIEF_FLAT);
	    x = mePtr->x + mePtr->width;
	    y = mePtr->y + mePtr->height;
	    width = Tk_Width(tkwin) - x - activeBorderWidth;
	    height = Tk_Height(tkwin) - y - activeBorderWidth;
	}
	Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, x, y, 
		width, height, 0, TK_RELIEF_FLAT);
    }

    Tk_GetReliefFromObj(NULL, menuPtr->reliefPtr, &relief);
    Tk_Draw3DRectangle(menuPtr->tkwin, Tk_WindowId(tkwin),
	    border, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), borderWidth, 
	    relief);
}

/*
 *--------------------------------------------------------------
 *
 * TkMenuEventProc --
 *
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
    
    if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
	TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
    } else if (eventPtr->type == ConfigureNotify) {
	TkEventuallyRecomputeMenu(menuPtr);
	TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
    } else if (eventPtr->type == ActivateNotify) {
    	if (menuPtr->menuType == TEAROFF_MENU) {
    	    TkpSetMainMenubar(menuPtr->interp, menuPtr->tkwin, NULL);
    	}
    } else if (eventPtr->type == DestroyNotify) {
	if (menuPtr->tkwin != NULL) {

	    menuPtr->tkwin = NULL;
	    Tcl_DeleteCommandFromToken(menuPtr->interp, menuPtr->widgetCmd);
	}
	if (menuPtr->menuFlags & REDRAW_PENDING) {
	    Tcl_CancelIdleCall(DisplayMenu, (ClientData) menuPtr);
	}
	if (menuPtr->menuFlags & RESIZE_PENDING) {
	    Tcl_CancelIdleCall(ComputeMenuGeometry, (ClientData) menuPtr);
	}
	TkDestroyMenu(menuPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkMenuImageProc --







|
|
|


>









|







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
    
    if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
	TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
    } else if (eventPtr->type == ConfigureNotify) {
	TkEventuallyRecomputeMenu(menuPtr);
	TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
    } else if (eventPtr->type == ActivateNotify) {
	if (menuPtr->menuType == TEAROFF_MENU) {
	    TkpSetMainMenubar(menuPtr->interp, menuPtr->tkwin, NULL);
	}
    } else if (eventPtr->type == DestroyNotify) {
	if (menuPtr->tkwin != NULL) {
	    TkDestroyMenu(menuPtr);
	    menuPtr->tkwin = NULL;
	    Tcl_DeleteCommandFromToken(menuPtr->interp, menuPtr->widgetCmd);
	}
	if (menuPtr->menuFlags & REDRAW_PENDING) {
	    Tcl_CancelIdleCall(DisplayMenu, (ClientData) menuPtr);
	}
	if (menuPtr->menuFlags & RESIZE_PENDING) {
	    Tcl_CancelIdleCall(ComputeMenuGeometry, (ClientData) menuPtr);
	}
	Tcl_EventuallyFree((ClientData) menuPtr, TCL_DYNAMIC);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkMenuImageProc --
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931


932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969




970
971
972
973
974
975
976
977
978
979
980
    Tcl_Interp *interp;		/* Used for invoking sub-commands and
				 * reporting errors. */
    register TkMenu *menuPtr;	/* Information about menu as a whole. */
    register TkMenuEntry *mePtr;	/* Info about submenu that is to be
				 * posted.  NULL means make sure that
				 * no submenu is posted. */
{
    char string[30];
    int result, x, y;

    if (mePtr == menuPtr->postedCascade) {
	return TCL_OK;
    }

    if (menuPtr->postedCascade != NULL) {



	/*
	 * Note: when unposting a submenu, we have to redraw the entire
	 * parent menu.  This is because of a combination of the following
	 * things:
	 * (a) the submenu partially overlaps the parent.
	 * (b) the submenu specifies "save under", which causes the X
	 *     server to make a copy of the information under it when it
	 *     is posted.  When the submenu is unposted, the X server
	 *     copies this data back and doesn't generate any Expose
	 *     events for the parent.
	 * (c) the parent may have redisplayed itself after the submenu
	 *     was posted, in which case the saved information is no
	 *     longer correct.
	 * The simplest solution is just force a complete redisplay of
	 * the parent.
	 */

	TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
	result = Tcl_VarEval(interp, menuPtr->postedCascade->name,
		" unpost", (char *) NULL);
	menuPtr->postedCascade = NULL;
	if (result != TCL_OK) {
	    return result;
	}
    }

    if ((mePtr != NULL) && (mePtr->name != NULL)
	    && Tk_IsMapped(menuPtr->tkwin)) {

	/*
	 * Position the cascade with its upper left corner slightly
	 * below and to the left of the upper right corner of the
	 * menu entry (this is an attempt to match Motif behavior).
	 *
	 * The menu has to redrawn so that the entry can change relief.
	 */





	Tk_GetRootCoords(menuPtr->tkwin, &x, &y);
	AdjustMenuCoords(menuPtr, mePtr, &x, &y, string);
	result = Tcl_VarEval(interp, mePtr->name, " post ", string,
		(char *) NULL);
	if (result != TCL_OK) {
	    return result;
	}
	menuPtr->postedCascade = mePtr;
	TkEventuallyRedrawMenu(menuPtr, mePtr);
    }
    return TCL_OK;







<







>
>



















<
|






|

<








>
>
>
>


|
<







943
944
945
946
947
948
949

950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977

978
979
980
981
982
983
984
985
986

987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001

1002
1003
1004
1005
1006
1007
1008
    Tcl_Interp *interp;		/* Used for invoking sub-commands and
				 * reporting errors. */
    register TkMenu *menuPtr;	/* Information about menu as a whole. */
    register TkMenuEntry *mePtr;	/* Info about submenu that is to be
				 * posted.  NULL means make sure that
				 * no submenu is posted. */
{

    int result, x, y;

    if (mePtr == menuPtr->postedCascade) {
	return TCL_OK;
    }

    if (menuPtr->postedCascade != NULL) {
	char *name = Tcl_GetStringFromObj(menuPtr->postedCascade->namePtr,
		NULL);

	/*
	 * Note: when unposting a submenu, we have to redraw the entire
	 * parent menu.  This is because of a combination of the following
	 * things:
	 * (a) the submenu partially overlaps the parent.
	 * (b) the submenu specifies "save under", which causes the X
	 *     server to make a copy of the information under it when it
	 *     is posted.  When the submenu is unposted, the X server
	 *     copies this data back and doesn't generate any Expose
	 *     events for the parent.
	 * (c) the parent may have redisplayed itself after the submenu
	 *     was posted, in which case the saved information is no
	 *     longer correct.
	 * The simplest solution is just force a complete redisplay of
	 * the parent.
	 */

	TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);

	result = Tcl_VarEval(interp, name, " unpost", (char *) NULL);
	menuPtr->postedCascade = NULL;
	if (result != TCL_OK) {
	    return result;
	}
    }

    if ((mePtr != NULL) && (mePtr->namePtr != NULL)
	    && Tk_IsMapped(menuPtr->tkwin)) {

	/*
	 * Position the cascade with its upper left corner slightly
	 * below and to the left of the upper right corner of the
	 * menu entry (this is an attempt to match Motif behavior).
	 *
	 * The menu has to redrawn so that the entry can change relief.
	 */

	char string[TCL_INTEGER_SPACE * 2];
	char *name;

	name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
	Tk_GetRootCoords(menuPtr->tkwin, &x, &y);
	AdjustMenuCoords(menuPtr, mePtr, &x, &y, string);
	result = Tcl_VarEval(interp, name, " post ", string, (char *) NULL);

	if (result != TCL_OK) {
	    return result;
	}
	menuPtr->postedCascade = mePtr;
	TkEventuallyRedrawMenu(menuPtr, mePtr);
    }
    return TCL_OK;
1005
1006
1007
1008
1009
1010
1011






1012
1013
1014
1015
1016
1017
1018
    int *yPtr;
    char *string;
{
    if (menuPtr->menuType == MENUBAR) {
	*xPtr += mePtr->x;
	*yPtr += mePtr->y + mePtr->height;
    } else {






	*xPtr += Tk_Width(menuPtr->tkwin) - menuPtr->borderWidth
		- menuPtr->activeBorderWidth - 2;
	*yPtr += mePtr->y
	        + menuPtr->activeBorderWidth + 2;
    }
    sprintf(string, "%d %d", *xPtr, *yPtr);
}







>
>
>
>
>
>
|
|
|
<



1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048

1049
1050
1051
    int *yPtr;
    char *string;
{
    if (menuPtr->menuType == MENUBAR) {
	*xPtr += mePtr->x;
	*yPtr += mePtr->y + mePtr->height;
    } else {
	int borderWidth, activeBorderWidth;

	Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
		&borderWidth);
	Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, 
		menuPtr->activeBorderWidthPtr, &activeBorderWidth);
	*xPtr += Tk_Width(menuPtr->tkwin) - borderWidth	- activeBorderWidth 
		- 2;
	*yPtr += mePtr->y + activeBorderWidth + 2;

    }
    sprintf(string, "%d %d", *xPtr, *yPtr);
}

Changes to generic/tkMenubutton.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20


21
22
23
24
25

26




27
28


29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63

64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

86
87
88
89
90
91
92
93
94
95
96
97
98
99

100
101
102
103
104
105
106

107
108

109
110

111
112

113
114
115
116
117
118
119
120
121
122

123
124

125
126

127
128
129














130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146

147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178

179
180




181






182






183

184
185
186
187
188
189
190
191
192

193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209

210

211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
/* 
 * tkMenubutton.c --
 *
 *	This module implements button-like widgets that are used
 *	to invoke pull-down menus.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMenubutton.c 1.94 97/07/31 09:10:37
 */

#include "tkMenubutton.h"
#include "tkPort.h"
#include "default.h"

/*


 * Uids internal to menubuttons.
 */

static Tk_Uid aboveUid = NULL;
static Tk_Uid belowUid = NULL;

static Tk_Uid leftUid = NULL;




static Tk_Uid rightUid = NULL;
static Tk_Uid flushUid = NULL;



/*
 * Information used for parsing configuration specs:
 */

static Tk_ConfigSpec configSpecs[] = {
    {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
	DEF_MENUBUTTON_ACTIVE_BG_COLOR, Tk_Offset(TkMenuButton, activeBorder),
	TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
	DEF_MENUBUTTON_ACTIVE_BG_MONO, Tk_Offset(TkMenuButton, activeBorder),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
	DEF_MENUBUTTON_ACTIVE_FG_COLOR, Tk_Offset(TkMenuButton, activeFg),
	TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
	DEF_MENUBUTTON_ACTIVE_FG_MONO, Tk_Offset(TkMenuButton, activeFg),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor",
	DEF_MENUBUTTON_ANCHOR, Tk_Offset(TkMenuButton, anchor), 0},
    {TK_CONFIG_BORDER, "-background", "background", "Background",
	DEF_MENUBUTTON_BG_COLOR, Tk_Offset(TkMenuButton, normalBorder),
	TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_BORDER, "-background", "background", "Background",
	DEF_MENUBUTTON_BG_MONO, Tk_Offset(TkMenuButton, normalBorder),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_BITMAP, "-bitmap", "bitmap", "Bitmap",
	DEF_MENUBUTTON_BITMAP, Tk_Offset(TkMenuButton, bitmap),
	TK_CONFIG_NULL_OK},
    {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	DEF_MENUBUTTON_BORDER_WIDTH, Tk_Offset(TkMenuButton, borderWidth), 0},

    {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
	DEF_MENUBUTTON_CURSOR, Tk_Offset(TkMenuButton, cursor),
	TK_CONFIG_NULL_OK},
    {TK_CONFIG_UID, "-direction", "direction", "Direction",
    	DEF_MENUBUTTON_DIRECTION, Tk_Offset(TkMenuButton, direction), 
	0},
    {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
	"DisabledForeground", DEF_MENUBUTTON_DISABLED_FG_COLOR,
	Tk_Offset(TkMenuButton, disabledFg),
	TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
    {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
	"DisabledForeground", DEF_MENUBUTTON_DISABLED_FG_MONO,
	Tk_Offset(TkMenuButton, disabledFg),
	TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
    {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_FONT, "-font", "font", "Font",
	DEF_MENUBUTTON_FONT, Tk_Offset(TkMenuButton, tkfont), 0},
    {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
	DEF_MENUBUTTON_FG, Tk_Offset(TkMenuButton, normalFg), 0},
    {TK_CONFIG_STRING, "-height", "height", "Height",
	DEF_MENUBUTTON_HEIGHT, Tk_Offset(TkMenuButton, heightString), 0},

    {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
	"HighlightBackground", DEF_MENUBUTTON_HIGHLIGHT_BG,
	Tk_Offset(TkMenuButton, highlightBgColorPtr), 0},
    {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
	DEF_MENUBUTTON_HIGHLIGHT, Tk_Offset(TkMenuButton, highlightColorPtr),
	0},
    {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
	"HighlightThickness", DEF_MENUBUTTON_HIGHLIGHT_WIDTH,
	Tk_Offset(TkMenuButton, highlightWidth), 0},
    {TK_CONFIG_STRING, "-image", "image", "Image",
	DEF_MENUBUTTON_IMAGE, Tk_Offset(TkMenuButton, imageString),
	TK_CONFIG_NULL_OK},
    {TK_CONFIG_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
	DEF_MENUBUTTON_INDICATOR, Tk_Offset(TkMenuButton, indicatorOn), 0},

    {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify",
	DEF_MENUBUTTON_JUSTIFY, Tk_Offset(TkMenuButton, justify), 0},
    {TK_CONFIG_STRING, "-menu", "menu", "Menu",
	DEF_MENUBUTTON_MENU, Tk_Offset(TkMenuButton, menuName),
	TK_CONFIG_NULL_OK},
    {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
	DEF_MENUBUTTON_PADX, Tk_Offset(TkMenuButton, padX), 0},

    {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
	DEF_MENUBUTTON_PADY, Tk_Offset(TkMenuButton, padY), 0},

    {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
	DEF_MENUBUTTON_RELIEF, Tk_Offset(TkMenuButton, relief), 0},

    {TK_CONFIG_UID, "-state", "state", "State",
	DEF_MENUBUTTON_STATE, Tk_Offset(TkMenuButton, state), 0},

    {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
	DEF_MENUBUTTON_TAKE_FOCUS, Tk_Offset(TkMenuButton, takeFocus),
	TK_CONFIG_NULL_OK},
    {TK_CONFIG_STRING, "-text", "text", "Text",
	DEF_MENUBUTTON_TEXT, Tk_Offset(TkMenuButton, text), 0},
    {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable",
	DEF_MENUBUTTON_TEXT_VARIABLE, Tk_Offset(TkMenuButton, textVarName),
	TK_CONFIG_NULL_OK},
    {TK_CONFIG_INT, "-underline", "underline", "Underline",
	DEF_MENUBUTTON_UNDERLINE, Tk_Offset(TkMenuButton, underline), 0},

    {TK_CONFIG_STRING, "-width", "width", "Width",
	DEF_MENUBUTTON_WIDTH, Tk_Offset(TkMenuButton, widthString), 0},

    {TK_CONFIG_PIXELS, "-wraplength", "wrapLength", "WrapLength",
	DEF_MENUBUTTON_WRAP_LENGTH, Tk_Offset(TkMenuButton, wrapLength), 0},

    {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, 0}
};















/*
 * Forward declarations for procedures defined later in this file:
 */

static void		MenuButtonCmdDeletedProc _ANSI_ARGS_((
			    ClientData clientData));
static void		MenuButtonEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		MenuButtonImageProc _ANSI_ARGS_((ClientData clientData,
			    int x, int y, int width, int height, int imgWidth,
			    int imgHeight));
static char *		MenuButtonTextVarProc _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp,
			    char *name1, char *name2, int flags));
static int		MenuButtonWidgetCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));

static int		ConfigureMenuButton _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenuButton *mbPtr, int argc, char **argv,
			    int flags));
static void		DestroyMenuButton _ANSI_ARGS_((char *memPtr));

/*
 *--------------------------------------------------------------
 *
 * Tk_MenubuttonCmd --
 *
 *	This procedure is invoked to process the "button", "label",
 *	"radiobutton", and "checkbutton" Tcl commands.  See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_MenubuttonCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    register TkMenuButton *mbPtr;

    Tk_Window tkwin = (Tk_Window) clientData;
    Tk_Window new;











    if (argc < 2) {






	Tcl_AppendResult(interp, "wrong # args: should be \"",

		argv[0], " pathName ?options?\"", (char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Create the new window.
     */

    new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);

    if (new == NULL) {
	return TCL_ERROR;
    }

    Tk_SetClass(new, "Menubutton");
    mbPtr = TkpCreateMenuButton(new);

    TkSetClassProcs(new, &tkpMenubuttonClass, (ClientData) mbPtr);

    /*
     * Initialize the data structure for the button.
     */

    mbPtr->tkwin = new;
    mbPtr->display = Tk_Display (new);
    mbPtr->interp = interp;
    mbPtr->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(mbPtr->tkwin),

	    MenuButtonWidgetCmd, (ClientData) mbPtr, MenuButtonCmdDeletedProc);

    mbPtr->menuName = NULL;
    mbPtr->text = NULL;
    mbPtr->underline = -1;
    mbPtr->textVarName = NULL;
    mbPtr->bitmap = None;
    mbPtr->imageString = NULL;
    mbPtr->image = NULL;
    mbPtr->state = tkNormalUid;
    mbPtr->normalBorder = NULL;
    mbPtr->activeBorder = NULL;
    mbPtr->borderWidth = 0;
    mbPtr->relief = TK_RELIEF_FLAT;
    mbPtr->highlightWidth = 0;
    mbPtr->highlightBgColorPtr = NULL;
    mbPtr->highlightColorPtr = NULL;












|







>
>
|


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





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

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

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


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















|
|
>

|
|





|















|
|
|

|
|


>
|
|
>
>
>
>

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







|
>
|



|
|

|





|
|

|
>
|
>







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45


46
47
48
49


50
51
52
53

54

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76


77


78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
/* 
 * tkMenubutton.c --
 *
 *	This module implements button-like widgets that are used
 *	to invoke pull-down menus.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMenubutton.c,v 1.1.4.7 1999/03/30 23:56:57 stanton Exp $
 */

#include "tkMenubutton.h"
#include "tkPort.h"
#include "default.h"

/*
 * The following table defines the legal values for the -direction 
 * option.  It is used together with the "enum direction" declaration 
 * in tkMenubutton.h.
 */

static char *directionStrings[] = {
    "above", "below", "flush", "left", "right", (char *) NULL
};

/*
 * The following table defines the legal values for the -state option.
 * It is used together with the "enum state" declaration in tkMenubutton.h.
 */

static char *stateStrings[] = {
    "active", "disabled", "normal", (char *) NULL
};

/*
 * Information used for parsing configuration specs:
 */

static Tk_OptionSpec optionSpecs[] = {
    {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
        DEF_MENUBUTTON_ACTIVE_BG_COLOR, -1, 


        Tk_Offset(TkMenuButton, activeBorder), 0, 
        (ClientData) DEF_MENUBUTTON_ACTIVE_BG_MONO, 0},
    {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
	DEF_MENUBUTTON_ACTIVE_FG_COLOR, -1, 


         Tk_Offset(TkMenuButton, activeFg),
         0, (ClientData) DEF_MENUBUTTON_ACTIVE_FG_MONO, 0},
    {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
	DEF_MENUBUTTON_ANCHOR, -1, 

        Tk_Offset(TkMenuButton, anchor), 0, 0, 0},

    {TK_OPTION_BORDER, "-background", "background", "Background",
	DEF_MENUBUTTON_BG_COLOR, -1, Tk_Offset(TkMenuButton, normalBorder),
        0, (ClientData) DEF_MENUBUTTON_BG_MONO, 0},
    {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
    {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
    {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
	DEF_MENUBUTTON_BITMAP, -1, Tk_Offset(TkMenuButton, bitmap),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	DEF_MENUBUTTON_BORDER_WIDTH, -1, 
        Tk_Offset(TkMenuButton, borderWidth), 0, 0, 0},
    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
	DEF_MENUBUTTON_CURSOR, -1, Tk_Offset(TkMenuButton, cursor),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_STRING_TABLE, "-direction", "direction", "Direction",
    	DEF_MENUBUTTON_DIRECTION, -1, Tk_Offset(TkMenuButton, direction), 
	0, (ClientData) directionStrings, 0},
    {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
	"DisabledForeground", DEF_MENUBUTTON_DISABLED_FG_COLOR,
	-1, Tk_Offset(TkMenuButton, disabledFg), TK_OPTION_NULL_OK,


	(ClientData) DEF_MENUBUTTON_DISABLED_FG_MONO, 0},


    {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
    {TK_OPTION_FONT, "-font", "font", "Font",
	DEF_MENUBUTTON_FONT, -1, Tk_Offset(TkMenuButton, tkfont), 0, 0, 0},
    {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
	DEF_MENUBUTTON_FG, -1, Tk_Offset(TkMenuButton, normalFg), 0, 0, 0},
    {TK_OPTION_STRING, "-height", "height", "Height",
	DEF_MENUBUTTON_HEIGHT, -1, Tk_Offset(TkMenuButton, heightString), 
        0, 0, 0},
    {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
	"HighlightBackground", DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR,
	-1, Tk_Offset(TkMenuButton, highlightBgColorPtr), 0, 0, 0},
    {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
	DEF_MENUBUTTON_HIGHLIGHT, -1, 
        Tk_Offset(TkMenuButton, highlightColorPtr),	0, 0, 0},
    {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
	"HighlightThickness", DEF_MENUBUTTON_HIGHLIGHT_WIDTH,
	-1, Tk_Offset(TkMenuButton, highlightWidth), 0, 0, 0},
    {TK_OPTION_STRING, "-image", "image", "Image",
	DEF_MENUBUTTON_IMAGE, -1, Tk_Offset(TkMenuButton, imageString), 
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
	DEF_MENUBUTTON_INDICATOR, -1, Tk_Offset(TkMenuButton, indicatorOn),
        0, 0, 0},
    {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
	DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkMenuButton, justify), 0, 0, 0},
    {TK_OPTION_STRING, "-menu", "menu", "Menu",
	DEF_MENUBUTTON_MENU, -1, Tk_Offset(TkMenuButton, menuName), 
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
	DEF_MENUBUTTON_PADX, -1, Tk_Offset(TkMenuButton, padX),
	0, 0, 0},
    {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
	DEF_MENUBUTTON_PADY, -1, Tk_Offset(TkMenuButton, padY),
	0, 0, 0},
    {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
	DEF_MENUBUTTON_RELIEF, -1, Tk_Offset(TkMenuButton, relief), 
        0, 0, 0},
    {TK_OPTION_STRING_TABLE, "-state", "state", "State",
	DEF_MENUBUTTON_STATE, -1, Tk_Offset(TkMenuButton, state),
	0, (ClientData) stateStrings, 0},
    {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
	DEF_MENUBUTTON_TAKE_FOCUS, -1, 
        Tk_Offset(TkMenuButton, takeFocus), TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_STRING, "-text", "text", "Text",
	DEF_MENUBUTTON_TEXT, -1, Tk_Offset(TkMenuButton, text), 0, 0, 0},
    {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
	DEF_MENUBUTTON_TEXT_VARIABLE, -1, 
        Tk_Offset(TkMenuButton, textVarName), TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_INT, "-underline", "underline", "Underline",
	DEF_MENUBUTTON_UNDERLINE, -1, Tk_Offset(TkMenuButton, underline),
         0, 0, 0},
    {TK_OPTION_STRING, "-width", "width", "Width",
	DEF_MENUBUTTON_WIDTH, -1, Tk_Offset(TkMenuButton, widthString), 
        0, 0, 0},
    {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
	DEF_MENUBUTTON_WRAP_LENGTH, -1, Tk_Offset(TkMenuButton, wrapLength),
        0, 0, 0},
    {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, 0}
};

/*
 * The following tables define the menubutton widget commands and map the 
 * indexes into the string tables into a single enumerated type used 
 * to dispatch the scale widget command.
 */

static char *commandNames[] = {
    "cget", "configure", (char *) NULL
};

enum command {
    COMMAND_CGET, COMMAND_CONFIGURE, 
};

/*
 * Forward declarations for procedures defined later in this file:
 */

static void		MenuButtonCmdDeletedProc _ANSI_ARGS_((
			    ClientData clientData));
static void		MenuButtonEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		MenuButtonImageProc _ANSI_ARGS_((ClientData clientData,
			    int x, int y, int width, int height, int imgWidth,
			    int imgHeight));
static char *		MenuButtonTextVarProc _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp,
			    char *name1, char *name2, int flags));
static int		MenuButtonWidgetObjCmd _ANSI_ARGS_((
                            ClientData clientData, Tcl_Interp *interp, 
			    int objc, Tcl_Obj *CONST objv[]));
static int		ConfigureMenuButton _ANSI_ARGS_((Tcl_Interp *interp,
			    TkMenuButton *mbPtr, int objc, 
                            Tcl_Obj *CONST objv[]));
static void		DestroyMenuButton _ANSI_ARGS_((char *memPtr));

/*
 *--------------------------------------------------------------
 *
 * Tk_MenubuttonObjCmd --
 *
 *	This procedure is invoked to process the "button", "label",
 *	"radiobutton", and "checkbutton" Tcl commands.  See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_MenubuttonObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Either NULL or pointer to 
				 * option table. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    register TkMenuButton *mbPtr;
    Tk_OptionTable optionTable;
    Tk_Window tkwin;

    optionTable = (Tk_OptionTable) clientData;
    if (optionTable == NULL) {
	Tcl_CmdInfo info;
	char *name;

	/*
	 * We haven't created the option table for this widget class
	 * yet.  Do it now and save the table as the clientData for
	 * the command, so we'll have access to it in future
	 * invocations of the command.
	 */

	optionTable = Tk_CreateOptionTable(interp, optionSpecs);
	name = Tcl_GetString(objv[0]);
	Tcl_GetCommandInfo(interp, name, &info);
	info.objClientData = (ClientData) optionTable;
	Tcl_SetCommandInfo(interp, name, &info);
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
	return TCL_ERROR;
    }

    /*
     * Create the new window.
     */

    tkwin = Tk_CreateWindowFromPath(interp, 
        Tk_MainWindow(interp), Tcl_GetString(objv[1]), (char *) NULL);
    if (tkwin == NULL) {
	return TCL_ERROR;
    }

    Tk_SetClass(tkwin, "Menubutton");
    mbPtr = TkpCreateMenuButton(tkwin);

    TkSetClassProcs(tkwin, &tkpMenubuttonClass, (ClientData) mbPtr);

    /*
     * Initialize the data structure for the button.
     */

    mbPtr->tkwin = tkwin;
    mbPtr->display = Tk_Display (tkwin);
    mbPtr->interp = interp;
    mbPtr->widgetCmd = Tcl_CreateObjCommand(interp, 
            Tk_PathName(mbPtr->tkwin), MenuButtonWidgetObjCmd, 
            (ClientData) mbPtr, MenuButtonCmdDeletedProc);
    mbPtr->optionTable = optionTable;
    mbPtr->menuName = NULL;
    mbPtr->text = NULL;
    mbPtr->underline = -1;
    mbPtr->textVarName = NULL;
    mbPtr->bitmap = None;
    mbPtr->imageString = NULL;
    mbPtr->image = NULL;
    mbPtr->state = STATE_NORMAL;
    mbPtr->normalBorder = NULL;
    mbPtr->activeBorder = NULL;
    mbPtr->borderWidth = 0;
    mbPtr->relief = TK_RELIEF_FLAT;
    mbPtr->highlightWidth = 0;
    mbPtr->highlightBgColorPtr = NULL;
    mbPtr->highlightColorPtr = NULL;
243
244
245
246
247
248
249

250
251
252
253
254
255
256
257
258
259
260
261
262
263
264







265
266
267
268
269
270

271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307





308
309
310
311
312
313
314
315


316
317

318

319
320
321
322


323
324

325
326
327
328
329
330

331
332
333
334
335
336
337
338


339

340
341
342




343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368





369
370
371
372
373
374
375

376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395




396

397
398


399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425

426

427
428
429
430


431
432
433
434
435

436
437
438
439
440
441
442
443






444






445

446






447



448
449
450
451
452
453
454
455

456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498

499
500
501
502
503
504
505
506
507
508
509


































510
511

512
513
514


515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
    mbPtr->padY = 0;
    mbPtr->anchor = TK_ANCHOR_CENTER;
    mbPtr->justify = TK_JUSTIFY_CENTER;
    mbPtr->textLayout = NULL;
    mbPtr->indicatorOn = 0;
    mbPtr->indicatorWidth = 0;
    mbPtr->indicatorHeight = 0;

    mbPtr->cursor = None;
    mbPtr->takeFocus = NULL;
    mbPtr->flags = 0;
    if (aboveUid == NULL) {
	aboveUid = Tk_GetUid("above");
	belowUid = Tk_GetUid("below");
	leftUid = Tk_GetUid("left");
	rightUid = Tk_GetUid("right");
	flushUid = Tk_GetUid("flush");
    }
    mbPtr->direction = flushUid;

    Tk_CreateEventHandler(mbPtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    MenuButtonEventProc, (ClientData) mbPtr);







    if (ConfigureMenuButton(interp, mbPtr, argc-2, argv+2, 0) != TCL_OK) {
	Tk_DestroyWindow(mbPtr->tkwin);
	return TCL_ERROR;
    }

    interp->result = Tk_PathName(mbPtr->tkwin);

    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * MenuButtonWidgetCmd --
 *
 *	This procedure is invoked to process the Tcl command
 *	that corresponds to a widget managed by this module.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
MenuButtonWidgetCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Information about button widget. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    register TkMenuButton *mbPtr = (TkMenuButton *) clientData;
    int result;
    size_t length;
    int c;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?arg arg ...?\"", (char *) NULL);
	return TCL_ERROR;





    }
    Tcl_Preserve((ClientData) mbPtr);
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",


		    argv[0], " cget option\"",
		    (char *) NULL);

	    result = TCL_ERROR;

	} else {
	    result = Tk_ConfigureValue(interp, mbPtr->tkwin, configSpecs,
		    (char *) mbPtr, argv[2], 0);
	}


    } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
	    && (length >= 2)) {

	if (argc == 2) {
	    result = Tk_ConfigureInfo(interp, mbPtr->tkwin, configSpecs,
		    (char *) mbPtr, (char *) NULL, 0);
	} else if (argc == 3) {
	    result = Tk_ConfigureInfo(interp, mbPtr->tkwin, configSpecs,
		    (char *) mbPtr, argv[2], 0);

	} else {
	    result = ConfigureMenuButton(interp, mbPtr, argc-2, argv+2,
		    TK_CONFIG_ARGV_ONLY);
	}
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be cget or configure",
		(char *) NULL);


	result = TCL_ERROR;

    }
    Tcl_Release((ClientData) mbPtr);
    return result;




}

/*
 *----------------------------------------------------------------------
 *
 * DestroyMenuButton --
 *
 *	This procedure is invoked to recycle all of the resources
 *	associated with a button widget.  It is invoked as a
 *	when-idle handler in order to make sure that there is no
 *	other use of the button pending at the time of the deletion.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Everything associated with the widget is freed up.
 *
 *----------------------------------------------------------------------
 */

static void
DestroyMenuButton(memPtr)
    char *memPtr;		/* Info about button widget. */
{
    register TkMenuButton *mbPtr = (TkMenuButton *) memPtr;






    /*
     * Free up all the stuff that requires special handling, then
     * let Tk_FreeOptions handle all the standard option-related
     * stuff.
     */


    if (mbPtr->textVarName != NULL) {
	Tcl_UntraceVar(mbPtr->interp, mbPtr->textVarName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		MenuButtonTextVarProc, (ClientData) mbPtr);
    }
    if (mbPtr->image != NULL) {
	Tk_FreeImage(mbPtr->image);
    }
    if (mbPtr->normalTextGC != None) {
	Tk_FreeGC(mbPtr->display, mbPtr->normalTextGC);
    }
    if (mbPtr->activeTextGC != None) {
	Tk_FreeGC(mbPtr->display, mbPtr->activeTextGC);
    }
    if (mbPtr->gray != None) {
	Tk_FreeBitmap(mbPtr->display, mbPtr->gray);
    }
    if (mbPtr->disabledGC != None) {
	Tk_FreeGC(mbPtr->display, mbPtr->disabledGC);
    }




    Tk_FreeTextLayout(mbPtr->textLayout);

    Tk_FreeOptions(configSpecs, (char *) mbPtr, mbPtr->display, 0);
    ckfree((char *) mbPtr);


}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureMenuButton --
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a menubutton widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as text string, colors, font,
 *	etc. get set for mbPtr;  old resources get freed, if there
 *	were any.  The menubutton is redisplayed.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureMenuButton(interp, mbPtr, argc, argv, flags)
    Tcl_Interp *interp;		/* Used for error reporting. */
    register TkMenuButton *mbPtr;	/* Information about widget;  may or may

				 * not already have values for some fields. */

    int argc;			/* Number of valid entries in argv. */
    char **argv;		/* Arguments. */
    int flags;			/* Flags to pass to Tk_ConfigureWidget. */
{


    int result;
    Tk_Image image;

    /*
     * Eliminate any existing trace on variables monitored by the menubutton.

     */

    if (mbPtr->textVarName != NULL) {
	Tcl_UntraceVar(interp, mbPtr->textVarName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		MenuButtonTextVarProc, (ClientData) mbPtr);
    }







    result = Tk_ConfigureWidget(interp, mbPtr->tkwin, configSpecs,






	    argc, argv, (char *) mbPtr, flags);

    if (result != TCL_OK) {






	return TCL_ERROR;



    }

    /*
     * A few options need special processing, such as setting the
     * background from a 3-D border, or filling in complicated
     * defaults that couldn't be specified to Tk_ConfigureWidget.
     */


    if ((mbPtr->state == tkActiveUid) && !Tk_StrictMotif(mbPtr->tkwin)) {
	Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->activeBorder);
    } else {
	Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->normalBorder);
	if ((mbPtr->state != tkNormalUid) && (mbPtr->state != tkActiveUid)
		&& (mbPtr->state != tkDisabledUid)) {
	    Tcl_AppendResult(interp, "bad state value \"", mbPtr->state,
		    "\": must be normal, active, or disabled", (char *) NULL);
	    mbPtr->state = tkNormalUid;
	    return TCL_ERROR;
	}
    }

    if ((mbPtr->direction != aboveUid) && (mbPtr->direction != belowUid)
	    && (mbPtr->direction != leftUid) && (mbPtr->direction != rightUid)
	    && (mbPtr->direction != flushUid)) {
	Tcl_AppendResult(interp, "bad direction value \"", mbPtr->direction,
		"\": must be above, below, left, right, or flush",
		(char *) NULL);
	mbPtr->direction = belowUid;
	return TCL_ERROR;
    }
    
    if (mbPtr->highlightWidth < 0) {
	mbPtr->highlightWidth = 0;
    }

    if (mbPtr->padX < 0) {
	mbPtr->padX = 0;
    }
    if (mbPtr->padY < 0) {
	mbPtr->padY = 0;
    }

    /*
     * Get the image for the widget, if there is one.  Allocate the
     * new image before freeing the old one, so that the reference
     * count doesn't go to zero and cause image data to be discarded.
     */

    if (mbPtr->imageString != NULL) {
	image = Tk_GetImage(mbPtr->interp, mbPtr->tkwin,
		mbPtr->imageString, MenuButtonImageProc, (ClientData) mbPtr);

	if (image == NULL) {
	    return TCL_ERROR;
	}
    } else {
	image = NULL;
    }
    if (mbPtr->image != NULL) {
	Tk_FreeImage(mbPtr->image);
    }
    mbPtr->image = image;



































    if ((mbPtr->image == NULL) && (mbPtr->bitmap == None)
	    && (mbPtr->textVarName != NULL)) {

	/*
	 * The menubutton displays a variable.  Set up a trace to watch
	 * for any changes in it.


	 */

	char *value;

	value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY);
	if (value == NULL) {
	    Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text,
		    TCL_GLOBAL_ONLY);
	} else {
	    if (mbPtr->text != NULL) {
		ckfree(mbPtr->text);
	    }
	    mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
	    strcpy(mbPtr->text, value);
	}
	Tcl_TraceVar(interp, mbPtr->textVarName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		MenuButtonTextVarProc, (ClientData) mbPtr);
    }

    /*
     * Recompute the geometry for the button.
     */

    if ((mbPtr->bitmap != None) || (mbPtr->image != NULL)) {
	if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->widthString,
		&mbPtr->width) != TCL_OK) {
	    widthError:
	    Tcl_AddErrorInfo(interp, "\n    (processing -width option)");
	    return TCL_ERROR;
	}
	if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->heightString,
		&mbPtr->height) != TCL_OK) {
	    heightError:
	    Tcl_AddErrorInfo(interp, "\n    (processing -height option)");
	    return TCL_ERROR;
	}
    } else {
	if (Tcl_GetInt(interp, mbPtr->widthString, &mbPtr->width)
		!= TCL_OK) {
	    goto widthError;
	}
	if (Tcl_GetInt(interp, mbPtr->heightString, &mbPtr->height)
		!= TCL_OK) {
	    goto heightError;
	}
    }
    TkMenuButtonWorldChanged((ClientData) mbPtr);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkMenuButtonWorldChanged --
 *







>



<
<
<
<
<
<
<
<




>
>
>
>
>
>
>
|




|
>






|















|


|
|


|
|
<

|
<
|

>
>
>
>
>


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



>
>
>
>








|

|















>
>
>
>
>







>














<
<
<



>
>
>
>
|
>
|
|
>
>













|










|

|
>
|
>
|
|
<

>
>
|



|
>



|




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

|
|
|
|
|

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

|
|
|
|
|
|

|
|
|
|
|

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

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


>
|
|
|
>
>
|

|

|
|
|
|
|
|
|
|
|
|
|
|
|
|


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

<
|
<
|
<
<
<
<
<
<
<







288
289
290
291
292
293
294
295
296
297
298








299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347

348
349

350
351
352
353
354
355
356
357
358
359
360
361

362
363
364
365
366
367
368
369
370
371
372

373
374
375
376

377
378
379
380
381
382
383
384
385
386

387
388

389

390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453



454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498

499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554

















555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650



651



652
653




654

655

656

657

658







659
660
661
662
663
664
665
    mbPtr->padY = 0;
    mbPtr->anchor = TK_ANCHOR_CENTER;
    mbPtr->justify = TK_JUSTIFY_CENTER;
    mbPtr->textLayout = NULL;
    mbPtr->indicatorOn = 0;
    mbPtr->indicatorWidth = 0;
    mbPtr->indicatorHeight = 0;
    mbPtr->direction = DIRECTION_FLUSH;
    mbPtr->cursor = None;
    mbPtr->takeFocus = NULL;
    mbPtr->flags = 0;









    Tk_CreateEventHandler(mbPtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    MenuButtonEventProc, (ClientData) mbPtr);

    if (Tk_InitOptions(interp, (char *) mbPtr, optionTable, tkwin)
            != TCL_OK) {
	Tk_DestroyWindow(mbPtr->tkwin);
	return TCL_ERROR;
    }

    if (ConfigureMenuButton(interp, mbPtr, objc-2, objv+2) != TCL_OK) {
	Tk_DestroyWindow(mbPtr->tkwin);
	return TCL_ERROR;
    }

    Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(mbPtr->tkwin),
            -1);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * MenuButtonWidgetObjCmd --
 *
 *	This procedure is invoked to process the Tcl command
 *	that corresponds to a widget managed by this module.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
MenuButtonWidgetObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Information about button widget. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    register TkMenuButton *mbPtr = (TkMenuButton *) clientData;
    int result, index;
    Tcl_Obj *objPtr;


    if (objc < 2) {

        Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
	return TCL_ERROR;
    }
    result = Tcl_GetIndexFromObj(interp, objv[1], 
            commandNames, "option", 0, &index);
    if (result != TCL_OK) {
        return result;
    }
    Tcl_Preserve((ClientData) mbPtr);

    switch (index) {
        case COMMAND_CGET: {

	    if (objc != 3) {
	        Tcl_WrongNumArgs(interp, 1, objv, "cget option");
	    goto error;
	    }

	    objPtr = Tk_GetOptionValue(interp, (char *) mbPtr,
                    mbPtr->optionTable, objv[2], mbPtr->tkwin);
	    if (objPtr == NULL) {
	        goto error;
	    } else {
	        Tcl_SetObjResult(interp, objPtr);

	    }
	    break;
	}


        case COMMAND_CONFIGURE: {
	    if (objc <= 3) {
		objPtr = Tk_GetOptionInfo(interp, (char *) mbPtr,
			mbPtr->optionTable,
			(objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
			mbPtr->tkwin);
		if (objPtr == NULL) {
		    goto error;
		} else {
		    Tcl_SetObjResult(interp, objPtr);

		}
	    } else {

		result = ConfigureMenuButton(interp, mbPtr, objc-2, 

		        objv+2);
	    }
	    break;
	}
    }
    Tcl_Release((ClientData) mbPtr);
    return result;

    error:
    Tcl_Release((ClientData) mbPtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * DestroyMenuButton --
 *
 *	This procedure is invoked to recycle all of the resources
 *	associated with a menubutton widget.  It is invoked as a
 *	when-idle handler in order to make sure that there is no
 *	other use of the menubutton pending at the time of the deletion.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Everything associated with the widget is freed up.
 *
 *----------------------------------------------------------------------
 */

static void
DestroyMenuButton(memPtr)
    char *memPtr;		/* Info about button widget. */
{
    register TkMenuButton *mbPtr = (TkMenuButton *) memPtr;
    TkpDestroyMenuButton(mbPtr);

    if (mbPtr->flags & REDRAW_PENDING) {
        Tcl_CancelIdleCall(TkpDisplayMenuButton, (ClientData) mbPtr);
    }

    /*
     * Free up all the stuff that requires special handling, then
     * let Tk_FreeOptions handle all the standard option-related
     * stuff.
     */

    Tcl_DeleteCommandFromToken(mbPtr->interp, mbPtr->widgetCmd);
    if (mbPtr->textVarName != NULL) {
	Tcl_UntraceVar(mbPtr->interp, mbPtr->textVarName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		MenuButtonTextVarProc, (ClientData) mbPtr);
    }
    if (mbPtr->image != NULL) {
	Tk_FreeImage(mbPtr->image);
    }
    if (mbPtr->normalTextGC != None) {
	Tk_FreeGC(mbPtr->display, mbPtr->normalTextGC);
    }
    if (mbPtr->activeTextGC != None) {
	Tk_FreeGC(mbPtr->display, mbPtr->activeTextGC);
    }



    if (mbPtr->disabledGC != None) {
	Tk_FreeGC(mbPtr->display, mbPtr->disabledGC);
    }
    if (mbPtr->gray != None) {
	Tk_FreeBitmap(mbPtr->display, mbPtr->gray);
    }
    if (mbPtr->textLayout != NULL) {
        Tk_FreeTextLayout(mbPtr->textLayout);
    }
    Tk_FreeConfigOptions((char *) mbPtr, mbPtr->optionTable,
	    mbPtr->tkwin);
    mbPtr->tkwin = NULL;
    Tcl_EventuallyFree((ClientData) mbPtr, TCL_DYNAMIC);
}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureMenuButton --
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a menubutton widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as text string, colors, font,
 *	etc. get set for mbPtr;  old resources get freed, if there
 *	were any.  The menubutton is redisplayed.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureMenuButton(interp, mbPtr, objc, objv)
    Tcl_Interp *interp;		/* Used for error reporting. */
    register TkMenuButton *mbPtr;	
                                /* Information about widget;  may or may
				 * not already have values for some 
				 * fields. */
    int objc;			/* Number of valid entries in objv. */
    Tcl_Obj *CONST objv[];	/* Arguments. */

{
    Tk_SavedOptions savedOptions;
    Tcl_Obj *errorResult = NULL;
    int error;
    Tk_Image image;

    /*
     * Eliminate any existing trace on variables monitored by the 
     * menubutton.
     */

    if (mbPtr->textVarName != NULL) {
	Tcl_UntraceVar(interp, mbPtr->textVarName, 
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		MenuButtonTextVarProc, (ClientData) mbPtr);
    }

    /*
     * The following loop is potentially executed twice.  During the
     * first pass configuration options get set to their new values.
     * If there is an error in this pass, we execute a second pass
     * to restore all the options to their previous values.
     */

    for (error = 0; error <= 1; error++) {
	if (!error) {
	    /*
	     * First pass: set options to new values.
	     */

	    if (Tk_SetOptions(interp, (char *) mbPtr,
		    mbPtr->optionTable, objc, objv,
		    mbPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
		continue;
	    }
	} else {
	    /*
	     * Second pass: restore options to old values.
	     */

	    errorResult = Tcl_GetObjResult(interp);
	    Tcl_IncrRefCount(errorResult);
	    Tk_RestoreSavedOptions(&savedOptions);
	}

	/*
	 * A few options need special processing, such as setting the
	 * background from a 3-D border, or filling in complicated
	 * defaults that couldn't be specified to Tk_SetOptions.
	 */

	if ((mbPtr->state == STATE_ACTIVE)
		&& !Tk_StrictMotif(mbPtr->tkwin)) {
	    Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->activeBorder);
	} else {
	    Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->normalBorder);

















	}

	if (mbPtr->highlightWidth < 0) {
	    mbPtr->highlightWidth = 0;
	}

	if (mbPtr->padX < 0) {
	    mbPtr->padX = 0;
	}
	if (mbPtr->padY < 0) {
	    mbPtr->padY = 0;
	}

	/*
	 * Get the image for the widget, if there is one.  Allocate the
	 * new image before freeing the old one, so that the reference
	 * count doesn't go to zero and cause image data to be discarded.
	 */

	if (mbPtr->imageString != NULL) {
	    image = Tk_GetImage(mbPtr->interp, mbPtr->tkwin,
		    mbPtr->imageString, MenuButtonImageProc, 
		    (ClientData) mbPtr);
	    if (image == NULL) {
	        return TCL_ERROR;
	    }
	} else {
	    image = NULL;
	}
	if (mbPtr->image != NULL) {
	    Tk_FreeImage(mbPtr->image);
	}
	mbPtr->image = image;

	/*
	 * Recompute the geometry for the button.
	 */

	if ((mbPtr->bitmap != None) || (mbPtr->image != NULL)) {
	    if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->widthString,
                    &mbPtr->width) != TCL_OK) {
                widthError:
	        Tcl_AddErrorInfo(interp, "\n    (processing -width option)");
		continue;
	    }
	    if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->heightString,
		    &mbPtr->height) != TCL_OK) {
	        heightError:
	        Tcl_AddErrorInfo(interp, "\n    (processing -height option)");
		continue;
	    }
	} else {
	    if (Tcl_GetInt(interp, mbPtr->widthString, &mbPtr->width)
		    != TCL_OK) {
	        goto widthError;
	    }
	    if (Tcl_GetInt(interp, mbPtr->heightString, &mbPtr->height)
		    != TCL_OK) {
	        goto heightError;
	    }
	}
	break;
    }

    if (!error) {
      Tk_FreeSavedOptions(&savedOptions);
    }

    if ((mbPtr->image == NULL) && (mbPtr->bitmap == None)
	    && (mbPtr->textVarName != NULL)) {

      /*
       * The menubutton displays the value of a variable.  
       * Set up a trace to watch for any changes in it, create
       * the variable if it doesn't exist, and fetch its
       * current value.
       */

      char *value;

      value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY);
      if (value == NULL) {
	  Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text,
		     TCL_GLOBAL_ONLY);
      } else {
	  if (mbPtr->text != NULL) {
	      ckfree(mbPtr->text);
	  }
	  mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
	  strcpy(mbPtr->text, value);
      }
      Tcl_TraceVar(interp, mbPtr->textVarName,
		   TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		   MenuButtonTextVarProc, (ClientData) mbPtr);
    }




    TkMenuButtonWorldChanged((ClientData) mbPtr);



    if (error) {
	Tcl_SetObjResult(interp, errorResult);




	Tcl_DecrRefCount(errorResult);

        return TCL_ERROR;

    } else {

        return TCL_OK;

    }







}

/*
 *---------------------------------------------------------------------------
 *
 * TkMenuButtonWorldChanged --
 *
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
	/*
	 * Must redraw after size changes, since layout could have changed
	 * and borders will need to be redrawn.
	 */

	goto redraw;
    } else if (eventPtr->type == DestroyNotify) {
	TkpDestroyMenuButton(mbPtr);
	if (mbPtr->tkwin != NULL) {
	    mbPtr->tkwin = NULL;
	    Tcl_DeleteCommandFromToken(mbPtr->interp, mbPtr->widgetCmd);
	}
	if (mbPtr->flags & REDRAW_PENDING) {
	    Tcl_CancelIdleCall(TkpDisplayMenuButton, (ClientData) mbPtr);
	}
	Tcl_EventuallyFree((ClientData) mbPtr, DestroyMenuButton);
    } else if (eventPtr->type == FocusIn) {
	if (eventPtr->xfocus.detail != NotifyInferior) {
	    mbPtr->flags |= GOT_FOCUS;
	    if (mbPtr->highlightWidth > 0) {
		goto redraw;
	    }
	}







|
<
<
<
<
<
<
<
<







781
782
783
784
785
786
787
788








789
790
791
792
793
794
795
	/*
	 * Must redraw after size changes, since layout could have changed
	 * and borders will need to be redrawn.
	 */

	goto redraw;
    } else if (eventPtr->type == DestroyNotify) {
        DestroyMenuButton((char *) mbPtr);








    } else if (eventPtr->type == FocusIn) {
	if (eventPtr->xfocus.detail != NotifyInferior) {
	    mbPtr->flags |= GOT_FOCUS;
	    if (mbPtr->highlightWidth > 0) {
		goto redraw;
	    }
	}
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
     * This procedure could be invoked either because the window was
     * destroyed and the command was then deleted (in which case tkwin
     * is NULL) or because the command was deleted, and then this procedure
     * destroys the widget.
     */

    if (tkwin != NULL) {
	mbPtr->tkwin = NULL;
	Tk_DestroyWindow(tkwin);
    }
}

/*
 *--------------------------------------------------------------
 *







<







839
840
841
842
843
844
845

846
847
848
849
850
851
852
     * This procedure could be invoked either because the window was
     * destroyed and the command was then deleted (in which case tkwin
     * is NULL) or because the command was deleted, and then this procedure
     * destroys the widget.
     */

    if (tkwin != NULL) {

	Tk_DestroyWindow(tkwin);
    }
}

/*
 *--------------------------------------------------------------
 *

Changes to generic/tkMenubutton.h.

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
/*
 * tkMenubutton.h --
 *
 *	Declarations of types and functions used to implement
 *	the menubutton widget.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMenubutton.h 1.3 97/04/11 11:24:15
 */

#ifndef _TKMENUBUTTON
#define _TKMENUBUTTON

#ifndef _TKINT
#include "tkInt.h"
#endif























/*
 * A data structure of the following type is kept for each
 * widget managed by this file:
 */

typedef struct {
    Tk_Window tkwin;		/* Window that embodies the widget.  NULL
				 * means that the window has been destroyed
				 * but the data structures haven't yet been
				 * cleaned up.*/
    Display *display;		/* Display containing widget.  Needed, among
				 * other things, so that resources can bee
				 * freed up even after tkwin has gone away. */
    Tcl_Interp *interp;		/* Interpreter associated with menubutton. */
    Tcl_Command widgetCmd;	/* Token for menubutton's widget command. */


    char *menuName;		/* Name of menu associated with widget.
				 * Malloc-ed. */

    /*
     * Information about what's displayed in the menu button:
     */












|








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
















>
>







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
/*
 * tkMenubutton.h --
 *
 *	Declarations of types and functions used to implement
 *	the menubutton widget.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMenubutton.h,v 1.1.4.4 1999/02/16 06:00:41 lfb Exp $
 */

#ifndef _TKMENUBUTTON
#define _TKMENUBUTTON

#ifndef _TKINT
#include "tkInt.h"
#endif

#ifdef BUILD_tk
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * Legal values for the "orient" field of TkMenubutton records.
 */

enum direction {
    DIRECTION_ABOVE, DIRECTION_BELOW, DIRECTION_FLUSH, 
    DIRECTION_LEFT, DIRECTION_RIGHT
};

/*
 * Legal values for the "state" field of TkMenubutton records.
 */

enum state {
    STATE_ACTIVE, STATE_DISABLED, STATE_NORMAL
};

/*
 * A data structure of the following type is kept for each
 * widget managed by this file:
 */

typedef struct {
    Tk_Window tkwin;		/* Window that embodies the widget.  NULL
				 * means that the window has been destroyed
				 * but the data structures haven't yet been
				 * cleaned up.*/
    Display *display;		/* Display containing widget.  Needed, among
				 * other things, so that resources can bee
				 * freed up even after tkwin has gone away. */
    Tcl_Interp *interp;		/* Interpreter associated with menubutton. */
    Tcl_Command widgetCmd;	/* Token for menubutton's widget command. */
    Tk_OptionTable optionTable;	/* Table that defines configuration options
				 * available for this widget. */
    char *menuName;		/* Name of menu associated with widget.
				 * Malloc-ed. */

    /*
     * Information about what's displayed in the menu button:
     */

56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
    Tk_Image image;		/* Image to display in window, or NULL if
				 * none. */

    /*
     * Information used when displaying widget:
     */

    Tk_Uid state;		/* State of button for display purposes:
				 * normal, active, or disabled. */
    Tk_3DBorder normalBorder;	/* Structure used to draw 3-D
				 * border and background when window
				 * isn't active.  NULL means no such
				 * border exists. */
    Tk_3DBorder activeBorder;	/* Structure used to draw 3-D
				 * border and background when window







|







80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
    Tk_Image image;		/* Image to display in window, or NULL if
				 * none. */

    /*
     * Information used when displaying widget:
     */

    enum state state;          	/* State of button for display purposes:
				 * normal, active, or disabled. */
    Tk_3DBorder normalBorder;	/* Structure used to draw 3-D
				 * border and background when window
				 * isn't active.  NULL means no such
				 * border exists. */
    Tk_3DBorder activeBorder;	/* Structure used to draw 3-D
				 * border and background when window
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
				 * indicatorHeight in padding on each side.
				 * 0 if no indicator. */

    /*
     * Miscellaneous information:
     */

    Tk_Uid direction;		/* Direction for where to pop the menu.
    				 * Valid directions are "above", "below",
    				 * "left", "right", and "flush". "flush"
    				 * means that the upper left corner of the
    				 * menubutton is where the menu pops up.
    				 * "above" and "below" will attempt to pop
    				 * the menu compleletly above or below
    				 * the menu respectively.







|







158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
				 * indicatorHeight in padding on each side.
				 * 0 if no indicator. */

    /*
     * Miscellaneous information:
     */

    enum direction direction;	/* Direction for where to pop the menu.
    				 * Valid directions are "above", "below",
    				 * "left", "right", and "flush". "flush"
    				 * means that the upper left corner of the
    				 * menubutton is where the menu pops up.
    				 * "above" and "below" will attempt to pop
    				 * the menu compleletly above or below
    				 * the menu respectively.
200
201
202
203
204
205
206



207
EXTERN void		TkpDisplayMenuButton _ANSI_ARGS_((
			    ClientData clientData));
EXTERN void 		TkpDestroyMenuButton _ANSI_ARGS_((
			    TkMenuButton *mbPtr));
EXTERN void		TkMenuButtonWorldChanged _ANSI_ARGS_((
			    ClientData instanceData));




#endif /* _TKMENUBUTTON */







>
>
>

224
225
226
227
228
229
230
231
232
233
234
EXTERN void		TkpDisplayMenuButton _ANSI_ARGS_((
			    ClientData clientData));
EXTERN void 		TkpDestroyMenuButton _ANSI_ARGS_((
			    TkMenuButton *mbPtr));
EXTERN void		TkMenuButtonWorldChanged _ANSI_ARGS_((
			    ClientData instanceData));

# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TKMENUBUTTON */

Changes to generic/tkMessage.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkMessage.c --
 *
 *	This module implements a message widgets for the Tk
 *	toolkit.  A message widget displays a multi-line string
 *	in a window according to a particular aspect ratio.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMessage.c 1.75 97/07/31 09:11:14
 */

#include "tkPort.h"
#include "default.h"
#include "tkInt.h"

/*








|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkMessage.c --
 *
 *	This module implements a message widgets for the Tk
 *	toolkit.  A message widget displays a multi-line string
 *	in a window according to a particular aspect ratio.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMessage.c,v 1.1.4.3 1999/03/30 04:12:58 stanton Exp $
 */

#include "tkPort.h"
#include "default.h"
#include "tkInt.h"

/*
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

    /*
     * Information used when displaying widget:
     */

    char *string;		/* String displayed in message. */
    int numChars;		/* Number of characters in string, not
				 * including terminating NULL character. */
    char *textVarName;		/* Name of variable (malloc'ed) or NULL.
				 * If non-NULL, message displays the contents
				 * of this variable. */
    Tk_3DBorder border;		/* Structure used to draw 3-D border and
				 * background.  NULL means a border hasn't
				 * been created yet. */
    int borderWidth;		/* Width of border. */







|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

    /*
     * Information used when displaying widget:
     */

    char *string;		/* String displayed in message. */
    int numChars;		/* Number of characters in string, not
				 * including terminating NULL. */
    char *textVarName;		/* Name of variable (malloc'ed) or NULL.
				 * If non-NULL, message displays the contents
				 * of this variable. */
    Tk_3DBorder border;		/* Structure used to draw 3-D border and
				 * background.  NULL means a border hasn't
				 * been created yet. */
    int borderWidth;		/* Width of border. */
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
    Tk_CreateEventHandler(msgPtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    MessageEventProc, (ClientData) msgPtr);
    if (ConfigureMessage(interp, msgPtr, argc-2, argv+2, 0) != TCL_OK) {
	goto error;
    }

    interp->result = Tk_PathName(msgPtr->tkwin);
    return TCL_OK;

    error:
    Tk_DestroyWindow(msgPtr->tkwin);
    return TCL_ERROR;
}








|







270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
    Tk_CreateEventHandler(msgPtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    MessageEventProc, (ClientData) msgPtr);
    if (ConfigureMessage(interp, msgPtr, argc-2, argv+2, 0) != TCL_OK) {
	goto error;
    }

    Tcl_SetResult(interp, Tk_PathName(msgPtr->tkwin), TCL_STATIC);
    return TCL_OK;

    error:
    Tk_DestroyWindow(msgPtr->tkwin);
    return TCL_ERROR;
}

397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a message widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as text string, colors, font,
 *	etc. get set for msgPtr;  old resources get freed, if there
 *	were any.
 *
 *----------------------------------------------------------------------







|







397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a message widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as text string, colors, font,
 *	etc. get set for msgPtr;  old resources get freed, if there
 *	were any.
 *
 *----------------------------------------------------------------------
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475

    /*
     * A few other options need special processing, such as setting
     * the background from a 3-D border or handling special defaults
     * that couldn't be specified to Tk_ConfigureWidget.
     */

    msgPtr->numChars = strlen(msgPtr->string);

    Tk_SetBackgroundFromBorder(msgPtr->tkwin, msgPtr->border);

    if (msgPtr->highlightWidth < 0) {
	msgPtr->highlightWidth = 0;
    }








|







461
462
463
464
465
466
467
468
469
470
471
472
473
474
475

    /*
     * A few other options need special processing, such as setting
     * the background from a 3-D border or handling special defaults
     * that couldn't be specified to Tk_ConfigureWidget.
     */

    msgPtr->numChars = Tcl_NumUtfChars(msgPtr->string, -1);

    Tk_SetBackgroundFromBorder(msgPtr->tkwin, msgPtr->border);

    if (msgPtr->highlightWidth < 0) {
	msgPtr->highlightWidth = 0;
    }

830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
    value = Tcl_GetVar(interp, msgPtr->textVarName, TCL_GLOBAL_ONLY);
    if (value == NULL) {
	value = "";
    }
    if (msgPtr->string != NULL) {
	ckfree(msgPtr->string);
    }
    msgPtr->numChars = strlen(value);
    msgPtr->string = (char *) ckalloc((unsigned) (msgPtr->numChars + 1));
    strcpy(msgPtr->string, value);
    ComputeMessageGeometry(msgPtr);

    if ((msgPtr->tkwin != NULL) && Tk_IsMapped(msgPtr->tkwin)
	    && !(msgPtr->flags & REDRAW_PENDING)) {
	Tcl_DoWhenIdle(DisplayMessage, (ClientData) msgPtr);
	msgPtr->flags |= REDRAW_PENDING;
    }
    return (char *) NULL;
}







|
|










830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
    value = Tcl_GetVar(interp, msgPtr->textVarName, TCL_GLOBAL_ONLY);
    if (value == NULL) {
	value = "";
    }
    if (msgPtr->string != NULL) {
	ckfree(msgPtr->string);
    }
    msgPtr->numChars = Tcl_NumUtfChars(value, -1);
    msgPtr->string = (char *) ckalloc((unsigned) (strlen(value) + 1));
    strcpy(msgPtr->string, value);
    ComputeMessageGeometry(msgPtr);

    if ((msgPtr->tkwin != NULL) && Tk_IsMapped(msgPtr->tkwin)
	    && !(msgPtr->flags & REDRAW_PENDING)) {
	Tcl_DoWhenIdle(DisplayMessage, (ClientData) msgPtr);
	msgPtr->flags |= REDRAW_PENDING;
    }
    return (char *) NULL;
}

Added generic/tkObj.c.







































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
/* 
 * tkObj.c --
 *
 *	This file contains procedures that implement the common Tk object
 *	types
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkObj.c,v 1.1.2.2 1998/09/30 02:17:12 stanton Exp $
 */

#include "tkInt.h"

/*
 * The following structure is the internal representation for pixel objects.
 */
 
typedef struct PixelRep {
    double value;
    int units;
    Tk_Window tkwin;
    int returnValue;
} PixelRep;

#define SIMPLE_PIXELREP(objPtr)				\
    ((objPtr)->internalRep.twoPtrValue.ptr2 == 0)

#define SET_SIMPLEPIXEL(objPtr, intval)			\
    (objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (intval);	\
    (objPtr)->internalRep.twoPtrValue.ptr2 = 0

#define GET_SIMPLEPIXEL(objPtr)				\
    ((int) (objPtr)->internalRep.twoPtrValue.ptr1)

#define SET_COMPLEXPIXEL(objPtr, repPtr)		\
    (objPtr)->internalRep.twoPtrValue.ptr1 = 0;		\
    (objPtr)->internalRep.twoPtrValue.ptr2 = (VOID *) repPtr

#define GET_COMPLEXPIXEL(objPtr)			\
    ((PixelRep *) (objPtr)->internalRep.twoPtrValue.ptr2)


/*
 * The following structure is the internal representation for mm objects.
 */
 
typedef struct MMRep {
    double value;
    int units;
    Tk_Window tkwin;
    double returnValue;
} MMRep;

/*
 * Prototypes for procedures defined later in this file:
 */

static void		DupMMInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr));
static void		DupPixelInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr));
static void		FreeMMInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
static void		FreePixelInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
static int		SetMMFromAny _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr));
static int		SetPixelFromAny _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr));
static int		SetWindowFromAny _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr));
			
/*
 * The following structure defines the implementation of the "pixel"
 * Tcl object, used for measuring distances.  The pixel object remembers
 * its initial display-independant settings.
 */

static Tcl_ObjType pixelObjType = {
    "pixel",			/* name */
    FreePixelInternalRep,	/* freeIntRepProc */
    DupPixelInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetPixelFromAny		/* setFromAnyProc */
};

/*
 * The following structure defines the implementation of the "pixel"
 * Tcl object, used for measuring distances.  The pixel object remembers
 * its initial display-independant settings.
 */

static Tcl_ObjType mmObjType = {
    "mm",			/* name */
    FreeMMInternalRep,		/* freeIntRepProc */
    DupMMInternalRep,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetMMFromAny		/* setFromAnyProc */
};

/*
 * The following structure defines the implementation of the "window"
 * Tcl object.
 */

static Tcl_ObjType windowObjType = {
    "window",				/* name */
    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
    (Tcl_DupInternalRepProc *) NULL,	/* dupIntRepProc */
    NULL,				/* updateStringProc */
    SetWindowFromAny			/* setFromAnyProc */
};



/*
 *----------------------------------------------------------------------
 *
 * Tk_GetPixelsFromObj --
 *
 *	Attempt to return a pixel value from the Tcl object "objPtr". If the
 *	object is not already a pixel value, an attempt will be made to convert
 *	it to one.
 *
 * Results:
 *	The return value is a standard Tcl object result. If an error occurs
 *	during conversion, an error message is left in the interpreter's
 *	result unless "interp" is NULL.
 *
 * Side effects:
 *	If the object is not already a pixel, the conversion will free
 *	any old internal representation. 
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr)
    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
    Tk_Window tkwin;
    Tcl_Obj *objPtr;		/* The object from which to get pixels. */
    int *intPtr;		/* Place to store resulting pixels. */
{
    int result;
    double d;
    PixelRep *pixelPtr;
    static double bias[] = {
	1.0,	10.0,	25.4,	25.4 / 72.0
    };

    if (objPtr->typePtr != &pixelObjType) {
	result = SetPixelFromAny(interp, objPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    if (SIMPLE_PIXELREP(objPtr)) {
	*intPtr = GET_SIMPLEPIXEL(objPtr);
    } else {
	pixelPtr = GET_COMPLEXPIXEL(objPtr);
	if (pixelPtr->tkwin != tkwin) {
	    d = pixelPtr->value;
	    if (pixelPtr->units >= 0) {
		d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin));
		d /= WidthMMOfScreen(Tk_Screen(tkwin));
	    }
	    if (d < 0) {
		pixelPtr->returnValue = (int) (d - 0.5);
	    } else {
		pixelPtr->returnValue = (int) (d + 0.5);
	    }
	    pixelPtr->tkwin = tkwin;
	}
        *intPtr = pixelPtr->returnValue;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FreePixelInternalRep --
 *
 *	Deallocate the storage associated with a pixel object's internal
 *	representation.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees objPtr's internal representation and sets objPtr's
 *	internalRep to NULL.
 *
 *----------------------------------------------------------------------
 */

static void
FreePixelInternalRep(objPtr)
    Tcl_Obj *objPtr;		/* Pixel object with internal rep to free. */
{
    PixelRep *pixelPtr;
    
    if (!SIMPLE_PIXELREP(objPtr)) {
	pixelPtr = GET_COMPLEXPIXEL(objPtr);
	ckfree((char *) pixelPtr);
    }
    SET_SIMPLEPIXEL(objPtr, 0);
}

/*
 *----------------------------------------------------------------------
 *
 * DupPixelInternalRep --
 *
 *	Initialize the internal representation of a pixel Tcl_Obj to a
 *	copy of the internal representation of an existing pixel object. 
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	copyPtr's internal rep is set to the pixel corresponding to
 *	srcPtr's internal rep.
 *
 *----------------------------------------------------------------------
 */

static void
DupPixelInternalRep(srcPtr, copyPtr)
    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy. */
    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
{
    PixelRep *oldPtr, *newPtr;
    
    copyPtr->typePtr = srcPtr->typePtr;

    if (SIMPLE_PIXELREP(srcPtr)) {
	SET_SIMPLEPIXEL(copyPtr, GET_SIMPLEPIXEL(srcPtr));
    } else {
	oldPtr = GET_COMPLEXPIXEL(srcPtr);
	newPtr = (PixelRep *) ckalloc(sizeof(PixelRep));
	newPtr->value = oldPtr->value;
	newPtr->units = oldPtr->units;
	newPtr->tkwin = oldPtr->tkwin;
	newPtr->returnValue = oldPtr->returnValue;
	SET_COMPLEXPIXEL(copyPtr, newPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SetPixelFromAny --
 *
 *	Attempt to generate a pixel internal form for the Tcl object
 *	"objPtr".
 *
 * Results:
 *	The return value is a standard Tcl result. If an error occurs during
 *	conversion, an error message is left in the interpreter's result
 *	unless "interp" is NULL.
 *
 * Side effects:
 *	If no error occurs, a pixel representation of the object is
 *	stored internally and the type of "objPtr" is set to pixel.
 *
 *----------------------------------------------------------------------
 */

static int
SetPixelFromAny(interp, objPtr)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr;		/* The object to convert. */
{
    Tcl_ObjType *typePtr;
    char *string, *rest;
    double d;
    int i, units;
    PixelRep *pixelPtr;

    string = Tcl_GetStringFromObj(objPtr, NULL);

    d = strtod(string, &rest);
    if (rest == string) {
	/*
	 * Must copy string before resetting the result in case a caller
	 * is trying to convert the interpreter's result to pixels.
	 */

	char buf[100];

	error:
	sprintf(buf, "bad screen distance \"%.50s\"", string);
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, buf, NULL);
	return TCL_ERROR;
    }
    while ((*rest != '\0') && isspace(UCHAR(*rest))) {
	rest++;
    }
    switch (*rest) {
	case '\0':
	    units = -1;
	    break;

	case 'm':
	    units = 0;
	    break;

	case 'c':
	    units = 1;
	    break;

	case 'i':
	    units = 2;
	    break;

	case 'p':
	    units = 3;
	    break;

	default:
	    goto error;
    }

    /*
     * Free the old internalRep before setting the new one. 
     */

    typePtr = objPtr->typePtr;
    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	(*typePtr->freeIntRepProc)(objPtr);
    }

    objPtr->typePtr = &pixelObjType;

    i = (int) d;
    if ((units < 0) && (i == d)) {
	SET_SIMPLEPIXEL(objPtr, i);
    } else {
	pixelPtr = (PixelRep *) ckalloc(sizeof(PixelRep));
	pixelPtr->value = d;
	pixelPtr->units = units;
	pixelPtr->tkwin = NULL;
	pixelPtr->returnValue = i;
	SET_COMPLEXPIXEL(objPtr, pixelPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetMMFromObj --
 *
 *	Attempt to return an mm value from the Tcl object "objPtr". If the
 *	object is not already an mm value, an attempt will be made to convert
 *	it to one.
 *
 * Results:
 *	The return value is a standard Tcl object result. If an error occurs
 *	during conversion, an error message is left in the interpreter's
 *	result unless "interp" is NULL.
 *
 * Side effects:
 *	If the object is not already a pixel, the conversion will free
 *	any old internal representation. 
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetMMFromObj(interp, tkwin, objPtr, doublePtr)
    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
    Tk_Window tkwin;
    Tcl_Obj *objPtr;		/* The object from which to get mms. */
    double *doublePtr;		/* Place to store resulting millimeters. */
{
    int result;
    double d;
    MMRep *mmPtr;
    static double bias[] = {
	10.0,	25.4,	1.0,	25.4 / 72.0
    };

    if (objPtr->typePtr != &mmObjType) {
	result = SetMMFromAny(interp, objPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr;
    if (mmPtr->tkwin != tkwin) {
	d = mmPtr->value;
	if (mmPtr->units == -1) {
	    d /= WidthOfScreen(Tk_Screen(tkwin));
	    d *= WidthMMOfScreen(Tk_Screen(tkwin));
	} else {
	    d *= bias[mmPtr->units];
	}
	mmPtr->tkwin = tkwin;
	mmPtr->returnValue = d;
    }
    *doublePtr = mmPtr->returnValue;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeMMInternalRep --
 *
 *	Deallocate the storage associated with a mm object's internal
 *	representation.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees objPtr's internal representation and sets objPtr's
 *	internalRep to NULL.
 *
 *----------------------------------------------------------------------
 */

static void
FreeMMInternalRep(objPtr)
    Tcl_Obj *objPtr;		/* MM object with internal rep to free. */
{
    ckfree((char *) objPtr->internalRep.otherValuePtr);
    objPtr->internalRep.otherValuePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DupMMInternalRep --
 *
 *	Initialize the internal representation of a pixel Tcl_Obj to a
 *	copy of the internal representation of an existing pixel object. 
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	copyPtr's internal rep is set to the pixel corresponding to
 *	srcPtr's internal rep.
 *
 *----------------------------------------------------------------------
 */

static void
DupMMInternalRep(srcPtr, copyPtr)
    register Tcl_Obj *srcPtr;	/* Object with internal rep to copy. */
    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
{
    MMRep *oldPtr, *newPtr;
    
    copyPtr->typePtr = srcPtr->typePtr;
    oldPtr = (MMRep *) srcPtr->internalRep.otherValuePtr;
    newPtr = (MMRep *) ckalloc(sizeof(MMRep));
    newPtr->value = oldPtr->value;
    newPtr->units = oldPtr->units;
    newPtr->tkwin = oldPtr->tkwin;
    newPtr->returnValue = oldPtr->returnValue;
    copyPtr->internalRep.otherValuePtr = (VOID *) newPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * SetMMFromAny --
 *
 *	Attempt to generate a mm internal form for the Tcl object
 *	"objPtr".
 *
 * Results:
 *	The return value is a standard Tcl result. If an error occurs during
 *	conversion, an error message is left in the interpreter's result
 *	unless "interp" is NULL.
 *
 * Side effects:
 *	If no error occurs, a mm representation of the object is
 *	stored internally and the type of "objPtr" is set to mm.
 *
 *----------------------------------------------------------------------
 */

static int
SetMMFromAny(interp, objPtr)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr;		/* The object to convert. */
{
    Tcl_ObjType *typePtr;
    char *string, *rest;
    double d;
    int units;
    MMRep *mmPtr;

    string = Tcl_GetStringFromObj(objPtr, NULL);

    d = strtod(string, &rest);
    if (rest == string) {
	/*
	 * Must copy string before resetting the result in case a caller
	 * is trying to convert the interpreter's result to mms.
	 */

	error:
	Tcl_AppendResult(interp, "bad screen distance \"", string,
		"\"", (char *) NULL);
	return TCL_ERROR;
    }
    while ((*rest != '\0') && isspace(UCHAR(*rest))) {
	rest++;
    }
    switch (*rest) {
	case '\0':
	    units = -1;
	    break;

	case 'c':
	    units = 0;
	    break;

	case 'i':
	    units = 1;
	    break;

	case 'm':
	    units = 2;
	    break;

	case 'p':
	    units = 3;
	    break;

	default:
	    goto error;
    }

    /*
     * Free the old internalRep before setting the new one. 
     */

    typePtr = objPtr->typePtr;
    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	(*typePtr->freeIntRepProc)(objPtr);
    }

    objPtr->typePtr = &mmObjType;

    mmPtr = (MMRep *) ckalloc(sizeof(MMRep));
    mmPtr->value = d;
    mmPtr->units = units;
    mmPtr->tkwin = NULL;
    mmPtr->returnValue = d;
    objPtr->internalRep.otherValuePtr = (VOID *) mmPtr;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TkGetWindowFromObj --
 *
 *	Attempt to return a Tk_Window from the Tcl object "objPtr". If the
 *	object is not already a Tk_Window, an attempt will be made to convert
 *	it to one.
 *
 * Results:
 *	The return value is a standard Tcl object result. If an error occurs
 *	during conversion, an error message is left in the interpreter's
 *	result unless "interp" is NULL.
 *
 * Side effects:
 *	If the object is not already a Tk_Window, the conversion will free
 *	any old internal representation. 
 *
 *----------------------------------------------------------------------
 */

int
TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr)
    Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
    Tk_Window tkwin;		/* A token to get the main window from. */
    register Tcl_Obj *objPtr;	/* The object from which to get boolean. */
    Tk_Window *windowPtr;	/* Place to store resulting window. */
{
    register int result;
    Tk_Window lastWindow;

    result = SetWindowFromAny(interp, objPtr);
    if (result != TCL_OK) {
	return result;
    }

    lastWindow = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr1;
    if (tkwin != lastWindow) {
	Tk_Window foundWindow = Tk_NameToWindow(interp,
		Tcl_GetStringFromObj(objPtr, NULL), tkwin);

	if (foundWindow == NULL) {
	    return TCL_ERROR;
	}
	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkwin;
	objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) foundWindow;
    }
    *windowPtr = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr2;

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * SetWindowFromAny --
 *
 *	Attempt to generate a Tk_Window internal form for the Tcl object
 *	"objPtr".
 *
 * Results:
 *	The return value is a standard Tcl result. If an error occurs during
 *	conversion, an error message is left in the interpreter's result
 *	unless "interp" is NULL.
 *
 * Side effects:
 *	If no error occurs, a standard window value is stored as "objPtr"s
 *	internal representation and the type of "objPtr" is set to Tk_Window.
 *
 *----------------------------------------------------------------------
 */

static int
SetWindowFromAny(interp, objPtr)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr;	/* The object to convert. */
{
    Tcl_ObjType *typePtr;

    /*
     * Free the old internalRep before setting the new one. 
     */

    Tcl_GetStringFromObj(objPtr, NULL);
    typePtr = objPtr->typePtr;
    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	(*typePtr->freeIntRepProc)(objPtr);
    }
    objPtr->typePtr = &windowObjType;
    objPtr->internalRep.twoPtrValue.ptr1 = NULL;
    objPtr->internalRep.twoPtrValue.ptr2 = NULL;

    return TCL_OK;
}

Added generic/tkOldConfig.c.

















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/* 
 * tkOldConfig.c --
 *
 *	This file contains the Tk_ConfigureWidget procedure. THIS FILE
 *	IS HERE FOR BACKWARD COMPATIBILITY; THE NEW CONFIGURATION
 *	PACKAGE SHOULD BE USED FOR NEW PROJECTS.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkOldConfig.c,v 1.1.2.5 1999/03/09 01:56:01 lfb Exp $
 */

#include "tkPort.h"
#include "tk.h"

/*
 * Values for "flags" field of Tk_ConfigSpec structures.  Be sure
 * to coordinate these values with those defined in tk.h
 * (TK_CONFIG_COLOR_ONLY, etc.).  There must not be overlap!
 *
 * INIT -		Non-zero means (char *) things have been
 *			converted to Tk_Uid's.
 */

#define INIT		0x20

/*
 * Forward declarations for procedures defined later in this file:
 */

static int		DoConfig _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Tk_ConfigSpec *specPtr,
			    Tk_Uid value, int valueIsUid, char *widgRec));
static Tk_ConfigSpec *	FindConfigSpec _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_ConfigSpec *specs, char *argvName,
			    int needFlags, int hateFlags));
static char *		FormatConfigInfo _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Tk_ConfigSpec *specPtr,
			    char *widgRec));
static char *		FormatConfigValue _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Tk_ConfigSpec *specPtr,
			    char *widgRec, char *buffer,
			    Tcl_FreeProc **freeProcPtr));

/*
 *--------------------------------------------------------------
 *
 * Tk_ConfigureWidget --
 *
 *	Process command-line options and database options to
 *	fill in fields of a widget record with resources and
 *	other parameters.
 *
 * Results:
 *	A standard Tcl return value.  In case of an error,
 *	the interp's result will hold an error message.
 *
 * Side effects:
 *	The fields of widgRec get filled in with information
 *	from argc/argv and the option database.  Old information
 *	in widgRec's fields gets recycled.
 *
 *--------------------------------------------------------------
 */

int
Tk_ConfigureWidget(interp, tkwin, specs, argc, argv, widgRec, flags)
    Tcl_Interp *interp;		/* Interpreter for error reporting. */
    Tk_Window tkwin;		/* Window containing widget (needed to
				 * set up X resources). */
    Tk_ConfigSpec *specs;	/* Describes legal options. */
    int argc;			/* Number of elements in argv. */
    char **argv;		/* Command-line options. */
    char *widgRec;		/* Record whose fields are to be
				 * modified.  Values must be properly
				 * initialized. */
    int flags;			/* Used to specify additional flags
				 * that must be present in config specs
				 * for them to be considered.  Also,
				 * may have TK_CONFIG_ARGV_ONLY set. */
{
    register Tk_ConfigSpec *specPtr;
    Tk_Uid value;		/* Value of option from database. */
    int needFlags;		/* Specs must contain this set of flags
				 * or else they are not considered. */
    int hateFlags;		/* If a spec contains any bits here, it's
				 * not considered. */

    needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
    if (Tk_Depth(tkwin) <= 1) {
	hateFlags = TK_CONFIG_COLOR_ONLY;
    } else {
	hateFlags = TK_CONFIG_MONO_ONLY;
    }

    /*
     * Pass one:  scan through all the option specs, replacing strings
     * with Tk_Uids (if this hasn't been done already) and clearing
     * the TK_CONFIG_OPTION_SPECIFIED flags.
     */

    for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
	if (!(specPtr->specFlags & INIT) && (specPtr->argvName != NULL)) {
	    if (specPtr->dbName != NULL) {
		specPtr->dbName = Tk_GetUid(specPtr->dbName);
	    }
	    if (specPtr->dbClass != NULL) {
		specPtr->dbClass = Tk_GetUid(specPtr->dbClass);
	    }
	    if (specPtr->defValue != NULL) {
		specPtr->defValue = Tk_GetUid(specPtr->defValue);
	    }
	}
	specPtr->specFlags = (specPtr->specFlags & ~TK_CONFIG_OPTION_SPECIFIED)
		| INIT;
    }

    /*
     * Pass two:  scan through all of the arguments, processing those
     * that match entries in the specs.
     */

    for ( ; argc > 0; argc -= 2, argv += 2) {
	specPtr = FindConfigSpec(interp, specs, *argv, needFlags, hateFlags);
	if (specPtr == NULL) {
	    return TCL_ERROR;
	}

	/*
	 * Process the entry.
	 */

	if (argc < 2) {
	    Tcl_AppendResult(interp, "value for \"", *argv,
		    "\" missing", (char *) NULL);
	    return TCL_ERROR;
	}
	if (DoConfig(interp, tkwin, specPtr, argv[1], 0, widgRec) != TCL_OK) {
	    char msg[100];

	    sprintf(msg, "\n    (processing \"%.40s\" option)",
		    specPtr->argvName);
	    Tcl_AddErrorInfo(interp, msg);
	    return TCL_ERROR;
	}
	specPtr->specFlags |= TK_CONFIG_OPTION_SPECIFIED;
    }

    /*
     * Pass three:  scan through all of the specs again;  if no
     * command-line argument matched a spec, then check for info
     * in the option database.  If there was nothing in the
     * database, then use the default.
     */

    if (!(flags & TK_CONFIG_ARGV_ONLY)) {
	for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
	    if ((specPtr->specFlags & TK_CONFIG_OPTION_SPECIFIED)
		    || (specPtr->argvName == NULL)
		    || (specPtr->type == TK_CONFIG_SYNONYM)) {
		continue;
	    }
	    if (((specPtr->specFlags & needFlags) != needFlags)
		    || (specPtr->specFlags & hateFlags)) {
		continue;
	    }
	    value = NULL;
	    if (specPtr->dbName != NULL) {
		value = Tk_GetOption(tkwin, specPtr->dbName, specPtr->dbClass);
	    }
	    if (value != NULL) {
		if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
			TCL_OK) {
		    char msg[200];
    
		    sprintf(msg, "\n    (%s \"%.50s\" in widget \"%.50s\")",
			    "database entry for",
			    specPtr->dbName, Tk_PathName(tkwin));
		    Tcl_AddErrorInfo(interp, msg);
		    return TCL_ERROR;
		}
	    } else {
		if (specPtr->defValue != NULL) {
		    value = Tk_GetUid(specPtr->defValue);
		} else {
		    value = NULL;
		}
		if ((value != NULL) && !(specPtr->specFlags
			& TK_CONFIG_DONT_SET_DEFAULT)) {
		    if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
			    TCL_OK) {
			char msg[200];
	
			sprintf(msg,
				"\n    (%s \"%.50s\" in widget \"%.50s\")",
				"default value for",
				specPtr->dbName, Tk_PathName(tkwin));
			Tcl_AddErrorInfo(interp, msg);
			return TCL_ERROR;
		    }
		}
	    }
	}
    }

    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * FindConfigSpec --
 *
 *	Search through a table of configuration specs, looking for
 *	one that matches a given argvName.
 *
 * Results:
 *	The return value is a pointer to the matching entry, or NULL
 *	if nothing matched.  In that case an error message is left
 *	in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static Tk_ConfigSpec *
FindConfigSpec(interp, specs, argvName, needFlags, hateFlags)
    Tcl_Interp *interp;		/* Used for reporting errors. */
    Tk_ConfigSpec *specs;	/* Pointer to table of configuration
				 * specifications for a widget. */
    char *argvName;		/* Name (suitable for use in a "config"
				 * command) identifying particular option. */
    int needFlags;		/* Flags that must be present in matching
				 * entry. */
    int hateFlags;		/* Flags that must NOT be present in
				 * matching entry. */
{
    register Tk_ConfigSpec *specPtr;
    register char c;		/* First character of current argument. */
    Tk_ConfigSpec *matchPtr;	/* Matching spec, or NULL. */
    size_t length;

    c = argvName[1];
    length = strlen(argvName);
    matchPtr = NULL;
    for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
	if (specPtr->argvName == NULL) {
	    continue;
	}
	if ((specPtr->argvName[1] != c)
		|| (strncmp(specPtr->argvName, argvName, length) != 0)) {
	    continue;
	}
	if (((specPtr->specFlags & needFlags) != needFlags)
		|| (specPtr->specFlags & hateFlags)) {
	    continue;
	}
	if (specPtr->argvName[length] == 0) {
	    matchPtr = specPtr;
	    goto gotMatch;
	}
	if (matchPtr != NULL) {
	    Tcl_AppendResult(interp, "ambiguous option \"", argvName,
		    "\"", (char *) NULL);
	    return (Tk_ConfigSpec *) NULL;
	}
	matchPtr = specPtr;
    }

    if (matchPtr == NULL) {
	Tcl_AppendResult(interp, "unknown option \"", argvName,
		"\"", (char *) NULL);
	return (Tk_ConfigSpec *) NULL;
    }

    /*
     * Found a matching entry.  If it's a synonym, then find the
     * entry that it's a synonym for.
     */

    gotMatch:
    specPtr = matchPtr;
    if (specPtr->type == TK_CONFIG_SYNONYM) {
	for (specPtr = specs; ; specPtr++) {
	    if (specPtr->type == TK_CONFIG_END) {
		Tcl_AppendResult(interp,
			"couldn't find synonym for option \"",
			argvName, "\"", (char *) NULL);
		return (Tk_ConfigSpec *) NULL;
	    }
	    if ((specPtr->dbName == matchPtr->dbName) 
		    && (specPtr->type != TK_CONFIG_SYNONYM)
		    && ((specPtr->specFlags & needFlags) == needFlags)
		    && !(specPtr->specFlags & hateFlags)) {
		break;
	    }
	}
    }
    return specPtr;
}

/*
 *--------------------------------------------------------------
 *
 * DoConfig --
 *
 *	This procedure applies a single configuration option
 *	to a widget record.
 *
 * Results:
 *	A standard Tcl return value.
 *
 * Side effects:
 *	WidgRec is modified as indicated by specPtr and value.
 *	The old value is recycled, if that is appropriate for
 *	the value type.
 *
 *--------------------------------------------------------------
 */

static int
DoConfig(interp, tkwin, specPtr, value, valueIsUid, widgRec)
    Tcl_Interp *interp;		/* Interpreter for error reporting. */
    Tk_Window tkwin;		/* Window containing widget (needed to
				 * set up X resources). */
    Tk_ConfigSpec *specPtr;	/* Specifier to apply. */
    char *value;		/* Value to use to fill in widgRec. */
    int valueIsUid;		/* Non-zero means value is a Tk_Uid;
				 * zero means it's an ordinary string. */
    char *widgRec;		/* Record whose fields are to be
				 * modified.  Values must be properly
				 * initialized. */
{
    char *ptr;
    Tk_Uid uid;
    int nullValue;

    nullValue = 0;
    if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) {
	nullValue = 1;
    }

    do {
	ptr = widgRec + specPtr->offset;
	switch (specPtr->type) {
	    case TK_CONFIG_BOOLEAN:
		if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_INT:
		if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_DOUBLE:
		if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_STRING: {
		char *old, *new;

		if (nullValue) {
		    new = NULL;
		} else {
		    new = (char *) ckalloc((unsigned) (strlen(value) + 1));
		    strcpy(new, value);
		}
		old = *((char **) ptr);
		if (old != NULL) {
		    ckfree(old);
		}
		*((char **) ptr) = new;
		break;
	    }
	    case TK_CONFIG_UID:
		if (nullValue) {
		    *((Tk_Uid *) ptr) = NULL;
		} else {
		    uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		    *((Tk_Uid *) ptr) = uid;
		}
		break;
	    case TK_CONFIG_COLOR: {
		XColor *newPtr, *oldPtr;

		if (nullValue) {
		    newPtr = NULL;
		} else {
		    uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		    newPtr = Tk_GetColor(interp, tkwin, uid);
		    if (newPtr == NULL) {
			return TCL_ERROR;
		    }
		}
		oldPtr = *((XColor **) ptr);
		if (oldPtr != NULL) {
		    Tk_FreeColor(oldPtr);
		}
		*((XColor **) ptr) = newPtr;
		break;
	    }
	    case TK_CONFIG_FONT: {
		Tk_Font new;

		if (nullValue) {
		    new = NULL;
		} else {
		    new = Tk_GetFont(interp, tkwin, value);
		    if (new == NULL) {
			return TCL_ERROR;
		    }
		}
		Tk_FreeFont(*((Tk_Font *) ptr));
		*((Tk_Font *) ptr) = new;
		break;
	    }
	    case TK_CONFIG_BITMAP: {
		Pixmap new, old;

		if (nullValue) {
		    new = None;
	        } else {
		    uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		    new = Tk_GetBitmap(interp, tkwin, uid);
		    if (new == None) {
			return TCL_ERROR;
		    }
		}
		old = *((Pixmap *) ptr);
		if (old != None) {
		    Tk_FreeBitmap(Tk_Display(tkwin), old);
		}
		*((Pixmap *) ptr) = new;
		break;
	    }
	    case TK_CONFIG_BORDER: {
		Tk_3DBorder new, old;

		if (nullValue) {
		    new = NULL;
		} else {
		    uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		    new = Tk_Get3DBorder(interp, tkwin, uid);
		    if (new == NULL) {
			return TCL_ERROR;
		    }
		}
		old = *((Tk_3DBorder *) ptr);
		if (old != NULL) {
		    Tk_Free3DBorder(old);
		}
		*((Tk_3DBorder *) ptr) = new;
		break;
	    }
	    case TK_CONFIG_RELIEF:
		uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		if (Tk_GetRelief(interp, uid, (int *) ptr) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_CURSOR:
	    case TK_CONFIG_ACTIVE_CURSOR: {
		Tk_Cursor new, old;

		if (nullValue) {
		    new = None;
		} else {
		    uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		    new = Tk_GetCursor(interp, tkwin, uid);
		    if (new == None) {
			return TCL_ERROR;
		    }
		}
		old = *((Tk_Cursor *) ptr);
		if (old != None) {
		    Tk_FreeCursor(Tk_Display(tkwin), old);
		}
		*((Tk_Cursor *) ptr) = new;
		if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) {
		    Tk_DefineCursor(tkwin, new);
		}
		break;
	    }
	    case TK_CONFIG_JUSTIFY:
		uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		if (Tk_GetJustify(interp, uid, (Tk_Justify *) ptr) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_ANCHOR:
		uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		if (Tk_GetAnchor(interp, uid, (Tk_Anchor *) ptr) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_CAP_STYLE:
		uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		if (Tk_GetCapStyle(interp, uid, (int *) ptr) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_JOIN_STYLE:
		uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
		if (Tk_GetJoinStyle(interp, uid, (int *) ptr) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_PIXELS:
		if (Tk_GetPixels(interp, tkwin, value, (int *) ptr)
			!= TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_MM:
		if (Tk_GetScreenMM(interp, tkwin, value, (double *) ptr)
			!= TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    case TK_CONFIG_WINDOW: {
		Tk_Window tkwin2;

		if (nullValue) {
		    tkwin2 = NULL;
		} else {
		    tkwin2 = Tk_NameToWindow(interp, value, tkwin);
		    if (tkwin2 == NULL) {
			return TCL_ERROR;
		    }
		}
		*((Tk_Window *) ptr) = tkwin2;
		break;
	    }
	    case TK_CONFIG_CUSTOM:
		if ((*specPtr->customPtr->parseProc)(
			specPtr->customPtr->clientData, interp, tkwin,
			value, widgRec, specPtr->offset) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    default: {
		char buf[64 + TCL_INTEGER_SPACE];

		sprintf(buf, "bad config table: unknown type %d",
			specPtr->type);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
		return TCL_ERROR;
	    }
	}
	specPtr++;
    } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END));
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_ConfigureInfo --
 *
 *	Return information about the configuration options
 *	for a window, and their current values.
 *
 * Results:
 *	Always returns TCL_OK.  The interp's result will be modified
 *	hold a description of either a single configuration option
 *	available for "widgRec" via "specs", or all the configuration
 *	options available.  In the "all" case, the result will
 *	available for "widgRec" via "specs".  The result will
 *	be a list, each of whose entries describes one option.
 *	Each entry will itself be a list containing the option's
 *	name for use on command lines, database name, database
 *	class, default value, and current value (empty string
 *	if none).  For options that are synonyms, the list will
 *	contain only two values:  name and synonym name.  If the
 *	"name" argument is non-NULL, then the only information
 *	returned is that for the named argument (i.e. the corresponding
 *	entry in the overall list is returned).
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

int
Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags)
    Tcl_Interp *interp;		/* Interpreter for error reporting. */
    Tk_Window tkwin;		/* Window corresponding to widgRec. */
    Tk_ConfigSpec *specs;	/* Describes legal options. */
    char *widgRec;		/* Record whose fields contain current
				 * values for options. */
    char *argvName;		/* If non-NULL, indicates a single option
				 * whose info is to be returned.  Otherwise
				 * info is returned for all options. */
    int flags;			/* Used to specify additional flags
				 * that must be present in config specs
				 * for them to be considered. */
{
    register Tk_ConfigSpec *specPtr;
    int needFlags, hateFlags;
    char *list;
    char *leader = "{";

    needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
    if (Tk_Depth(tkwin) <= 1) {
	hateFlags = TK_CONFIG_COLOR_ONLY;
    } else {
	hateFlags = TK_CONFIG_MONO_ONLY;
    }

    /*
     * If information is only wanted for a single configuration
     * spec, then handle that one spec specially.
     */

    Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
    if (argvName != NULL) {
	specPtr = FindConfigSpec(interp, specs, argvName, needFlags,
		hateFlags);
	if (specPtr == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetResult(interp,
		FormatConfigInfo(interp, tkwin, specPtr, widgRec),
		TCL_DYNAMIC);
	return TCL_OK;
    }

    /*
     * Loop through all the specs, creating a big list with all
     * their information.
     */

    for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
	if ((argvName != NULL) && (specPtr->argvName != argvName)) {
	    continue;
	}
	if (((specPtr->specFlags & needFlags) != needFlags)
		|| (specPtr->specFlags & hateFlags)) {
	    continue;
	}
	if (specPtr->argvName == NULL) {
	    continue;
	}
	list = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
	Tcl_AppendResult(interp, leader, list, "}", (char *) NULL);
	ckfree(list);
	leader = " {";
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * FormatConfigInfo --
 *
 *	Create a valid Tcl list holding the configuration information
 *	for a single configuration option.
 *
 * Results:
 *	A Tcl list, dynamically allocated.  The caller is expected to
 *	arrange for this list to be freed eventually.
 *
 * Side effects:
 *	Memory is allocated.
 *
 *--------------------------------------------------------------
 */

static char *
FormatConfigInfo(interp, tkwin, specPtr, widgRec)
    Tcl_Interp *interp;			/* Interpreter to use for things
					 * like floating-point precision. */
    Tk_Window tkwin;			/* Window corresponding to widget. */
    register Tk_ConfigSpec *specPtr;	/* Pointer to information describing
					 * option. */
    char *widgRec;			/* Pointer to record holding current
					 * values of info for widget. */
{
    char *argv[6], *result;
    char buffer[200];
    Tcl_FreeProc *freeProc = (Tcl_FreeProc *) NULL;

    argv[0] = specPtr->argvName;
    argv[1] = specPtr->dbName;
    argv[2] = specPtr->dbClass;
    argv[3] = specPtr->defValue;
    if (specPtr->type == TK_CONFIG_SYNONYM) {
	return Tcl_Merge(2, argv);
    }
    argv[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer,
	    &freeProc);
    if (argv[1] == NULL) {
	argv[1] = "";
    }
    if (argv[2] == NULL) {
	argv[2] = "";
    }
    if (argv[3] == NULL) {
	argv[3] = "";
    }
    if (argv[4] == NULL) {
	argv[4] = "";
    }
    result = Tcl_Merge(5, argv);
    if (freeProc != NULL) {
	if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) {
	    ckfree(argv[4]);
	} else {
	    (*freeProc)(argv[4]);
	}
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * FormatConfigValue --
 *
 *	This procedure formats the current value of a configuration
 *	option.
 *
 * Results:
 *	The return value is the formatted value of the option given
 *	by specPtr and widgRec.  If the value is static, so that it
 *	need not be freed, *freeProcPtr will be set to NULL;  otherwise
 *	*freeProcPtr will be set to the address of a procedure to
 *	free the result, and the caller must invoke this procedure
 *	when it is finished with the result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, freeProcPtr)
    Tcl_Interp *interp;		/* Interpreter for use in real conversions. */
    Tk_Window tkwin;		/* Window corresponding to widget. */
    Tk_ConfigSpec *specPtr;	/* Pointer to information describing option.
				 * Must not point to a synonym option. */
    char *widgRec;		/* Pointer to record holding current
				 * values of info for widget. */
    char *buffer;		/* Static buffer to use for small values.
				 * Must have at least 200 bytes of storage. */
    Tcl_FreeProc **freeProcPtr;	/* Pointer to word to fill in with address
				 * of procedure to free the result, or NULL
				 * if result is static. */
{
    char *ptr, *result;

    *freeProcPtr = NULL;
    ptr = widgRec + specPtr->offset;
    result = "";
    switch (specPtr->type) {
	case TK_CONFIG_BOOLEAN:
	    if (*((int *) ptr) == 0) {
		result = "0";
	    } else {
		result = "1";
	    }
	    break;
	case TK_CONFIG_INT:
	    sprintf(buffer, "%d", *((int *) ptr));
	    result = buffer;
	    break;
	case TK_CONFIG_DOUBLE:
	    Tcl_PrintDouble(interp, *((double *) ptr), buffer);
	    result = buffer;
	    break;
	case TK_CONFIG_STRING:
	    result = (*(char **) ptr);
	    if (result == NULL) {
		result = "";
	    }
	    break;
	case TK_CONFIG_UID: {
	    Tk_Uid uid = *((Tk_Uid *) ptr);
	    if (uid != NULL) {
		result = uid;
	    }
	    break;
	}
	case TK_CONFIG_COLOR: {
	    XColor *colorPtr = *((XColor **) ptr);
	    if (colorPtr != NULL) {
		result = Tk_NameOfColor(colorPtr);
	    }
	    break;
	}
	case TK_CONFIG_FONT: {
	    Tk_Font tkfont = *((Tk_Font *) ptr);
	    if (tkfont != NULL) {
		result = Tk_NameOfFont(tkfont);
	    }
	    break;
	}
	case TK_CONFIG_BITMAP: {
	    Pixmap pixmap = *((Pixmap *) ptr);
	    if (pixmap != None) {
		result = Tk_NameOfBitmap(Tk_Display(tkwin), pixmap);
	    }
	    break;
	}
	case TK_CONFIG_BORDER: {
	    Tk_3DBorder border = *((Tk_3DBorder *) ptr);
	    if (border != NULL) {
		result = Tk_NameOf3DBorder(border);
	    }
	    break;
	}
	case TK_CONFIG_RELIEF:
	    result = Tk_NameOfRelief(*((int *) ptr));
	    break;
	case TK_CONFIG_CURSOR:
	case TK_CONFIG_ACTIVE_CURSOR: {
	    Tk_Cursor cursor = *((Tk_Cursor *) ptr);
	    if (cursor != None) {
		result = Tk_NameOfCursor(Tk_Display(tkwin), cursor);
	    }
	    break;
	}
	case TK_CONFIG_JUSTIFY:
	    result = Tk_NameOfJustify(*((Tk_Justify *) ptr));
	    break;
	case TK_CONFIG_ANCHOR:
	    result = Tk_NameOfAnchor(*((Tk_Anchor *) ptr));
	    break;
	case TK_CONFIG_CAP_STYLE:
	    result = Tk_NameOfCapStyle(*((int *) ptr));
	    break;
	case TK_CONFIG_JOIN_STYLE:
	    result = Tk_NameOfJoinStyle(*((int *) ptr));
	    break;
	case TK_CONFIG_PIXELS:
	    sprintf(buffer, "%d", *((int *) ptr));
	    result = buffer;
	    break;
	case TK_CONFIG_MM:
	    Tcl_PrintDouble(interp, *((double *) ptr), buffer);
	    result = buffer;
	    break;
	case TK_CONFIG_WINDOW: {
	    Tk_Window tkwin;

	    tkwin = *((Tk_Window *) ptr);
	    if (tkwin != NULL) {
		result = Tk_PathName(tkwin);
	    }
	    break;
	}
	case TK_CONFIG_CUSTOM:
	    result = (*specPtr->customPtr->printProc)(
		    specPtr->customPtr->clientData, tkwin, widgRec,
		    specPtr->offset, freeProcPtr);
	    break;
	default: 
	    result = "?? unknown type ??";
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_ConfigureValue --
 *
 *	This procedure returns the current value of a configuration
 *	option for a widget.
 *
 * Results:
 *	The return value is a standard Tcl completion code (TCL_OK or
 *	TCL_ERROR).  The interp's result will be set to hold either the value
 *	of the option given by argvName (if TCL_OK is returned) or
 *	an error message (if TCL_ERROR is returned).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tk_ConfigureValue(interp, tkwin, specs, widgRec, argvName, flags)
    Tcl_Interp *interp;		/* Interpreter for error reporting. */
    Tk_Window tkwin;		/* Window corresponding to widgRec. */
    Tk_ConfigSpec *specs;	/* Describes legal options. */
    char *widgRec;		/* Record whose fields contain current
				 * values for options. */
    char *argvName;		/* Gives the command-line name for the
				 * option whose value is to be returned. */
    int flags;			/* Used to specify additional flags
				 * that must be present in config specs
				 * for them to be considered. */
{
    Tk_ConfigSpec *specPtr;
    int needFlags, hateFlags;

    needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
    if (Tk_Depth(tkwin) <= 1) {
	hateFlags = TK_CONFIG_COLOR_ONLY;
    } else {
	hateFlags = TK_CONFIG_MONO_ONLY;
    }
    specPtr = FindConfigSpec(interp, specs, argvName, needFlags, hateFlags);
    if (specPtr == NULL) {
	return TCL_ERROR;
    }
    interp->result = FormatConfigValue(interp, tkwin, specPtr, widgRec,
	    interp->result, &interp->freeProc);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_FreeOptions --
 *
 *	Free up all resources associated with configuration options.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Any resource in widgRec that is controlled by a configuration
 *	option (e.g. a Tk_3DBorder or XColor) is freed in the appropriate
 *	fashion.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
void
Tk_FreeOptions(specs, widgRec, display, needFlags)
    Tk_ConfigSpec *specs;	/* Describes legal options. */
    char *widgRec;		/* Record whose fields contain current
				 * values for options. */
    Display *display;		/* X display; needed for freeing some
				 * resources. */
    int needFlags;		/* Used to specify additional flags
				 * that must be present in config specs
				 * for them to be considered. */
{
    register Tk_ConfigSpec *specPtr;
    char *ptr;

    for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
	if ((specPtr->specFlags & needFlags) != needFlags) {
	    continue;
	}
	ptr = widgRec + specPtr->offset;
	switch (specPtr->type) {
	    case TK_CONFIG_STRING:
		if (*((char **) ptr) != NULL) {
		    ckfree(*((char **) ptr));
		    *((char **) ptr) = NULL;
		}
		break;
	    case TK_CONFIG_COLOR:
		if (*((XColor **) ptr) != NULL) {
		    Tk_FreeColor(*((XColor **) ptr));
		    *((XColor **) ptr) = NULL;
		}
		break;
	    case TK_CONFIG_FONT:
		Tk_FreeFont(*((Tk_Font *) ptr));
		*((Tk_Font *) ptr) = NULL;
		break;
	    case TK_CONFIG_BITMAP:
		if (*((Pixmap *) ptr) != None) {
		    Tk_FreeBitmap(display, *((Pixmap *) ptr));
		    *((Pixmap *) ptr) = None;
		}
		break;
	    case TK_CONFIG_BORDER:
		if (*((Tk_3DBorder *) ptr) != NULL) {
		    Tk_Free3DBorder(*((Tk_3DBorder *) ptr));
		    *((Tk_3DBorder *) ptr) = NULL;
		}
		break;
	    case TK_CONFIG_CURSOR:
	    case TK_CONFIG_ACTIVE_CURSOR:
		if (*((Tk_Cursor *) ptr) != None) {
		    Tk_FreeCursor(display, *((Tk_Cursor *) ptr));
		    *((Tk_Cursor *) ptr) = None;
		}
	}
    }
}

Changes to generic/tkOption.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkOption.c --
 *
 *	This module contains procedures to manage the option
 *	database, which allows various strings to be associated
 *	with windows either by name or by class or both.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkOption.c 1.57 96/10/17 15:16:45
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * The option database is stored as one tree for each main window.








|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkOption.c --
 *
 *	This module contains procedures to manage the option
 *	database, which allows various strings to be associated
 *	with windows either by name or by class or both.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkOption.c,v 1.1.4.3 1998/12/13 08:16:09 lfb Exp $
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * The option database is stored as one tree for each main window.
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
 * stacks get checked, but only the portions of the exact stacks that
 * pertain to the window's parent.  Lastly, name and class stacks are
 * kept separate because different search keys are used when searching
 * them;  keeping them separate speeds up the searches.
 */

#define NUM_STACKS 8
static ElArray *stacks[NUM_STACKS];
static TkWindow *cachedWindow = NULL;	/* Lowest-level window currently
					 * loaded in stacks at present. 
					 * NULL means stacks have never
					 * been used, or have been
					 * invalidated because of a change
					 * to the database. */

/*
 * One of the following structures is used to keep track of each
 * level in the stacks.
 */

typedef struct StackLevel {
    TkWindow *winPtr;		/* Window corresponding to this stack
				 * level. */
    int bases[NUM_STACKS];	/* For each stack, index of first
				 * element on stack corresponding to
				 * this level (used to restore "numUsed"
				 * fields when popping out of a level. */
} StackLevel;













/*
 * Information about all of the stack levels that are currently
 * active.  This array grows dynamically to become as large as needed.
 */

static StackLevel *levels = NULL;
				/* Array describing current stack. */
static int numLevels = 0;	/* Total space allocated. */
static int curLevel = -1;	/* Highest level currently in use.  Note:
				 * curLevel is never 0!  (I don't remember
				 * why anymore...) */

/*
 * The variable below is a serial number for all options entered into
 * the database so far.  It increments on each addition to the option
 * database.  It is used in computing option priorities, so that the
 * most recent entry wins when choosing between options at the same
 * priority level.
 */

static int serial = 0;

/*
 * Special "no match" Element to use as default for searches.
 */

static Element defaultMatch;

/*
 * Forward declarations for procedures defined in this file:
 */

static int		AddFromString _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *string, int priority));







<
<
<
<
<
<
<















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

<
|
|
|


<
|
|
|
|
|
|
|

|
|
<
|
<
|
|







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
 * stacks get checked, but only the portions of the exact stacks that
 * pertain to the window's parent.  Lastly, name and class stacks are
 * kept separate because different search keys are used when searching
 * them;  keeping them separate speeds up the searches.
 */

#define NUM_STACKS 8








/*
 * One of the following structures is used to keep track of each
 * level in the stacks.
 */

typedef struct StackLevel {
    TkWindow *winPtr;		/* Window corresponding to this stack
				 * level. */
    int bases[NUM_STACKS];	/* For each stack, index of first
				 * element on stack corresponding to
				 * this level (used to restore "numUsed"
				 * fields when popping out of a level. */
} StackLevel;

typedef struct ThreadSpecificData {
    int initialized;            /* 0 means the ThreadSpecific Data structure
				 * for the current thread needs to be
				 * initialized. */
    ElArray *stacks[NUM_STACKS];
    TkWindow *cachedWindow;
                                /* Lowest-level window currently
				 * loaded in stacks at present. 
				 * NULL means stacks have never
				 * been used, or have been
				 * invalidated because of a change
				 * to the database. */
    /*
     * Information about all of the stack levels that are currently
     * active.  This array grows dynamically to become as large as needed.
     */


    StackLevel *levels;	        /* Array describing current stack. */
    int numLevels;	        /* Total space allocated. */
    int curLevel;	        /* Highest level currently in use.  Note:
				 * curLevel is never 0!  (I don't remember
				 * why anymore...) */

    /*
     * The variable below is a serial number for all options entered into
     * the database so far.  It increments on each addition to the option
     * database.  It is used in computing option priorities, so that the
     * most recent entry wins when choosing between options at the same
     * priority level.
     */

    int serial;
    Element defaultMatch;       /* Special "no match" Element to use as 

				 * default for searches.*/

} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations for procedures defined in this file:
 */

static int		AddFromString _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *string, int priority));
244
245
246
247
248
249
250


251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
    register Element *elPtr;
    Element newEl;
    register char *p;
    char *field;
    int count, firstField, length;
#define TMP_SIZE 100
    char tmp[TMP_SIZE+1];



    if (winPtr->mainPtr->optionRootPtr == NULL) {
	OptionInit(winPtr->mainPtr);
    }
    cachedWindow = NULL;	/* Invalidate the cache. */

    /*
     * Compute the priority for the new element, including both the
     * overall level and the serial number (to disambiguate with the
     * level).
     */

    if (priority < 0) {
	priority = 0;
    } else if (priority > TK_MAX_PRIO) {
	priority = TK_MAX_PRIO;
    }
    newEl.priority = (priority << 24) + serial;
    serial++;

    /*
     * Parse the option one field at a time.
     */

    arrayPtrPtr = &(((TkWindow *) tkwin)->mainPtr->optionRootPtr);
    p = name;







>
>




|












|
|







245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
    register Element *elPtr;
    Element newEl;
    register char *p;
    char *field;
    int count, firstField, length;
#define TMP_SIZE 100
    char tmp[TMP_SIZE+1];
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (winPtr->mainPtr->optionRootPtr == NULL) {
	OptionInit(winPtr->mainPtr);
    }
    tsdPtr->cachedWindow = NULL;	/* Invalidate the cache. */

    /*
     * Compute the priority for the new element, including both the
     * overall level and the serial number (to disambiguate with the
     * level).
     */

    if (priority < 0) {
	priority = 0;
    } else if (priority > TK_MAX_PRIO) {
	priority = TK_MAX_PRIO;
    }
    newEl.priority = (priority << 24) + tsdPtr->serial;
    tsdPtr->serial++;

    /*
     * Parse the option one field at a time.
     */

    arrayPtrPtr = &(((TkWindow *) tkwin)->mainPtr->optionRootPtr);
    p = name;
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
    char *className;		/* Class of option.  NULL means there
				 * is no class for this option:  just
				 * check for name. */
{
    Tk_Uid nameId, classId;
    register Element *elPtr, *bestPtr;
    register int count;



    /*
     * Note:  no need to call OptionInit here:  it will be done by
     * the SetupStacks call below (squeeze out those nanoseconds).
     */

    if (tkwin != (Tk_Window) cachedWindow) {
	SetupStacks((TkWindow *) tkwin, 1);
    }

    nameId = Tk_GetUid(name);
    bestPtr = &defaultMatch;
    for (elPtr = stacks[EXACT_LEAF_NAME]->els,
	    count = stacks[EXACT_LEAF_NAME]->numUsed; count > 0;
	    elPtr++, count--) {
	if ((elPtr->nameUid == nameId)
		&& (elPtr->priority > bestPtr->priority)) {
	    bestPtr = elPtr;
	}
    }
    for (elPtr = stacks[WILDCARD_LEAF_NAME]->els,
	    count = stacks[WILDCARD_LEAF_NAME]->numUsed; count > 0;
	    elPtr++, count--) {
	if ((elPtr->nameUid == nameId)
		&& (elPtr->priority > bestPtr->priority)) {
	    bestPtr = elPtr;
	}
    }
    if (className != NULL) {
	classId = Tk_GetUid(className);
	for (elPtr = stacks[EXACT_LEAF_CLASS]->els,
		count = stacks[EXACT_LEAF_CLASS]->numUsed; count > 0;
		elPtr++, count--) {
	    if ((elPtr->nameUid == classId)
		    && (elPtr->priority > bestPtr->priority)) {
		bestPtr = elPtr;
	    }
	}
	for (elPtr = stacks[WILDCARD_LEAF_CLASS]->els,
		count = stacks[WILDCARD_LEAF_CLASS]->numUsed; count > 0;
		elPtr++, count--) {
	    if ((elPtr->nameUid == classId)
		    && (elPtr->priority > bestPtr->priority)) {
		bestPtr = elPtr;
	    }
	}
    }
    return bestPtr->child.valueUid;







>
>






|




|
|
|






|
|








|
|






|
|
|







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
    char *className;		/* Class of option.  NULL means there
				 * is no class for this option:  just
				 * check for name. */
{
    Tk_Uid nameId, classId;
    register Element *elPtr, *bestPtr;
    register int count;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Note:  no need to call OptionInit here:  it will be done by
     * the SetupStacks call below (squeeze out those nanoseconds).
     */

    if (tkwin != (Tk_Window) tsdPtr->cachedWindow) {
	SetupStacks((TkWindow *) tkwin, 1);
    }

    nameId = Tk_GetUid(name);
    bestPtr = &tsdPtr->defaultMatch;
    for (elPtr = tsdPtr->stacks[EXACT_LEAF_NAME]->els,
	    count = tsdPtr->stacks[EXACT_LEAF_NAME]->numUsed; count > 0;
	    elPtr++, count--) {
	if ((elPtr->nameUid == nameId)
		&& (elPtr->priority > bestPtr->priority)) {
	    bestPtr = elPtr;
	}
    }
    for (elPtr = tsdPtr->stacks[WILDCARD_LEAF_NAME]->els,
	    count = tsdPtr->stacks[WILDCARD_LEAF_NAME]->numUsed; count > 0;
	    elPtr++, count--) {
	if ((elPtr->nameUid == nameId)
		&& (elPtr->priority > bestPtr->priority)) {
	    bestPtr = elPtr;
	}
    }
    if (className != NULL) {
	classId = Tk_GetUid(className);
	for (elPtr = tsdPtr->stacks[EXACT_LEAF_CLASS]->els,
		count = tsdPtr->stacks[EXACT_LEAF_CLASS]->numUsed; count > 0;
		elPtr++, count--) {
	    if ((elPtr->nameUid == classId)
		    && (elPtr->priority > bestPtr->priority)) {
		bestPtr = elPtr;
	    }
	}
	for (elPtr = tsdPtr->stacks[WILDCARD_LEAF_CLASS]->els,
		count = tsdPtr->stacks[WILDCARD_LEAF_CLASS]->numUsed; 
                count > 0; elPtr++, count--) {
	    if ((elPtr->nameUid == classId)
		    && (elPtr->priority > bestPtr->priority)) {
		bestPtr = elPtr;
	    }
	}
    }
    return bestPtr->child.valueUid;
470
471
472
473
474
475
476


477
478
479
480
481
482
483
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    Tk_Window tkwin = (Tk_Window) clientData;
    size_t length;
    char c;



    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" cmd arg ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    c = argv[1][0];







>
>







475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    Tk_Window tkwin = (Tk_Window) clientData;
    size_t length;
    char c;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" cmd arg ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    c = argv[1][0];
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
	    return TCL_ERROR;
	}
	mainPtr = ((TkWindow *) tkwin)->mainPtr;
	if (mainPtr->optionRootPtr != NULL) {
	    ClearOptionTree(mainPtr->optionRootPtr);
	    mainPtr->optionRootPtr = NULL;
	}
	cachedWindow = NULL;
	return TCL_OK;
    } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
	Tk_Window window;
	Tk_Uid value;

	if (argc != 5) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " get window name class\"", (char *) NULL);
	    return TCL_ERROR;
	}
	window = Tk_NameToWindow(interp, argv[2], tkwin);
	if (window == NULL) {
	    return TCL_ERROR;
	}
	value = Tk_GetOption(window, argv[3], argv[4]);
	if (value != NULL) {
	    interp->result = value;
	}
	return TCL_OK;
    } else if ((c == 'r') && (strncmp(argv[1], "readfile", length) == 0)) {
	int priority;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",







|
















|







516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
	    return TCL_ERROR;
	}
	mainPtr = ((TkWindow *) tkwin)->mainPtr;
	if (mainPtr->optionRootPtr != NULL) {
	    ClearOptionTree(mainPtr->optionRootPtr);
	    mainPtr->optionRootPtr = NULL;
	}
	tsdPtr->cachedWindow = NULL;
	return TCL_OK;
    } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
	Tk_Window window;
	Tk_Uid value;

	if (argc != 5) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " get window name class\"", (char *) NULL);
	    return TCL_ERROR;
	}
	window = Tk_NameToWindow(interp, argv[2], tkwin);
	if (window == NULL) {
	    return TCL_ERROR;
	}
	value = Tk_GetOption(window, argv[3], argv[4]);
	if (value != NULL) {
	    Tcl_SetResult(interp, value, TCL_STATIC);
	}
	return TCL_OK;
    } else if ((c == 'r') && (strncmp(argv[1], "readfile", length) == 0)) {
	int priority;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
577
578
579
580
581
582
583



584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
 *--------------------------------------------------------------
 */

void
TkOptionDeadWindow(winPtr)
    register TkWindow *winPtr;		/* Window to be cleaned up. */
{



    /*
     * If this window is in the option stacks, then clear the stacks.
     */

    if (winPtr->optionLevel != -1) {
	int i;

	for (i = 1; i <= curLevel; i++) {
	    levels[i].winPtr->optionLevel = -1;
	}
	curLevel = -1;
	cachedWindow = NULL;
    }

    /*
     * If this window was a main window, then delete its option
     * database.
     */








>
>
>







|
|

|
|







584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
 *--------------------------------------------------------------
 */

void
TkOptionDeadWindow(winPtr)
    register TkWindow *winPtr;		/* Window to be cleaned up. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * If this window is in the option stacks, then clear the stacks.
     */

    if (winPtr->optionLevel != -1) {
	int i;

	for (i = 1; i <= tsdPtr->curLevel; i++) {
	    tsdPtr->levels[i].winPtr->optionLevel = -1;
	}
	tsdPtr->curLevel = -1;
	tsdPtr->cachedWindow = NULL;
    }

    /*
     * If this window was a main window, then delete its option
     * database.
     */

628
629
630
631
632
633
634


635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684

void
TkOptionClassChanged(winPtr)
    TkWindow *winPtr;			/* Window whose class changed. */
{
    int i, j, *basePtr;
    ElArray *arrayPtr;



    if (winPtr->optionLevel == -1) {
	return;
    }

    /*
     * Find the lowest stack level that refers to this window, then
     * flush all of the levels above the matching one.
     */

    for (i = 1; i <= curLevel; i++) {
	if (levels[i].winPtr == winPtr) {
	    for (j = i; j <= curLevel; j++) {
		levels[j].winPtr->optionLevel = -1;
	    }
	    curLevel = i-1;
	    basePtr = levels[i].bases;
	    for (j = 0; j < NUM_STACKS; j++) {
		arrayPtr = stacks[j];
		arrayPtr->numUsed = basePtr[j];
		arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
	    }
	    if (curLevel <= 0) {
		cachedWindow = NULL;
	    } else {
		cachedWindow = levels[curLevel].winPtr;
	    }
	    break;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ParsePriority --
 *
 *	Parse a string priority value.
 *
 * Results:
 *	The return value is the integer priority level corresponding
 *	to string, or -1 if string doesn't point to a valid priority level.
 *	In this case, an error message is left in interp->result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */








>
>










|
|
|
|

|
|

|



|
|

|
















|







638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696

void
TkOptionClassChanged(winPtr)
    TkWindow *winPtr;			/* Window whose class changed. */
{
    int i, j, *basePtr;
    ElArray *arrayPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (winPtr->optionLevel == -1) {
	return;
    }

    /*
     * Find the lowest stack level that refers to this window, then
     * flush all of the levels above the matching one.
     */

    for (i = 1; i <= tsdPtr->curLevel; i++) {
	if (tsdPtr->levels[i].winPtr == winPtr) {
	    for (j = i; j <= tsdPtr->curLevel; j++) {
		tsdPtr->levels[j].winPtr->optionLevel = -1;
	    }
	    tsdPtr->curLevel = i-1;
	    basePtr = tsdPtr->levels[i].bases;
	    for (j = 0; j < NUM_STACKS; j++) {
		arrayPtr = tsdPtr->stacks[j];
		arrayPtr->numUsed = basePtr[j];
		arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
	    }
	    if (tsdPtr->curLevel <= 0) {
		tsdPtr->cachedWindow = NULL;
	    } else {
		tsdPtr->cachedWindow = tsdPtr->levels[tsdPtr->curLevel].winPtr;
	    }
	    break;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ParsePriority --
 *
 *	Parse a string priority value.
 *
 * Results:
 *	The return value is the integer priority level corresponding
 *	to string, or -1 if string doesn't point to a valid priority level.
 *	In this case, an error message is left in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
 *	X resources (see other documentation for details on what this
 *	is), parse the resource specifications and enter them as options
 *	for tkwin's main window.
 *
 * Results:
 *	The return value is a standard Tcl return code.  In the case of
 *	an error in parsing string, TCL_ERROR will be returned and an
 *	error message will be left in interp->result.  The memory at
 *	string is totally trashed by this procedure.  If you care about
 *	its contents, make a copy before calling here.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------







|







742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
 *	X resources (see other documentation for details on what this
 *	is), parse the resource specifications and enter them as options
 *	for tkwin's main window.
 *
 * Results:
 *	The return value is a standard Tcl return code.  In the case of
 *	an error in parsing string, TCL_ERROR will be returned and an
 *	error message will be left in the interp's result.  The memory at
 *	string is totally trashed by this procedure.  If you care about
 *	its contents, make a copy before calling here.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
793
794
795
796
797
798
799

800
801

802
803
804
805
806
807
808
	 * Parse off the option name, collapsing out backslash-newline
	 * sequences of course.
	 */

	dst = name = src;
	while (*src != ':') {
	    if ((*src == '\0') || (*src == '\n')) {

		sprintf(interp->result, "missing colon on line %d",
			lineNum);

		return TCL_ERROR;
	    }
	    if ((src[0] == '\\') && (src[1] == '\n')) {
		src += 2;
		lineNum++;
	    } else {
		*dst = *src;







>
|
|
>







805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
	 * Parse off the option name, collapsing out backslash-newline
	 * sequences of course.
	 */

	dst = name = src;
	while (*src != ':') {
	    if ((*src == '\0') || (*src == '\n')) {
		char buf[32 + TCL_INTEGER_SPACE];
		
		sprintf(buf, "missing colon on line %d", lineNum);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
		return TCL_ERROR;
	    }
	    if ((src[0] == '\\') && (src[1] == '\n')) {
		src += 2;
		lineNum++;
	    } else {
		*dst = *src;
826
827
828
829
830
831
832


833

834
835
836
837
838
839
840
841
842
843
844

845
846

847
848
849
850
851
852
853
	 */

	src++;
	while ((*src == ' ') || (*src == '\t')) {
	    src++;
	}
	if (*src == '\0') {


	    sprintf(interp->result, "missing value on line %d", lineNum);

	    return TCL_ERROR;
	}

	/*
	 * Parse off the value, squeezing out backslash-newline sequences
	 * along the way.
	 */

	dst = value = src;
	while (*src != '\n') {
	    if (*src == '\0') {

		sprintf(interp->result, "missing newline on line %d",
			lineNum);

		return TCL_ERROR;
	    }
	    if ((src[0] == '\\') && (src[1] == '\n')) {
		src += 2;
		lineNum++;
	    } else {
		*dst = *src;







>
>
|
>











>
|
|
>







840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
	 */

	src++;
	while ((*src == ' ') || (*src == '\t')) {
	    src++;
	}
	if (*src == '\0') {
	    char buf[32 + TCL_INTEGER_SPACE];
	    
	    sprintf(buf, "missing value on line %d", lineNum);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    return TCL_ERROR;
	}

	/*
	 * Parse off the value, squeezing out backslash-newline sequences
	 * along the way.
	 */

	dst = value = src;
	while (*src != '\n') {
	    if (*src == '\0') {
		char buf[32 + TCL_INTEGER_SPACE];
		
		sprintf(buf, "missing newline on line %d", lineNum);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
		return TCL_ERROR;
	    }
	    if ((src[0] == '\\') && (src[1] == '\n')) {
		src += 2;
		lineNum++;
	    } else {
		*dst = *src;
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
 *
 * 	Read a file of options ("resources" in the old X terminology)
 *	and load them into the option database.
 *
 * Results:
 *	The return value is a standard Tcl return code.  In the case of
 *	an error in parsing string, TCL_ERROR will be returned and an
 *	error message will be left in interp->result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */








|







894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
 *
 * 	Read a file of options ("resources" in the old X terminology)
 *	and load them into the option database.
 *
 * Results:
 *	The return value is a standard Tcl return code.  In the case of
 *	an error in parsing string, TCL_ERROR will be returned and an
 *	error message will be left in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

1058
1059
1060
1061
1062
1063
1064


1065
1066
1067
1068
1069
1070
1071
    int leaf;			/* Non-zero means this is the leaf
				 * window being probed.  Zero means this
				 * is an ancestor of the desired leaf. */
{
    int level, i, *iPtr;
    register StackLevel *levelPtr;
    register ElArray *arrayPtr;



    /*
     * The following array defines the order in which the current
     * stacks are searched to find matching entries to add to the
     * stacks.  Given the current priority-based scheme, the order
     * below is no longer relevant;  all that matters is that an
     * element is on the list *somewhere*.  The ordering is a relic







>
>







1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
    int leaf;			/* Non-zero means this is the leaf
				 * window being probed.  Zero means this
				 * is an ancestor of the desired leaf. */
{
    int level, i, *iPtr;
    register StackLevel *levelPtr;
    register ElArray *arrayPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * The following array defines the order in which the current
     * stacks are searched to find matching entries to add to the
     * stacks.  Given the current priority-based scheme, the order
     * below is no longer relevant;  all that matters is that an
     * element is on the list *somewhere*.  The ordering is a relic
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160

1161

1162

1163

1164

1165

1166

1167

1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
    /*
     * Step 1:  make sure that options are cached for this window's
     * parent.
     */

    if (winPtr->parentPtr != NULL) {
	level = winPtr->parentPtr->optionLevel;
	if ((level == -1) || (cachedWindow == NULL)) {
	    SetupStacks(winPtr->parentPtr, 0);
	    level = winPtr->parentPtr->optionLevel;
	}
	level++;
    } else {
	level = 1;
    }

    /*
     * Step 2:  pop extra unneeded information off the stacks and
     * mark those windows as no longer having cached information.
     */

    if (curLevel >= level) {
	while (curLevel >= level) {
	    levels[curLevel].winPtr->optionLevel = -1;
	    curLevel--;
	}
	levelPtr = &levels[level];
	for (i = 0; i < NUM_STACKS; i++) {
	    arrayPtr = stacks[i];
	    arrayPtr->numUsed = levelPtr->bases[i];
	    arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
	}
    }
    curLevel = winPtr->optionLevel = level;

    /*
     * Step 3:  if the root database information isn't loaded or
     * isn't valid, initialize level 0 of the stack from the
     * database root (this only happens if winPtr is a main window).
     */

    if ((curLevel == 1)
	    && ((cachedWindow == NULL)
	    || (cachedWindow->mainPtr != winPtr->mainPtr))) {
	for (i = 0; i < NUM_STACKS; i++) {
	    arrayPtr = stacks[i];
	    arrayPtr->numUsed = 0;
	    arrayPtr->nextToUse = arrayPtr->els;
	}
	ExtendStacks(winPtr->mainPtr->optionRootPtr, 0);
    }

    /*
     * Step 4: create a new stack level;  grow the level array if
     * we've run out of levels.  Clear the stacks for EXACT_LEAF_NAME
     * and EXACT_LEAF_CLASS (anything that was there is of no use
     * any more).
     */

    if (curLevel >= numLevels) {
	StackLevel *newLevels;

	newLevels = (StackLevel *) ckalloc((unsigned)
		(numLevels*2*sizeof(StackLevel)));
	memcpy((VOID *) newLevels, (VOID *) levels,
		(numLevels*sizeof(StackLevel)));
	ckfree((char *) levels);
	numLevels *= 2;
	levels = newLevels;
    }
    levelPtr = &levels[curLevel];
    levelPtr->winPtr = winPtr;
    arrayPtr = stacks[EXACT_LEAF_NAME];
    arrayPtr->numUsed = 0;
    arrayPtr->nextToUse = arrayPtr->els;
    arrayPtr = stacks[EXACT_LEAF_CLASS];
    arrayPtr->numUsed = 0;
    arrayPtr->nextToUse = arrayPtr->els;
    levelPtr->bases[EXACT_LEAF_NAME] = stacks[EXACT_LEAF_NAME]->numUsed;

    levelPtr->bases[EXACT_LEAF_CLASS] = stacks[EXACT_LEAF_CLASS]->numUsed;

    levelPtr->bases[EXACT_NODE_NAME] = stacks[EXACT_NODE_NAME]->numUsed;

    levelPtr->bases[EXACT_NODE_CLASS] = stacks[EXACT_NODE_CLASS]->numUsed;

    levelPtr->bases[WILDCARD_LEAF_NAME] = stacks[WILDCARD_LEAF_NAME]->numUsed;

    levelPtr->bases[WILDCARD_LEAF_CLASS] = stacks[WILDCARD_LEAF_CLASS]->numUsed;

    levelPtr->bases[WILDCARD_NODE_NAME] = stacks[WILDCARD_NODE_NAME]->numUsed;

    levelPtr->bases[WILDCARD_NODE_CLASS] = stacks[WILDCARD_NODE_CLASS]->numUsed;



    /*
     * Step 5: scan the current stack level looking for matches to this
     * window's name or class;  where found, add new information to the
     * stacks.
     */

    for (iPtr = searchOrder; *iPtr != -1; iPtr++) {
	register Element *elPtr;
	int count;
	Tk_Uid id;

	i = *iPtr;
	if (i & CLASS) {
	    id = winPtr->classUid;
	} else {
	    id = winPtr->nameUid;
	}
	elPtr = stacks[i]->els;
	count = levelPtr->bases[i];

	/*
	 * For wildcard stacks, check all entries;  for non-wildcard
	 * stacks, only check things that matched in the parent.
	 */

	if (!(i & WILDCARD)) {
	    elPtr += levelPtr[-1].bases[i];
	    count -= levelPtr[-1].bases[i];
	}
	for ( ; count > 0; elPtr++, count--) {
	    if (elPtr->nameUid != id) {
		continue;
	    }
	    ExtendStacks(elPtr->child.arrayPtr, leaf);
	}
    }
    cachedWindow = winPtr;
}

/*
 *--------------------------------------------------------------
 *
 * ExtendStacks --
 *







|













|
|
|
|

|

|




|







|
|
|

|













|



|
|
|
|
|
|

|

|


|


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



















|


















|







1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
    /*
     * Step 1:  make sure that options are cached for this window's
     * parent.
     */

    if (winPtr->parentPtr != NULL) {
	level = winPtr->parentPtr->optionLevel;
	if ((level == -1) || (tsdPtr->cachedWindow == NULL)) {
	    SetupStacks(winPtr->parentPtr, 0);
	    level = winPtr->parentPtr->optionLevel;
	}
	level++;
    } else {
	level = 1;
    }

    /*
     * Step 2:  pop extra unneeded information off the stacks and
     * mark those windows as no longer having cached information.
     */

    if (tsdPtr->curLevel >= level) {
	while (tsdPtr->curLevel >= level) {
	    tsdPtr->levels[tsdPtr->curLevel].winPtr->optionLevel = -1;
	    tsdPtr->curLevel--;
	}
	levelPtr = &tsdPtr->levels[level];
	for (i = 0; i < NUM_STACKS; i++) {
	    arrayPtr = tsdPtr->stacks[i];
	    arrayPtr->numUsed = levelPtr->bases[i];
	    arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
	}
    }
    tsdPtr->curLevel = winPtr->optionLevel = level;

    /*
     * Step 3:  if the root database information isn't loaded or
     * isn't valid, initialize level 0 of the stack from the
     * database root (this only happens if winPtr is a main window).
     */

    if ((tsdPtr->curLevel == 1)
	    && ((tsdPtr->cachedWindow == NULL)
	    || (tsdPtr->cachedWindow->mainPtr != winPtr->mainPtr))) {
	for (i = 0; i < NUM_STACKS; i++) {
	    arrayPtr = tsdPtr->stacks[i];
	    arrayPtr->numUsed = 0;
	    arrayPtr->nextToUse = arrayPtr->els;
	}
	ExtendStacks(winPtr->mainPtr->optionRootPtr, 0);
    }

    /*
     * Step 4: create a new stack level;  grow the level array if
     * we've run out of levels.  Clear the stacks for EXACT_LEAF_NAME
     * and EXACT_LEAF_CLASS (anything that was there is of no use
     * any more).
     */

    if (tsdPtr->curLevel >= tsdPtr->numLevels) {
	StackLevel *newLevels;

	newLevels = (StackLevel *) ckalloc((unsigned)
		(tsdPtr->numLevels*2*sizeof(StackLevel)));
	memcpy((VOID *) newLevels, (VOID *) tsdPtr->levels,
		(tsdPtr->numLevels*sizeof(StackLevel)));
	ckfree((char *) tsdPtr->levels);
	tsdPtr->numLevels *= 2;
	tsdPtr->levels = newLevels;
    }
    levelPtr = &tsdPtr->levels[tsdPtr->curLevel];
    levelPtr->winPtr = winPtr;
    arrayPtr = tsdPtr->stacks[EXACT_LEAF_NAME];
    arrayPtr->numUsed = 0;
    arrayPtr->nextToUse = arrayPtr->els;
    arrayPtr = tsdPtr->stacks[EXACT_LEAF_CLASS];
    arrayPtr->numUsed = 0;
    arrayPtr->nextToUse = arrayPtr->els;
    levelPtr->bases[EXACT_LEAF_NAME] = tsdPtr->stacks[EXACT_LEAF_NAME]
            ->numUsed;
    levelPtr->bases[EXACT_LEAF_CLASS] = tsdPtr->stacks[EXACT_LEAF_CLASS]
            ->numUsed;
    levelPtr->bases[EXACT_NODE_NAME] = tsdPtr->stacks[EXACT_NODE_NAME]
            ->numUsed;
    levelPtr->bases[EXACT_NODE_CLASS] = tsdPtr->stacks[EXACT_NODE_CLASS]
            ->numUsed;
    levelPtr->bases[WILDCARD_LEAF_NAME] = tsdPtr->stacks[WILDCARD_LEAF_NAME]
            ->numUsed;
    levelPtr->bases[WILDCARD_LEAF_CLASS] = tsdPtr->stacks[WILDCARD_LEAF_CLASS]
            ->numUsed;
    levelPtr->bases[WILDCARD_NODE_NAME] = tsdPtr->stacks[WILDCARD_NODE_NAME]
            ->numUsed;
    levelPtr->bases[WILDCARD_NODE_CLASS] = tsdPtr->stacks[WILDCARD_NODE_CLASS]
            ->numUsed;


    /*
     * Step 5: scan the current stack level looking for matches to this
     * window's name or class;  where found, add new information to the
     * stacks.
     */

    for (iPtr = searchOrder; *iPtr != -1; iPtr++) {
	register Element *elPtr;
	int count;
	Tk_Uid id;

	i = *iPtr;
	if (i & CLASS) {
	    id = winPtr->classUid;
	} else {
	    id = winPtr->nameUid;
	}
	elPtr = tsdPtr->stacks[i]->els;
	count = levelPtr->bases[i];

	/*
	 * For wildcard stacks, check all entries;  for non-wildcard
	 * stacks, only check things that matched in the parent.
	 */

	if (!(i & WILDCARD)) {
	    elPtr += levelPtr[-1].bases[i];
	    count -= levelPtr[-1].bases[i];
	}
	for ( ; count > 0; elPtr++, count--) {
	    if (elPtr->nameUid != id) {
		continue;
	    }
	    ExtendStacks(elPtr->child.arrayPtr, leaf);
	}
    }
    tsdPtr->cachedWindow = winPtr;
}

/*
 *--------------------------------------------------------------
 *
 * ExtendStacks --
 *
1228
1229
1230
1231
1232
1233
1234


1235
1236
1237
1238
1239
1240
1241

1242
1243
1244
1245
1246
1247
1248
ExtendStacks(arrayPtr, leaf)
    ElArray *arrayPtr;		/* Array of elements to copy onto stacks. */
    int leaf;			/* If zero, then don't copy exact leaf
				 * elements. */
{
    register int count;
    register Element *elPtr;



    for (elPtr = arrayPtr->els, count = arrayPtr->numUsed;
	    count > 0; elPtr++, count--) {
	if (!(elPtr->flags & (NODE|WILDCARD)) && !leaf) {
	    continue;
	}
	stacks[elPtr->flags] = ExtendArray(stacks[elPtr->flags], elPtr);

    }
}

/*
 *--------------------------------------------------------------
 *
 * OptionInit --







>
>






|
>







1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
ExtendStacks(arrayPtr, leaf)
    ElArray *arrayPtr;		/* Array of elements to copy onto stacks. */
    int leaf;			/* If zero, then don't copy exact leaf
				 * elements. */
{
    register int count;
    register Element *elPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    for (elPtr = arrayPtr->els, count = arrayPtr->numUsed;
	    count > 0; elPtr++, count--) {
	if (!(elPtr->flags & (NODE|WILDCARD)) && !leaf) {
	    continue;
	}
	tsdPtr->stacks[elPtr->flags] = ExtendArray(
                tsdPtr->stacks[elPtr->flags], elPtr);
    }
}

/*
 *--------------------------------------------------------------
 *
 * OptionInit --
1262
1263
1264
1265
1266
1267
1268



1269
1270
1271
1272
1273



1274


1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
OptionInit(mainPtr)
    register TkMainInfo *mainPtr;	/* Top-level information about
					 * window that isn't initialized
					 * yet. */
{
    int i;
    Tcl_Interp *interp;




    /*
     * First, once-only initialization.
     */




    if (numLevels == 0) {



	numLevels = 5;
	levels = (StackLevel *) ckalloc((unsigned) (5*sizeof(StackLevel)));
	for (i = 0; i < NUM_STACKS; i++) {
	    stacks[i] = NewArray(10);
	    levels[0].bases[i] = 0;
	}
    
	defaultMatch.nameUid = NULL;
	defaultMatch.child.valueUid = NULL;
	defaultMatch.priority = -1;
	defaultMatch.flags = 0;
    }

    /*
     * Then, per-main-window initialization.  Create and delete dummy
     * interpreter for message logging.
     */








>
>
>




|
>
>
>
|
>
>

|
|

|
|


|
|
|
|







1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
OptionInit(mainPtr)
    register TkMainInfo *mainPtr;	/* Top-level information about
					 * window that isn't initialized
					 * yet. */
{
    int i;
    Tcl_Interp *interp;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    Element *defaultMatchPtr = &tsdPtr->defaultMatch;

    /*
     * First, once-only initialization.
     */
    
    if (tsdPtr->initialized == 0) {
        tsdPtr->initialized = 1;
        tsdPtr->cachedWindow = NULL;
	tsdPtr->numLevels = 5;
	tsdPtr->curLevel = -1;
	tsdPtr->serial = 0;

	tsdPtr->levels = (StackLevel *) ckalloc((unsigned) 
                (5*sizeof(StackLevel)));
	for (i = 0; i < NUM_STACKS; i++) {
	    tsdPtr->stacks[i] = NewArray(10);
	    tsdPtr->levels[0].bases[i] = 0;
	}
    
	defaultMatchPtr->nameUid = NULL;
	defaultMatchPtr->child.valueUid = NULL;
	defaultMatchPtr->priority = -1;
	defaultMatchPtr->flags = 0;
    }

    /*
     * Then, per-main-window initialization.  Create and delete dummy
     * interpreter for message logging.
     */

Changes to generic/tkPack.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkPack.c --
 *
 *	This file contains code to implement the "packer"
 *	geometry manager for Tk.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkPack.c 1.64 96/05/03 10:51:52
 */

#include "tkPort.h"
#include "tkInt.h"

typedef enum {TOP, BOTTOM, LEFT, RIGHT} Side;








|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkPack.c --
 *
 *	This file contains code to implement the "packer"
 *	geometry manager for Tk.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkPack.c,v 1.1.4.3 1998/12/13 08:16:10 lfb Exp $
 */

#include "tkPort.h"
#include "tkInt.h"

typedef enum {TOP, BOTTOM, LEFT, RIGHT} Side;

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
#define REQUESTED_REPACK	1
#define FILLX			2
#define FILLY			4
#define EXPAND			8
#define OLD_STYLE		16
#define DONT_PROPAGATE		32

/*
 * Hash table used to map from Tk_Window tokens to corresponding
 * Packer structures:
 */

static Tcl_HashTable packerHashTable;

/*
 * Have statics in this module been initialized?
 */

static int initialized = 0;

/*
 * The following structure is the official type record for the
 * packer:
 */

static void		PackReqProc _ANSI_ARGS_((ClientData clientData,
			    Tk_Window tkwin));







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







91
92
93
94
95
96
97













98
99
100
101
102
103
104
#define REQUESTED_REPACK	1
#define FILLX			2
#define FILLY			4
#define EXPAND			8
#define OLD_STYLE		16
#define DONT_PROPAGATE		32














/*
 * The following structure is the official type record for the
 * packer:
 */

static void		PackReqProc _ANSI_ARGS_((ClientData clientData,
			    Tk_Window tkwin));
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
		Unlink(slavePtr);
		Tk_UnmapWindow(slavePtr->tkwin);
	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) {
	register Packer *slavePtr;
	Tk_Window slave;
	char buffer[300];
	static char *sideNames[] = {"top", "bottom", "left", "right"};

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " info window\"", (char *) NULL);
	    return TCL_ERROR;
	}







|







264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
		Unlink(slavePtr);
		Tk_UnmapWindow(slavePtr->tkwin);
	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) {
	register Packer *slavePtr;
	Tk_Window slave;
	char buffer[64 + TCL_INTEGER_SPACE * 4];
	static char *sideNames[] = {"top", "bottom", "left", "right"};

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " info window\"", (char *) NULL);
	    return TCL_ERROR;
	}
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
	master = Tk_NameToWindow(interp, argv[2], tkwin);
	if (master == NULL) {
	    return TCL_ERROR;
	}
	masterPtr = GetPacker(master);
	if (argc == 3) {
	    if (masterPtr->flags & DONT_PROPAGATE) {
		interp->result = "0";
	    } else {
		interp->result = "1";
	    }
	    return TCL_OK;
	}
	if (Tcl_GetBoolean(interp, argv[3], &propagate) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (propagate) {







|

|







325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
	master = Tk_NameToWindow(interp, argv[2], tkwin);
	if (master == NULL) {
	    return TCL_ERROR;
	}
	masterPtr = GetPacker(master);
	if (argc == 3) {
	    if (masterPtr->flags & DONT_PROPAGATE) {
		Tcl_SetResult(interp, "0", TCL_STATIC);
	    } else {
		Tcl_SetResult(interp, "1", TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (Tcl_GetBoolean(interp, argv[3], &propagate) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (propagate) {
953
954
955
956
957
958
959

960
961
962
963
964
965
966
967
968
969
970
971

972
973
974
975
976
977
978
GetPacker(tkwin)
    Tk_Window tkwin;		/* Token for window for which
				 * packer structure is desired. */
{
    register Packer *packPtr;
    Tcl_HashEntry *hPtr;
    int new;


    if (!initialized) {
	initialized = 1;
	Tcl_InitHashTable(&packerHashTable, TCL_ONE_WORD_KEYS);
    }

    /*
     * See if there's already packer for this window.  If not,
     * then create a new one.
     */

    hPtr = Tcl_CreateHashEntry(&packerHashTable, (char *) tkwin, &new);

    if (!new) {
	return (Packer *) Tcl_GetHashValue(hPtr);
    }
    packPtr = (Packer *) ckalloc(sizeof(Packer));
    packPtr->tkwin = tkwin;
    packPtr->masterPtr = NULL;
    packPtr->nextPtr = NULL;







>

|
|
|







|
>







940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
GetPacker(tkwin)
    Tk_Window tkwin;		/* Token for window for which
				 * packer structure is desired. */
{
    register Packer *packPtr;
    Tcl_HashEntry *hPtr;
    int new;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    if (!dispPtr->packInit) {
	dispPtr->packInit = 1;
	Tcl_InitHashTable(&dispPtr->packerHashTable, TCL_ONE_WORD_KEYS);
    }

    /*
     * See if there's already packer for this window.  If not,
     * then create a new one.
     */

    hPtr = Tcl_CreateHashEntry(&dispPtr->packerHashTable, (char *) tkwin, 
            &new);
    if (!new) {
	return (Packer *) Tcl_GetHashValue(hPtr);
    }
    packPtr = (Packer *) ckalloc(sizeof(Packer));
    packPtr->tkwin = tkwin;
    packPtr->masterPtr = NULL;
    packPtr->nextPtr = NULL;
1320
1321
1322
1323
1324
1325
1326


1327
1328
1329
1330
1331
1332
1333
static void
PackStructureProc(clientData, eventPtr)
    ClientData clientData;		/* Our information about window
					 * referred to by eventPtr. */
    XEvent *eventPtr;			/* Describes what just happened. */
{
    register Packer *packPtr = (Packer *) clientData;


    if (eventPtr->type == ConfigureNotify) {
	if ((packPtr->slavePtr != NULL)
		&& !(packPtr->flags & REQUESTED_REPACK)) {
	    packPtr->flags |= REQUESTED_REPACK;
	    Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr);
	}
	if (packPtr->doubleBw != 2*Tk_Changes(packPtr->tkwin)->border_width) {







>
>







1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
static void
PackStructureProc(clientData, eventPtr)
    ClientData clientData;		/* Our information about window
					 * referred to by eventPtr. */
    XEvent *eventPtr;			/* Describes what just happened. */
{
    register Packer *packPtr = (Packer *) clientData;
    TkDisplay *dispPtr;

    if (eventPtr->type == ConfigureNotify) {
	if ((packPtr->slavePtr != NULL)
		&& !(packPtr->flags & REQUESTED_REPACK)) {
	    packPtr->flags |= REQUESTED_REPACK;
	    Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr);
	}
	if (packPtr->doubleBw != 2*Tk_Changes(packPtr->tkwin)->border_width) {
1349
1350
1351
1352
1353
1354
1355


1356
1357

1358
1359
1360
1361
1362
1363
1364
	    Tk_ManageGeometry(slavePtr->tkwin, (Tk_GeomMgr *) NULL,
		    (ClientData) NULL);
	    Tk_UnmapWindow(slavePtr->tkwin);
	    slavePtr->masterPtr = NULL;
	    nextPtr = slavePtr->nextPtr;
	    slavePtr->nextPtr = NULL;
	}


	Tcl_DeleteHashEntry(Tcl_FindHashEntry(&packerHashTable,
		(char *) packPtr->tkwin));

	if (packPtr->flags & REQUESTED_REPACK) {
	    Tcl_CancelIdleCall(ArrangePacking, (ClientData) packPtr);
	}
	packPtr->tkwin = NULL;
	Tcl_EventuallyFree((ClientData) packPtr, DestroyPacker);
    } else if (eventPtr->type == MapNotify) {
	/*







>
>
|
|
>







1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
	    Tk_ManageGeometry(slavePtr->tkwin, (Tk_GeomMgr *) NULL,
		    (ClientData) NULL);
	    Tk_UnmapWindow(slavePtr->tkwin);
	    slavePtr->masterPtr = NULL;
	    nextPtr = slavePtr->nextPtr;
	    slavePtr->nextPtr = NULL;
	}
	if (packPtr->tkwin != NULL) {
	    dispPtr = ((TkWindow *) packPtr->tkwin)->dispPtr;
            Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->packerHashTable,
		    (char *) packPtr->tkwin));
	}
	if (packPtr->flags & REQUESTED_REPACK) {
	    Tcl_CancelIdleCall(ArrangePacking, (ClientData) packPtr);
	}
	packPtr->tkwin = NULL;
	Tcl_EventuallyFree((ClientData) packPtr, DestroyPacker);
    } else if (eventPtr->type == MapNotify) {
	/*
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
 *
 *	This implements the guts of the "pack configure" command.  Given
 *	a list of slaves and configuration options, it arranges for the
 *	packer to manage the slaves and sets the specified options.
 *
 * Results:
 *	TCL_OK is returned if all went well.  Otherwise, TCL_ERROR is
 *	returned and interp->result is set to contain an error message.
 *
 * Side effects:
 *	Slave windows get taken over by the packer.
 *
 *----------------------------------------------------------------------
 */








|







1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
 *
 *	This implements the guts of the "pack configure" command.  Given
 *	a list of slaves and configuration options, it arranges for the
 *	packer to manage the slaves and sets the specified options.
 *
 * Results:
 *	TCL_OK is returned if all went well.  Otherwise, TCL_ERROR is
 *	returned and the interp's result is set to contain an error message.
 *
 * Side effects:
 *	Slave windows get taken over by the packer.
 *
 *----------------------------------------------------------------------
 */

Changes to generic/tkPlace.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkPlace.c --
 *
 *	This file contains code to implement a simple geometry manager
 *	for Tk based on absolute placement or "rubber-sheet" placement.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkPlace.c 1.27 96/08/20 17:05:31
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * Border modes for relative placement:







|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkPlace.c --
 *
 *	This file contains code to implement a simple geometry manager
 *	for Tk based on absolute placement or "rubber-sheet" placement.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkPlace.c,v 1.1.4.3 1998/12/13 08:16:10 lfb Exp $
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * Border modes for relative placement:
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
 * PARENT_RECONFIG_PENDING -	1 means that a call to RecomputePlacement
 *				is already pending via a Do_When_Idle handler.
 */

#define PARENT_RECONFIG_PENDING	1

/*
 * The hash tables below both use Tk_Window tokens as keys.  They map
 * from Tk_Windows to Slave and Master structures for windows, if they
 * exist.
 */

static int initialized = 0;
static Tcl_HashTable masterTable;
static Tcl_HashTable slaveTable;
/*
 * The following structure is the official type record for the
 * placer:
 */

static void		PlaceRequestProc _ANSI_ARGS_((ClientData clientData,
			    Tk_Window tkwin));
static void		PlaceLostSlaveProc _ANSI_ARGS_((ClientData clientData,







<
<
<
<
<
<
<
<
<







95
96
97
98
99
100
101









102
103
104
105
106
107
108
 * PARENT_RECONFIG_PENDING -	1 means that a call to RecomputePlacement
 *				is already pending via a Do_When_Idle handler.
 */

#define PARENT_RECONFIG_PENDING	1

/*









 * The following structure is the official type record for the
 * placer:
 */

static void		PlaceRequestProc _ANSI_ARGS_((ClientData clientData,
			    Tk_Window tkwin));
static void		PlaceLostSlaveProc _ANSI_ARGS_((ClientData clientData,
164
165
166
167
168
169
170



171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
    char **argv;		/* Argument strings. */
{
    Tk_Window tkwin;
    Slave *slavePtr;
    Tcl_HashEntry *hPtr;
    size_t length;
    int c;




    /*
     * Initialize, if that hasn't been done yet.
     */

    if (!initialized) {
	Tcl_InitHashTable(&masterTable, TCL_ONE_WORD_KEYS);
	Tcl_InitHashTable(&slaveTable, TCL_ONE_WORD_KEYS);
	initialized = 1;
    }

    if (argc < 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option|pathName args", (char *) NULL);
	return TCL_ERROR;
    }







>
>
>





|
|
|
|







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
    char **argv;		/* Argument strings. */
{
    Tk_Window tkwin;
    Slave *slavePtr;
    Tcl_HashEntry *hPtr;
    size_t length;
    int c;
    TkDisplay *dispPtr;

    dispPtr = ((TkWindow *) clientData)->dispPtr;

    /*
     * Initialize, if that hasn't been done yet.
     */

    if (!dispPtr->placeInit) {
	Tcl_InitHashTable(&dispPtr->masterTable, TCL_ONE_WORD_KEYS);
	Tcl_InitHashTable(&dispPtr->slaveTable, TCL_ONE_WORD_KEYS);
	dispPtr->placeInit = 1;
    }

    if (argc < 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option|pathName args", (char *) NULL);
	return TCL_ERROR;
    }
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
	return ConfigureSlave(interp, slavePtr, argc-3, argv+3);
    } else if ((c == 'f') && (strncmp(argv[1], "forget", length) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " forget pathName\"", (char *) NULL);
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(&slaveTable, (char *) tkwin);
	if (hPtr == NULL) {
	    return TCL_OK;
	}
	slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
	if ((slavePtr->masterPtr != NULL) &&
		(slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin))) {
	    Tk_UnmaintainGeometry(slavePtr->tkwin,
		    slavePtr->masterPtr->tkwin);
	}
	UnlinkSlave(slavePtr);
	Tcl_DeleteHashEntry(hPtr);
	Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
		(ClientData) slavePtr);
	Tk_ManageGeometry(tkwin, (Tk_GeomMgr *) NULL, (ClientData) NULL);
	Tk_UnmapWindow(tkwin);
	ckfree((char *) slavePtr);
    } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) {
	char buffer[50];

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " info pathName\"", (char *) NULL);
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(&slaveTable, (char *) tkwin);
	if (hPtr == NULL) {
	    return TCL_OK;
	}
	slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
	sprintf(buffer, "-x %d", slavePtr->x);
	Tcl_AppendResult(interp, buffer, (char *) NULL);
	sprintf(buffer, " -relx %.4g", slavePtr->relX);







|

















|






|







215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
	return ConfigureSlave(interp, slavePtr, argc-3, argv+3);
    } else if ((c == 'f') && (strncmp(argv[1], "forget", length) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " forget pathName\"", (char *) NULL);
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin);
	if (hPtr == NULL) {
	    return TCL_OK;
	}
	slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
	if ((slavePtr->masterPtr != NULL) &&
		(slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin))) {
	    Tk_UnmaintainGeometry(slavePtr->tkwin,
		    slavePtr->masterPtr->tkwin);
	}
	UnlinkSlave(slavePtr);
	Tcl_DeleteHashEntry(hPtr);
	Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
		(ClientData) slavePtr);
	Tk_ManageGeometry(tkwin, (Tk_GeomMgr *) NULL, (ClientData) NULL);
	Tk_UnmapWindow(tkwin);
	ckfree((char *) slavePtr);
    } else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) {
	char buffer[32 + TCL_INTEGER_SPACE];

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " info pathName\"", (char *) NULL);
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin);
	if (hPtr == NULL) {
	    return TCL_OK;
	}
	slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
	sprintf(buffer, "-x %d", slavePtr->x);
	Tcl_AppendResult(interp, buffer, (char *) NULL);
	sprintf(buffer, " -relx %.4g", slavePtr->relX);
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
	}
    } else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " slaves pathName\"", (char *) NULL);
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(&masterTable, (char *) tkwin);
	if (hPtr != NULL) {
	    Master *masterPtr;
	    masterPtr = (Master *) Tcl_GetHashValue(hPtr);
	    for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
		    slavePtr = slavePtr->nextPtr) {
		Tcl_AppendElement(interp, Tk_PathName(slavePtr->tkwin));
	    }







|







296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
	}
    } else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " slaves pathName\"", (char *) NULL);
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(&dispPtr->masterTable, (char *) tkwin);
	if (hPtr != NULL) {
	    Master *masterPtr;
	    masterPtr = (Master *) Tcl_GetHashValue(hPtr);
	    for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
		    slavePtr = slavePtr->nextPtr) {
		Tcl_AppendElement(interp, Tk_PathName(slavePtr->tkwin));
	    }
344
345
346
347
348
349
350

351
352
353
354
355
356
357
358
359
static Slave *
FindSlave(tkwin)
    Tk_Window tkwin;		/* Token for desired slave. */
{
    Tcl_HashEntry *hPtr;
    register Slave *slavePtr;
    int new;


    hPtr = Tcl_CreateHashEntry(&slaveTable, (char *) tkwin, &new);
    if (new) {
	slavePtr = (Slave *) ckalloc(sizeof(Slave));
	slavePtr->tkwin = tkwin;
	slavePtr->masterPtr = NULL;
	slavePtr->nextPtr = NULL;
	slavePtr->x = slavePtr->y = 0;
	slavePtr->relX = slavePtr->relY = (float) 0.0;







>

|







338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
static Slave *
FindSlave(tkwin)
    Tk_Window tkwin;		/* Token for desired slave. */
{
    Tcl_HashEntry *hPtr;
    register Slave *slavePtr;
    int new;
    TkDisplay * dispPtr = ((TkWindow *) tkwin)->dispPtr;

    hPtr = Tcl_CreateHashEntry(&dispPtr->slaveTable, (char *) tkwin, &new);
    if (new) {
	slavePtr = (Slave *) ckalloc(sizeof(Slave));
	slavePtr->tkwin = tkwin;
	slavePtr->masterPtr = NULL;
	slavePtr->nextPtr = NULL;
	slavePtr->x = slavePtr->y = 0;
	slavePtr->relX = slavePtr->relY = (float) 0.0;
437
438
439
440
441
442
443

444
445
446
447
448
449
450
451
452
static Master *
FindMaster(tkwin)
    Tk_Window tkwin;		/* Token for desired master. */
{
    Tcl_HashEntry *hPtr;
    register Master *masterPtr;
    int new;


    hPtr = Tcl_CreateHashEntry(&masterTable, (char *) tkwin, &new);
    if (new) {
	masterPtr = (Master *) ckalloc(sizeof(Master));
	masterPtr->tkwin = tkwin;
	masterPtr->slavePtr = NULL;
	masterPtr->flags = 0;
	Tcl_SetHashValue(hPtr, masterPtr);
	Tk_CreateEventHandler(masterPtr->tkwin, StructureNotifyMask,







>

|







432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
static Master *
FindMaster(tkwin)
    Tk_Window tkwin;		/* Token for desired master. */
{
    Tcl_HashEntry *hPtr;
    register Master *masterPtr;
    int new;
    TkDisplay * dispPtr = ((TkWindow *) tkwin)->dispPtr;

    hPtr = Tcl_CreateHashEntry(&dispPtr->masterTable, (char *) tkwin, &new);
    if (new) {
	masterPtr = (Master *) ckalloc(sizeof(Master));
	masterPtr->tkwin = tkwin;
	masterPtr->slavePtr = NULL;
	masterPtr->flags = 0;
	Tcl_SetHashValue(hPtr, masterPtr);
	Tk_CreateEventHandler(masterPtr->tkwin, StructureNotifyMask,
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
 * ConfigureSlave --
 *
 *	This procedure is called to process an argv/argc list to
 *	reconfigure the placement of a window.
 *
 * Results:
 *	A standard Tcl result.  If an error occurs then a message is
 *	left in interp->result.
 *
 * Side effects:
 *	Information in slavePtr may change, and slavePtr's master is
 *	scheduled for reconfiguration.
 *
 *----------------------------------------------------------------------
 */







|







459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
 * ConfigureSlave --
 *
 *	This procedure is called to process an argv/argc list to
 *	reconfigure the placement of a window.
 *
 * Results:
 *	A standard Tcl result.  If an error occurs then a message is
 *	left in the interp's result.
 *
 * Side effects:
 *	Information in slavePtr may change, and slavePtr's master is
 *	scheduled for reconfiguration.
 *
 *----------------------------------------------------------------------
 */
898
899
900
901
902
903
904

905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
MasterStructureProc(clientData, eventPtr)
    ClientData clientData;	/* Pointer to Master structure for window
				 * referred to by eventPtr. */
    XEvent *eventPtr;		/* Describes what just happened. */
{
    register Master *masterPtr = (Master *) clientData;
    register Slave *slavePtr, *nextPtr;


    if (eventPtr->type == ConfigureNotify) {
	if ((masterPtr->slavePtr != NULL)
		&& !(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
	    masterPtr->flags |= PARENT_RECONFIG_PENDING;
	    Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr);
	}
    } else if (eventPtr->type == DestroyNotify) {
	for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
		slavePtr = nextPtr) {
	    slavePtr->masterPtr = NULL;
	    nextPtr = slavePtr->nextPtr;
	    slavePtr->nextPtr = NULL;
	}
	Tcl_DeleteHashEntry(Tcl_FindHashEntry(&masterTable,
		(char *) masterPtr->tkwin));
	if (masterPtr->flags & PARENT_RECONFIG_PENDING) {
	    Tcl_CancelIdleCall(RecomputePlacement, (ClientData) masterPtr);
	}
	masterPtr->tkwin = NULL;
	ckfree((char *) masterPtr);
    } else if (eventPtr->type == MapNotify) {







>














|







894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
MasterStructureProc(clientData, eventPtr)
    ClientData clientData;	/* Pointer to Master structure for window
				 * referred to by eventPtr. */
    XEvent *eventPtr;		/* Describes what just happened. */
{
    register Master *masterPtr = (Master *) clientData;
    register Slave *slavePtr, *nextPtr;
    TkDisplay *dispPtr = ((TkWindow *) masterPtr->tkwin)->dispPtr;

    if (eventPtr->type == ConfigureNotify) {
	if ((masterPtr->slavePtr != NULL)
		&& !(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
	    masterPtr->flags |= PARENT_RECONFIG_PENDING;
	    Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr);
	}
    } else if (eventPtr->type == DestroyNotify) {
	for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
		slavePtr = nextPtr) {
	    slavePtr->masterPtr = NULL;
	    nextPtr = slavePtr->nextPtr;
	    slavePtr->nextPtr = NULL;
	}
	Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->masterTable,
		(char *) masterPtr->tkwin));
	if (masterPtr->flags & PARENT_RECONFIG_PENDING) {
	    Tcl_CancelIdleCall(RecomputePlacement, (ClientData) masterPtr);
	}
	masterPtr->tkwin = NULL;
	ckfree((char *) masterPtr);
    } else if (eventPtr->type == MapNotify) {
967
968
969
970
971
972
973

974
975
976
977
978
979
980
981
982
983
984
static void
SlaveStructureProc(clientData, eventPtr)
    ClientData clientData;	/* Pointer to Slave structure for window
				 * referred to by eventPtr. */
    XEvent *eventPtr;		/* Describes what just happened. */
{
    register Slave *slavePtr = (Slave *) clientData;


    if (eventPtr->type == DestroyNotify) {
	UnlinkSlave(slavePtr);
	Tcl_DeleteHashEntry(Tcl_FindHashEntry(&slaveTable,
		(char *) slavePtr->tkwin));
	ckfree((char *) slavePtr);
    }
}

/*
 *----------------------------------------------------------------------







>



|







964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
static void
SlaveStructureProc(clientData, eventPtr)
    ClientData clientData;	/* Pointer to Slave structure for window
				 * referred to by eventPtr. */
    XEvent *eventPtr;		/* Describes what just happened. */
{
    register Slave *slavePtr = (Slave *) clientData;
    TkDisplay * dispPtr = ((TkWindow *) slavePtr->tkwin)->dispPtr;

    if (eventPtr->type == DestroyNotify) {
	UnlinkSlave(slavePtr);
	Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->slaveTable,
		(char *) slavePtr->tkwin));
	ckfree((char *) slavePtr);
    }
}

/*
 *----------------------------------------------------------------------
1043
1044
1045
1046
1047
1048
1049

1050
1051
1052
1053
1054
1055
1056

1057
1058
1059
1060
static void
PlaceLostSlaveProc(clientData, tkwin)
    ClientData clientData;	/* Slave structure for slave window that
				 * was stolen away. */
    Tk_Window tkwin;		/* Tk's handle for the slave window. */
{
    register Slave *slavePtr = (Slave *) clientData;


    if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
	Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
    }
    Tk_UnmapWindow(tkwin);
    UnlinkSlave(slavePtr);
    Tcl_DeleteHashEntry(Tcl_FindHashEntry(&slaveTable, (char *) tkwin));

    Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
	    (ClientData) slavePtr);
    ckfree((char *) slavePtr);
}







>






|
>




1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
static void
PlaceLostSlaveProc(clientData, tkwin)
    ClientData clientData;	/* Slave structure for slave window that
				 * was stolen away. */
    Tk_Window tkwin;		/* Tk's handle for the slave window. */
{
    register Slave *slavePtr = (Slave *) clientData;
    TkDisplay * dispPtr = ((TkWindow *) slavePtr->tkwin)->dispPtr;

    if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
	Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
    }
    Tk_UnmapWindow(tkwin);
    UnlinkSlave(slavePtr);
    Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->slaveTable, 
            (char *) tkwin));
    Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
	    (ClientData) slavePtr);
    ckfree((char *) slavePtr);
}

Added generic/tkPlatDecls.h.





















































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
/*
 * tkPlatDecls.h --
 *
 *	Declarations of functions in the platform-specific public Tcl API.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkPlatDecls.h,v 1.2.2.3 1999/04/01 21:58:49 redman Exp $
 */

#ifndef _TKPLATDECLS
#define _TKPLATDECLS

#ifdef BUILD_tk
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
 * script.  Any modifications to the function declarations below should be made
 * in the generic/tk.decls script.
 */


/* !BEGIN!: Do not edit below this line. */

/*
 * Exported function declarations:
 */

#ifdef __WIN32__
/* 0 */
EXTERN Window		Tk_AttachHWND _ANSI_ARGS_((Tk_Window tkwin, 
				HWND hwnd));
/* 1 */
EXTERN HINSTANCE	Tk_GetHINSTANCE _ANSI_ARGS_((void));
/* 2 */
EXTERN HWND		Tk_GetHWND _ANSI_ARGS_((Window window));
/* 3 */
EXTERN Tk_Window	Tk_HWNDToWindow _ANSI_ARGS_((HWND hwnd));
/* 4 */
EXTERN void		Tk_PointerEvent _ANSI_ARGS_((HWND hwnd, int x, int y));
/* 5 */
EXTERN int		Tk_TranslateWinEvent _ANSI_ARGS_((HWND hwnd, 
				UINT message, WPARAM wParam, LPARAM lParam, 
				LRESULT * result));
#endif /* __WIN32__ */
#ifdef MAC_TCL
/* 0 */
EXTERN void		Tk_MacSetEmbedHandler _ANSI_ARGS_((
				Tk_MacEmbedRegisterWinProc * registerWinProcPtr, 
				Tk_MacEmbedGetGrafPortProc * getPortProcPtr, 
				Tk_MacEmbedMakeContainerExistProc * containerExistProcPtr, 
				Tk_MacEmbedGetClipProc * getClipProc, 
				Tk_MacEmbedGetOffsetInParentProc * getOffsetProc));
/* 1 */
EXTERN void		Tk_MacTurnOffMenus _ANSI_ARGS_((void));
/* 2 */
EXTERN void		Tk_MacTkOwnsCursor _ANSI_ARGS_((int tkOwnsIt));
/* 3 */
EXTERN void		TkMacInitMenus _ANSI_ARGS_((Tcl_Interp * interp));
/* 4 */
EXTERN void		TkMacInitAppleEvents _ANSI_ARGS_((
				Tcl_Interp * interp));
/* 5 */
EXTERN int		TkMacConvertEvent _ANSI_ARGS_((
				EventRecord * eventPtr));
/* 6 */
EXTERN int		TkMacConvertTkEvent _ANSI_ARGS_((
				EventRecord * eventPtr, Window window));
/* 7 */
EXTERN void		TkGenWMConfigureEvent _ANSI_ARGS_((Tk_Window tkwin, 
				int x, int y, int width, int height, 
				int flags));
/* 8 */
EXTERN void		TkMacInvalClipRgns _ANSI_ARGS_((TkWindow * winPtr));
/* 9 */
EXTERN int		TkMacHaveAppearance _ANSI_ARGS_((void));
/* 10 */
EXTERN GWorldPtr	TkMacGetDrawablePort _ANSI_ARGS_((Drawable drawable));
#endif /* MAC_TCL */

typedef struct TkPlatStubs {
    int magic;
    struct TkPlatStubHooks *hooks;

#ifdef __WIN32__
    Window (*tk_AttachHWND) _ANSI_ARGS_((Tk_Window tkwin, HWND hwnd)); /* 0 */
    HINSTANCE (*tk_GetHINSTANCE) _ANSI_ARGS_((void)); /* 1 */
    HWND (*tk_GetHWND) _ANSI_ARGS_((Window window)); /* 2 */
    Tk_Window (*tk_HWNDToWindow) _ANSI_ARGS_((HWND hwnd)); /* 3 */
    void (*tk_PointerEvent) _ANSI_ARGS_((HWND hwnd, int x, int y)); /* 4 */
    int (*tk_TranslateWinEvent) _ANSI_ARGS_((HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam, LRESULT * result)); /* 5 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    void (*tk_MacSetEmbedHandler) _ANSI_ARGS_((Tk_MacEmbedRegisterWinProc * registerWinProcPtr, Tk_MacEmbedGetGrafPortProc * getPortProcPtr, Tk_MacEmbedMakeContainerExistProc * containerExistProcPtr, Tk_MacEmbedGetClipProc * getClipProc, Tk_MacEmbedGetOffsetInParentProc * getOffsetProc)); /* 0 */
    void (*tk_MacTurnOffMenus) _ANSI_ARGS_((void)); /* 1 */
    void (*tk_MacTkOwnsCursor) _ANSI_ARGS_((int tkOwnsIt)); /* 2 */
    void (*tkMacInitMenus) _ANSI_ARGS_((Tcl_Interp * interp)); /* 3 */
    void (*tkMacInitAppleEvents) _ANSI_ARGS_((Tcl_Interp * interp)); /* 4 */
    int (*tkMacConvertEvent) _ANSI_ARGS_((EventRecord * eventPtr)); /* 5 */
    int (*tkMacConvertTkEvent) _ANSI_ARGS_((EventRecord * eventPtr, Window window)); /* 6 */
    void (*tkGenWMConfigureEvent) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int width, int height, int flags)); /* 7 */
    void (*tkMacInvalClipRgns) _ANSI_ARGS_((TkWindow * winPtr)); /* 8 */
    int (*tkMacHaveAppearance) _ANSI_ARGS_((void)); /* 9 */
    GWorldPtr (*tkMacGetDrawablePort) _ANSI_ARGS_((Drawable drawable)); /* 10 */
#endif /* MAC_TCL */
} TkPlatStubs;

extern TkPlatStubs *tkPlatStubsPtr;

#if defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS)

/*
 * Inline function declarations:
 */

#ifdef __WIN32__
#ifndef Tk_AttachHWND
#define Tk_AttachHWND \
	(tkPlatStubsPtr->tk_AttachHWND) /* 0 */
#endif
#ifndef Tk_GetHINSTANCE
#define Tk_GetHINSTANCE \
	(tkPlatStubsPtr->tk_GetHINSTANCE) /* 1 */
#endif
#ifndef Tk_GetHWND
#define Tk_GetHWND \
	(tkPlatStubsPtr->tk_GetHWND) /* 2 */
#endif
#ifndef Tk_HWNDToWindow
#define Tk_HWNDToWindow \
	(tkPlatStubsPtr->tk_HWNDToWindow) /* 3 */
#endif
#ifndef Tk_PointerEvent
#define Tk_PointerEvent \
	(tkPlatStubsPtr->tk_PointerEvent) /* 4 */
#endif
#ifndef Tk_TranslateWinEvent
#define Tk_TranslateWinEvent \
	(tkPlatStubsPtr->tk_TranslateWinEvent) /* 5 */
#endif
#endif /* __WIN32__ */
#ifdef MAC_TCL
#ifndef Tk_MacSetEmbedHandler
#define Tk_MacSetEmbedHandler \
	(tkPlatStubsPtr->tk_MacSetEmbedHandler) /* 0 */
#endif
#ifndef Tk_MacTurnOffMenus
#define Tk_MacTurnOffMenus \
	(tkPlatStubsPtr->tk_MacTurnOffMenus) /* 1 */
#endif
#ifndef Tk_MacTkOwnsCursor
#define Tk_MacTkOwnsCursor \
	(tkPlatStubsPtr->tk_MacTkOwnsCursor) /* 2 */
#endif
#ifndef TkMacInitMenus
#define TkMacInitMenus \
	(tkPlatStubsPtr->tkMacInitMenus) /* 3 */
#endif
#ifndef TkMacInitAppleEvents
#define TkMacInitAppleEvents \
	(tkPlatStubsPtr->tkMacInitAppleEvents) /* 4 */
#endif
#ifndef TkMacConvertEvent
#define TkMacConvertEvent \
	(tkPlatStubsPtr->tkMacConvertEvent) /* 5 */
#endif
#ifndef TkMacConvertTkEvent
#define TkMacConvertTkEvent \
	(tkPlatStubsPtr->tkMacConvertTkEvent) /* 6 */
#endif
#ifndef TkGenWMConfigureEvent
#define TkGenWMConfigureEvent \
	(tkPlatStubsPtr->tkGenWMConfigureEvent) /* 7 */
#endif
#ifndef TkMacInvalClipRgns
#define TkMacInvalClipRgns \
	(tkPlatStubsPtr->tkMacInvalClipRgns) /* 8 */
#endif
#ifndef TkMacHaveAppearance
#define TkMacHaveAppearance \
	(tkPlatStubsPtr->tkMacHaveAppearance) /* 9 */
#endif
#ifndef TkMacGetDrawablePort
#define TkMacGetDrawablePort \
	(tkPlatStubsPtr->tkMacGetDrawablePort) /* 10 */
#endif
#endif /* MAC_TCL */

#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TKPLATDECLS */

Changes to generic/tkPointer.c.

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
/* 
 * tkPointer.c --
 *
 *	This file contains functions for emulating the X server
 *	pointer and grab state machine.  This file is used by the
 *	Mac and Windows platforms to generate appropriate enter/leave
 *	events, and to update the global grab window information.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkPointer.c 1.12 97/10/31 17:06:24
 */

#include "tkInt.h"





#ifdef MAC_TCL
#define Cursor XCursor
#endif

/*
 * Mask that selects any of the state bits corresponding to buttons,
 * plus masks that select individual buttons' bits:
 */

#define ALL_BUTTONS \
	(Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask)
static unsigned int buttonMasks[] = {
    Button1Mask, Button2Mask, Button3Mask, Button4Mask, Button5Mask
};
#define ButtonMask(b) (buttonMasks[(b)-Button1])

/*
 * Declarations of static variables used in the pointer module.
 */

static TkWindow *cursorWinPtr = NULL;	/* Window that is currently
					 * controlling the global cursor. */
static TkWindow *grabWinPtr = NULL;	/* Window that defines the top of the
					 * grab tree in a global grab. */
static XPoint lastPos = { 0, 0};	/* Last reported mouse position. */
static int lastState = 0;		/* Last known state flags. */

static TkWindow *lastWinPtr = NULL;	/* Last reported mouse window. */
static TkWindow *restrictWinPtr = NULL;	/* Window to which all mouse events
					 * will be reported. */





/*
 * Forward declarations of procedures used in this file.
 */

static int		GenerateEnterLeave _ANSI_ARGS_((TkWindow *winPtr,
			    int x, int y, int state));













|



>
>
>
>

















<
<
<
|
<
<
|

<
|
>
|
|

>
>
>
>







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
/* 
 * tkPointer.c --
 *
 *	This file contains functions for emulating the X server
 *	pointer and grab state machine.  This file is used by the
 *	Mac and Windows platforms to generate appropriate enter/leave
 *	events, and to update the global grab window information.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkPointer.c,v 1.1.4.3 1999/03/10 07:13:45 stanton Exp $
 */

#include "tkInt.h"

#ifdef __WIN32__
#include "tkWinInt.h"
#endif

#ifdef MAC_TCL
#define Cursor XCursor
#endif

/*
 * Mask that selects any of the state bits corresponding to buttons,
 * plus masks that select individual buttons' bits:
 */

#define ALL_BUTTONS \
	(Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask)
static unsigned int buttonMasks[] = {
    Button1Mask, Button2Mask, Button3Mask, Button4Mask, Button5Mask
};
#define ButtonMask(b) (buttonMasks[(b)-Button1])




typedef struct ThreadSpecificData {


    TkWindow *grabWinPtr;	        /* Window that defines the top of the
					 * grab tree in a global grab. */

    int lastState;		        /* Last known state flags. */
    XPoint lastPos;	                /* Last reported mouse position. */
    TkWindow *lastWinPtr;	        /* Last reported mouse window. */
    TkWindow *restrictWinPtr;    	/* Window to which all mouse events
					 * will be reported. */
    TkWindow *cursorWinPtr;	        /* Window that is currently
					 * controlling the global cursor. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations of procedures used in this file.
 */

static int		GenerateEnterLeave _ANSI_ARGS_((TkWindow *winPtr,
			    int x, int y, int state));
133
134
135
136
137
138
139




140
141
142
143
144
145
146
147
148
static int
GenerateEnterLeave(winPtr, x, y, state)
    TkWindow *winPtr;		/* Current Tk window (or NULL). */
    int x,y;			/* Current mouse position in root coords. */
    int state;			/* State flags. */
{
    int crossed = 0;		/* 1 if mouse crossed a window boundary */





    if (winPtr != lastWinPtr) {
	if (restrictWinPtr) {
	    int newPos, oldPos;

	    newPos = TkPositionInTree(winPtr, restrictWinPtr);
	    oldPos = TkPositionInTree(lastWinPtr, restrictWinPtr);

	    /*







>
>
>
>

|







136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
static int
GenerateEnterLeave(winPtr, x, y, state)
    TkWindow *winPtr;		/* Current Tk window (or NULL). */
    int x,y;			/* Current mouse position in root coords. */
    int state;			/* State flags. */
{
    int crossed = 0;		/* 1 if mouse crossed a window boundary */
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    TkWindow *restrictWinPtr = tsdPtr->restrictWinPtr;
    TkWindow *lastWinPtr = tsdPtr->lastWinPtr;

    if (winPtr != tsdPtr->lastWinPtr) {
	if (restrictWinPtr) {
	    int newPos, oldPos;

	    newPos = TkPositionInTree(winPtr, restrictWinPtr);
	    oldPos = TkPositionInTree(lastWinPtr, restrictWinPtr);

	    /*
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
			NotifyNormal);

		TkInOutEvents(&event, lastWinPtr, winPtr, LeaveNotify,
			EnterNotify, TCL_QUEUE_TAIL);
		crossed = 1;
	    }
	}
	lastWinPtr = winPtr;
    }

    return crossed;
}

/*
 *----------------------------------------------------------------------







|







199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
			NotifyNormal);

		TkInOutEvents(&event, lastWinPtr, winPtr, LeaveNotify,
			EnterNotify, TCL_QUEUE_TAIL);
		crossed = 1;
	    }
	}
	tsdPtr->lastWinPtr = winPtr;
    }

    return crossed;
}

/*
 *----------------------------------------------------------------------
222
223
224
225
226
227
228


229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244

245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
void
Tk_UpdatePointer(tkwin, x, y, state)
    Tk_Window tkwin;		/* Window to which pointer event
				 * is reported. May be NULL. */
    int x, y;			/* Pointer location in root coords. */
    int state;			/* Modifier state mask. */
{


    TkWindow *winPtr = (TkWindow *)tkwin;
    TkWindow *targetWinPtr;
    XPoint pos;
    XEvent event;
    int changes = (state ^ lastState) & ALL_BUTTONS;
    int type, b, mask;

    pos.x = x;
    pos.y = y;

    /*
     * Use the current keyboard state, but the old mouse button
     * state since we haven't generated the button events yet.
     */

    lastState = (state & ~ALL_BUTTONS) | (lastState & ALL_BUTTONS);


    /*
     * Generate Enter/Leave events.  If the pointer has crossed window
     * boundaries, update the current mouse position so we don't generate
     * redundant motion events.
     */

    if (GenerateEnterLeave(winPtr, x, y, lastState)) {
	lastPos = pos;
    }

    /*
     * Generate ButtonPress/ButtonRelease events based on the differences
     * between the current button state and the last known button state.
     */

    for (b = Button1; b <= Button3; b++) {
	mask = ButtonMask(b);
	if (changes & mask) {
	    if (state & mask) {	
		type = ButtonPress;

	        /*
		 * ButtonPress - Set restrict window if we aren't grabbed, or
		 * if this is the first button down.
		 */

		if (!restrictWinPtr) {
		    if (!grabWinPtr) {

			/*
			 * Mouse is not grabbed, so set a button grab.
			 */

			restrictWinPtr = winPtr;
			TkpSetCapture(restrictWinPtr);

		    } else if ((lastState & ALL_BUTTONS) == 0) {

			/*
			 * Mouse is in a non-button grab, so ensure
			 * the button grab is inside the grab tree.
			 */

			if (TkPositionInTree(winPtr, grabWinPtr)
				== TK_GRAB_IN_TREE) {
			    restrictWinPtr = winPtr;
			} else {
			    restrictWinPtr = grabWinPtr;
			}
			TkpSetCapture(restrictWinPtr);
		    }
		}

	    } else {
		type = ButtonRelease;

	        /*
		 * ButtonRelease - Release the mouse capture and clear the
		 * restrict window when the last button is released and we
		 * aren't in a global grab.
		 */

		if ((lastState & ALL_BUTTONS) == mask) {
		    if (!grabWinPtr) {
			TkpSetCapture(NULL);
		    }
		}

		/*
		 * If we are releasing a restrict window, then we need
		 * to send the button event followed by mouse motion from
		 * the restrict window to the current mouse position.
		 */

		if (restrictWinPtr) {
		    InitializeEvent(&event, restrictWinPtr, type, x, y,
			    lastState, b);
		    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
		    lastState &= ~mask;
		    lastWinPtr = restrictWinPtr;
		    restrictWinPtr = NULL;

		    GenerateEnterLeave(winPtr, x, y, lastState);
		    lastPos = pos;
		    continue;
		}		
	    }

	    /*
	     * If a restrict window is set, make sure the pointer event
	     * is reported relative to that window.  Otherwise, if a
	     * global grab is in effect then events outside of windows
	     * managed by Tk should be reported to the grab window.
	     */

	    if (restrictWinPtr) {
		targetWinPtr = restrictWinPtr;
	    } else if (grabWinPtr && !winPtr) {
		targetWinPtr = grabWinPtr;
	    } else {
		targetWinPtr = winPtr;
	    }

	    /*
	     * If we still have a target window, send the event.
	     */

	    if (winPtr != NULL) {
		InitializeEvent(&event, targetWinPtr, type, x, y,
			lastState, b);
		Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
	    }

	    /*
	     * Update the state for the next iteration.
	     */

	    lastState = (type == ButtonPress)
		? (lastState | mask) : (lastState & ~mask);
	    lastPos = pos;
	}
    }

    /*
     * Make sure the cursor window is up to date.
     */

    if (restrictWinPtr) {
	targetWinPtr = restrictWinPtr;
    } else if (grabWinPtr) {
	targetWinPtr = (TkPositionInTree(winPtr, grabWinPtr)
		== TK_GRAB_IN_TREE) ? winPtr : grabWinPtr;
    } else {
	targetWinPtr = winPtr;
    }
    UpdateCursor(targetWinPtr);

    /*
     * If no other events caused the position to be updated,
     * generate a motion event.
     */

    if (lastPos.x != pos.x || lastPos.y != pos.y) {
	if (restrictWinPtr) {
	    targetWinPtr = restrictWinPtr;
	} else if (grabWinPtr && !winPtr) {
	    targetWinPtr = grabWinPtr;
	}

	if (targetWinPtr != NULL) {
	    InitializeEvent(&event, targetWinPtr, MotionNotify, x, y,
		    lastState, NotifyNormal);
	    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
	}
	lastPos = pos;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * XGrabPointer --







>
>




|










|
>







|
|


















|
|





|
|

|






|

|

|

|












|
|










|
|
|

|
|
|

|
|











|
|
|
|










|







|
|
|







|
|
|
|
|










|
|
|
|
|




|


|







229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
void
Tk_UpdatePointer(tkwin, x, y, state)
    Tk_Window tkwin;		/* Window to which pointer event
				 * is reported. May be NULL. */
    int x, y;			/* Pointer location in root coords. */
    int state;			/* Modifier state mask. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    TkWindow *winPtr = (TkWindow *)tkwin;
    TkWindow *targetWinPtr;
    XPoint pos;
    XEvent event;
    int changes = (state ^ tsdPtr->lastState) & ALL_BUTTONS;
    int type, b, mask;

    pos.x = x;
    pos.y = y;

    /*
     * Use the current keyboard state, but the old mouse button
     * state since we haven't generated the button events yet.
     */

    tsdPtr->lastState = (state & ~ALL_BUTTONS) | (tsdPtr->lastState
	    & ALL_BUTTONS);

    /*
     * Generate Enter/Leave events.  If the pointer has crossed window
     * boundaries, update the current mouse position so we don't generate
     * redundant motion events.
     */

    if (GenerateEnterLeave(winPtr, x, y, tsdPtr->lastState)) {
	tsdPtr->lastPos = pos;
    }

    /*
     * Generate ButtonPress/ButtonRelease events based on the differences
     * between the current button state and the last known button state.
     */

    for (b = Button1; b <= Button3; b++) {
	mask = ButtonMask(b);
	if (changes & mask) {
	    if (state & mask) {	
		type = ButtonPress;

	        /*
		 * ButtonPress - Set restrict window if we aren't grabbed, or
		 * if this is the first button down.
		 */

		if (!tsdPtr->restrictWinPtr) {
		    if (!tsdPtr->grabWinPtr) {

			/*
			 * Mouse is not grabbed, so set a button grab.
			 */

			tsdPtr->restrictWinPtr = winPtr;
			TkpSetCapture(tsdPtr->restrictWinPtr);

		    } else if ((tsdPtr->lastState & ALL_BUTTONS) == 0) {

			/*
			 * Mouse is in a non-button grab, so ensure
			 * the button grab is inside the grab tree.
			 */

			if (TkPositionInTree(winPtr, tsdPtr->grabWinPtr)
				== TK_GRAB_IN_TREE) {
			    tsdPtr->restrictWinPtr = winPtr;
			} else {
			    tsdPtr->restrictWinPtr = tsdPtr->grabWinPtr;
			}
			TkpSetCapture(tsdPtr->restrictWinPtr);
		    }
		}

	    } else {
		type = ButtonRelease;

	        /*
		 * ButtonRelease - Release the mouse capture and clear the
		 * restrict window when the last button is released and we
		 * aren't in a global grab.
		 */

		if ((tsdPtr->lastState & ALL_BUTTONS) == mask) {
		    if (!tsdPtr->grabWinPtr) {
			TkpSetCapture(NULL);
		    }
		}

		/*
		 * If we are releasing a restrict window, then we need
		 * to send the button event followed by mouse motion from
		 * the restrict window to the current mouse position.
		 */

		if (tsdPtr->restrictWinPtr) {
		    InitializeEvent(&event, tsdPtr->restrictWinPtr, type, x, y,
			    tsdPtr->lastState, b);
		    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
		    tsdPtr->lastState &= ~mask;
		    tsdPtr->lastWinPtr = tsdPtr->restrictWinPtr;
		    tsdPtr->restrictWinPtr = NULL;

		    GenerateEnterLeave(winPtr, x, y, tsdPtr->lastState);
		    tsdPtr->lastPos = pos;
		    continue;
		}		
	    }

	    /*
	     * If a restrict window is set, make sure the pointer event
	     * is reported relative to that window.  Otherwise, if a
	     * global grab is in effect then events outside of windows
	     * managed by Tk should be reported to the grab window.
	     */

	    if (tsdPtr->restrictWinPtr) {
		targetWinPtr = tsdPtr->restrictWinPtr;
	    } else if (tsdPtr->grabWinPtr && !winPtr) {
		targetWinPtr = tsdPtr->grabWinPtr;
	    } else {
		targetWinPtr = winPtr;
	    }

	    /*
	     * If we still have a target window, send the event.
	     */

	    if (winPtr != NULL) {
		InitializeEvent(&event, targetWinPtr, type, x, y,
			tsdPtr->lastState, b);
		Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
	    }

	    /*
	     * Update the state for the next iteration.
	     */

	    tsdPtr->lastState = (type == ButtonPress)
		? (tsdPtr->lastState | mask) : (tsdPtr->lastState & ~mask);
	    tsdPtr->lastPos = pos;
	}
    }

    /*
     * Make sure the cursor window is up to date.
     */

    if (tsdPtr->restrictWinPtr) {
	targetWinPtr = tsdPtr->restrictWinPtr;
    } else if (tsdPtr->grabWinPtr) {
	targetWinPtr = (TkPositionInTree(winPtr, tsdPtr->grabWinPtr)
		== TK_GRAB_IN_TREE) ? winPtr : tsdPtr->grabWinPtr;
    } else {
	targetWinPtr = winPtr;
    }
    UpdateCursor(targetWinPtr);

    /*
     * If no other events caused the position to be updated,
     * generate a motion event.
     */

    if (tsdPtr->lastPos.x != pos.x || tsdPtr->lastPos.y != pos.y) {
	if (tsdPtr->restrictWinPtr) {
	    targetWinPtr = tsdPtr->restrictWinPtr;
	} else if (tsdPtr->grabWinPtr && !winPtr) {
	    targetWinPtr = tsdPtr->grabWinPtr;
	}

	if (targetWinPtr != NULL) {
	    InitializeEvent(&event, targetWinPtr, MotionNotify, x, y,
		    tsdPtr->lastState, NotifyNormal);
	    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
	}
	tsdPtr->lastPos = pos;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * XGrabPointer --
429
430
431
432
433
434
435



436
437
438
439

440
441
442
443
444
445
446
447
448
    unsigned int event_mask;
    int pointer_mode;
    int keyboard_mode;
    Window confine_to;
    Cursor cursor;
    Time time;
{



    display->request++;
    grabWinPtr = (TkWindow *) Tk_IdToWindow(display, grab_window);
    restrictWinPtr = NULL;
    TkpSetCapture(grabWinPtr);

    if (TkPositionInTree(lastWinPtr, grabWinPtr) != TK_GRAB_IN_TREE) {
	UpdateCursor(grabWinPtr);
    }
    return GrabSuccess;
}

/*
 *----------------------------------------------------------------------
 *







>
>
>

|
|
|
>
|
|







439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
    unsigned int event_mask;
    int pointer_mode;
    int keyboard_mode;
    Window confine_to;
    Cursor cursor;
    Time time;
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    display->request++;
    tsdPtr->grabWinPtr = (TkWindow *) Tk_IdToWindow(display, grab_window);
    tsdPtr->restrictWinPtr = NULL;
    TkpSetCapture(tsdPtr->grabWinPtr);
    if (TkPositionInTree(tsdPtr->lastWinPtr, tsdPtr->grabWinPtr) 
            != TK_GRAB_IN_TREE) {
	UpdateCursor(tsdPtr->grabWinPtr);
    }
    return GrabSuccess;
}

/*
 *----------------------------------------------------------------------
 *
460
461
462
463
464
465
466



467
468
469
470
471
472
473
474
475
476
477
478
 */

void
XUngrabPointer(display, time)
    Display* display;
    Time time;
{



    display->request++;
    grabWinPtr = NULL;
    restrictWinPtr = NULL;
    TkpSetCapture(NULL);
    UpdateCursor(lastWinPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TkPointerDeadWindow --
 *







>
>
>

|
|

|







474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
 */

void
XUngrabPointer(display, time)
    Display* display;
    Time time;
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    display->request++;
    tsdPtr->grabWinPtr = NULL;
    tsdPtr->restrictWinPtr = NULL;
    TkpSetCapture(NULL);
    UpdateCursor(tsdPtr->lastWinPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TkPointerDeadWindow --
 *
487
488
489
490
491
492
493



494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
 *----------------------------------------------------------------------
 */

void
TkPointerDeadWindow(winPtr)
    TkWindow *winPtr;
{



    if (winPtr == lastWinPtr) {
	lastWinPtr = NULL;
    }
    if (winPtr == grabWinPtr) {
	grabWinPtr = NULL;
    }
    if (winPtr == restrictWinPtr) {
	restrictWinPtr = NULL;
    }
    if (!(restrictWinPtr || grabWinPtr)) {
	TkpSetCapture(NULL);
    }
}

/*
 *----------------------------------------------------------------------
 *







>
>
>
|
|

|
|

|
|

|







504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
 *----------------------------------------------------------------------
 */

void
TkPointerDeadWindow(winPtr)
    TkWindow *winPtr;
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (winPtr == tsdPtr->lastWinPtr) {
	tsdPtr->lastWinPtr = NULL;
    }
    if (winPtr == tsdPtr->grabWinPtr) {
	tsdPtr->grabWinPtr = NULL;
    }
    if (winPtr == tsdPtr->restrictWinPtr) {
	tsdPtr->restrictWinPtr = NULL;
    }
    if (!(tsdPtr->restrictWinPtr || tsdPtr->grabWinPtr)) {
	TkpSetCapture(NULL);
    }
}

/*
 *----------------------------------------------------------------------
 *
523
524
525
526
527
528
529


530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
 */

static void
UpdateCursor(winPtr)
    TkWindow *winPtr;
{
    Cursor cursor = None;



    /*
     * A window inherits its cursor from its parent if it doesn't
     * have one of its own.  Top level windows inherit the default
     * cursor.
     */

    cursorWinPtr = winPtr;
    while (winPtr != NULL) {
	if (winPtr->atts.cursor != None) {
	    cursor = winPtr->atts.cursor;
	    break;
	} else if (winPtr->flags & TK_TOP_LEVEL) {
	    break;
	}







>
>







|







543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
 */

static void
UpdateCursor(winPtr)
    TkWindow *winPtr;
{
    Cursor cursor = None;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * A window inherits its cursor from its parent if it doesn't
     * have one of its own.  Top level windows inherit the default
     * cursor.
     */

    tsdPtr->cursorWinPtr = winPtr;
    while (winPtr != NULL) {
	if (winPtr->atts.cursor != None) {
	    cursor = winPtr->atts.cursor;
	    break;
	} else if (winPtr->flags & TK_TOP_LEVEL) {
	    break;
	}
569
570
571
572
573
574
575


576
577
578
579
580
581
582
583
584
void
XDefineCursor(display, w, cursor)
    Display* display;
    Window w;
    Cursor cursor;
{
    TkWindow *winPtr = (TkWindow *)Tk_IdToWindow(display, w);



    if (cursorWinPtr == winPtr) {
	UpdateCursor(winPtr);
    }
    display->request++;
}

/*
 *----------------------------------------------------------------------







>
>

|







591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
void
XDefineCursor(display, w, cursor)
    Display* display;
    Window w;
    Cursor cursor;
{
    TkWindow *winPtr = (TkWindow *)Tk_IdToWindow(display, w);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (tsdPtr->cursorWinPtr == winPtr) {
	UpdateCursor(winPtr);
    }
    display->request++;
}

/*
 *----------------------------------------------------------------------

Changes to generic/tkPort.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkPort.h --
 *
 *	This header file handles porting issues that occur because of
 *	differences between systems.  It reads in platform specific
 *	portability files.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkPort.h 1.7 96/02/11 16:42:10
 */

#ifndef _TKPORT
#define _TKPORT

#ifndef _TK
#include "tk.h"












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkPort.h --
 *
 *	This header file handles porting issues that occur because of
 *	differences between systems.  It reads in platform specific
 *	portability files.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkPort.h,v 1.1.4.1 1998/09/30 02:17:15 stanton Exp $
 */

#ifndef _TKPORT
#define _TKPORT

#ifndef _TK
#include "tk.h"

Changes to generic/tkRectOval.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkRectOval.c --
 *
 *	This file implements rectangle and oval items for canvas
 *	widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkRectOval.c 1.40 96/05/03 10:52:21
 */

#include <stdio.h>
#include "tk.h"
#include "tkInt.h"
#include "tkPort.h"








|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkRectOval.c --
 *
 *	This file implements rectangle and oval items for canvas
 *	widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkRectOval.c,v 1.1.4.2 1998/09/30 02:17:16 stanton Exp $
 */

#include <stdio.h>
#include "tk.h"
#include "tkInt.h"
#include "tkPort.h"

153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
 *
 *	This procedure is invoked to create a new rectangle
 *	or oval item in a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item, then an error message is left in
 *	interp->result;  in this case itemPtr is left uninitialized,
 *	so it can be safely freed by the caller.
 *
 * Side effects:
 *	A new rectangle or oval item is created.
 *
 *--------------------------------------------------------------
 */







|







153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
 *
 *	This procedure is invoked to create a new rectangle
 *	or oval item in a canvas.
 *
 * Results:
 *	A standard Tcl return value.  If an error occurred in
 *	creating the item, then an error message is left in
 *	the interp's result;  in this case itemPtr is left uninitialized,
 *	so it can be safely freed by the caller.
 *
 * Side effects:
 *	A new rectangle or oval item is created.
 *
 *--------------------------------------------------------------
 */
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
 * RectOvalCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on rectangles and ovals.  See the user documentation
 *	for details on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets interp->result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */








|







226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
 * RectOvalCoords --
 *
 *	This procedure is invoked to process the "coords" widget
 *	command on rectangles and ovals.  See the user documentation
 *	for details on what it does.
 *
 * Results:
 *	Returns TCL_OK or TCL_ERROR, and sets the interp's result.
 *
 * Side effects:
 *	The coordinates for the given item may be changed.
 *
 *--------------------------------------------------------------
 */

269
270
271
272
273
274
275

276
277
278

279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
			&rectOvalPtr->bbox[2]) != TCL_OK)
		|| (Tk_CanvasGetCoord(interp, canvas, argv[3],
			&rectOvalPtr->bbox[3]) != TCL_OK)) {
	    return TCL_ERROR;
	}
	ComputeRectOvalBbox(canvas, rectOvalPtr);
    } else {

	sprintf(interp->result,
		"wrong # coordinates: expected 0 or 4, got %d",
		argc);

	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ConfigureRectOval --
 *
 *	This procedure is invoked to configure various aspects
 *	of a rectangle or oval item, such as its border and
 *	background colors.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in interp->result.
 *
 * Side effects:
 *	Configuration information, such as colors and stipple
 *	patterns, may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */







>
|
|
<
>
















|







269
270
271
272
273
274
275
276
277
278

279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
			&rectOvalPtr->bbox[2]) != TCL_OK)
		|| (Tk_CanvasGetCoord(interp, canvas, argv[3],
			&rectOvalPtr->bbox[3]) != TCL_OK)) {
	    return TCL_ERROR;
	}
	ComputeRectOvalBbox(canvas, rectOvalPtr);
    } else {
	char buf[64 + TCL_INTEGER_SPACE];
	
	sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", argc);

	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ConfigureRectOval --
 *
 *	This procedure is invoked to configure various aspects
 *	of a rectangle or oval item, such as its border and
 *	background colors.
 *
 * Results:
 *	A standard Tcl result code.  If an error occurs, then
 *	an error message is left in the interp's result.
 *
 * Side effects:
 *	Configuration information, such as colors and stipple
 *	patterns, may be set for itemPtr.
 *
 *--------------------------------------------------------------
 */
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
 *
 *	This procedure is called to generate Postscript for
 *	rectangle and oval items.
 *
 * Results:
 *	The return value is a standard Tcl result.  If an error
 *	occurs in generating Postscript then an error message is
 *	left in interp->result, replacing whatever used to be there.
 *	If no error occurs, then Postscript for the rectangle is
 *	appended to the result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
RectOvalToPostscript(interp, canvas, itemPtr, prepass)
    Tcl_Interp *interp;			/* Interpreter for error reporting. */
    Tk_Canvas canvas;			/* Information about overall canvas. */
    Tk_Item *itemPtr;			/* Item for which Postscript is
					 * wanted. */
    int prepass;			/* 1 means this is a prepass to
					 * collect font information;  0 means
					 * final Postscript is being created. */
{
    char pathCmd[500], string[100];
    RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
    double y1, y2;

    y1 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[1]);
    y2 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[3]);

    /*







|



















|







939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
 *
 *	This procedure is called to generate Postscript for
 *	rectangle and oval items.
 *
 * Results:
 *	The return value is a standard Tcl result.  If an error
 *	occurs in generating Postscript then an error message is
 *	left in the interp's result, replacing whatever used to be there.
 *	If no error occurs, then Postscript for the rectangle is
 *	appended to the result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
RectOvalToPostscript(interp, canvas, itemPtr, prepass)
    Tcl_Interp *interp;			/* Interpreter for error reporting. */
    Tk_Canvas canvas;			/* Information about overall canvas. */
    Tk_Item *itemPtr;			/* Item for which Postscript is
					 * wanted. */
    int prepass;			/* 1 means this is a prepass to
					 * collect font information;  0 means
					 * final Postscript is being created. */
{
    char pathCmd[500];
    RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
    double y1, y2;

    y1 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[1]);
    y2 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[3]);

    /*
1012
1013
1014
1015
1016
1017
1018


1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
    }

    /*
     * Now draw the outline, if there is one.
     */

    if (rectOvalPtr->outlineColor != NULL) {


	Tcl_AppendResult(interp, pathCmd, (char *) NULL);
	sprintf(string, "%d setlinewidth", rectOvalPtr->width);
	Tcl_AppendResult(interp, string,
		" 0 setlinejoin 2 setlinecap\n", (char *) NULL);
	if (Tk_CanvasPsColor(interp, canvas, rectOvalPtr->outlineColor)
		!= TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
    }
    return TCL_OK;
}







>
>












1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
    }

    /*
     * Now draw the outline, if there is one.
     */

    if (rectOvalPtr->outlineColor != NULL) {
	char string[32 + TCL_INTEGER_SPACE];

	Tcl_AppendResult(interp, pathCmd, (char *) NULL);
	sprintf(string, "%d setlinewidth", rectOvalPtr->width);
	Tcl_AppendResult(interp, string,
		" 0 setlinejoin 2 setlinecap\n", (char *) NULL);
	if (Tk_CanvasPsColor(interp, canvas, rectOvalPtr->outlineColor)
		!= TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
    }
    return TCL_OK;
}

Changes to generic/tkScale.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28




29



30




31



32

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58



59






60

61

62
63
64
65
66
67
68
69
70
71

72
73

74
75
76
77
78
79
80
81
82

83
84
85
86

87
88

89
90

91
92

93
94

95
96
97
98
99

100
101
102
103
104

105
106
107
108
109
110
111
112
113
114

115
116
117
118















119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139

140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182

183
184




185






186






187


188
189
190
191

192
193
194


195
196
197
198
199
200
201
202
203
204
205
206
207
208

209
210
211
212
213
214
215
216
217
218

219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263

264
265
266
267

268
269




270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307





308
309
310
311
312

313
314
315
316
317
318
319
320
321
322
323
324
325

326






327


328


329



330
331
332
333
334



335
336

337
338
339
340
341
342
343

344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360



361
362

363
364
365
366
367
368
369
370
371
372

373
374
375
376
377
378
379




380
381
382
383
384
385
386
387
388
389
390
391
392
393


394


395


396
397



398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415

416
417
418
419
420
421
422
 *	
 *	The modifications to use floating-point values are based on
 *	an implementation by Paul Mackerras.  The -variable option
 *	is due to Henning Schulzrinne.  All of these are used with
 *	permission.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkScale.c 1.88 97/07/31 09:11:57
 */

#include "tkPort.h"
#include "default.h"
#include "tkInt.h"
#include "tclMath.h"
#include "tkScale.h"





static Tk_ConfigSpec configSpecs[] = {



    {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",




	DEF_SCALE_ACTIVE_BG_COLOR, Tk_Offset(TkScale, activeBorder),



	TK_CONFIG_COLOR_ONLY},

    {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
	DEF_SCALE_ACTIVE_BG_MONO, Tk_Offset(TkScale, activeBorder),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_BORDER, "-background", "background", "Background",
	DEF_SCALE_BG_COLOR, Tk_Offset(TkScale, bgBorder),
	TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_BORDER, "-background", "background", "Background",
	DEF_SCALE_BG_MONO, Tk_Offset(TkScale, bgBorder),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_DOUBLE, "-bigincrement", "bigIncrement", "BigIncrement",
	DEF_SCALE_BIG_INCREMENT, Tk_Offset(TkScale, bigIncrement), 0},
    {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	DEF_SCALE_BORDER_WIDTH, Tk_Offset(TkScale, borderWidth), 0},
    {TK_CONFIG_STRING, "-command", "command", "Command",
	DEF_SCALE_COMMAND, Tk_Offset(TkScale, command), TK_CONFIG_NULL_OK},
    {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
	DEF_SCALE_CURSOR, Tk_Offset(TkScale, cursor), TK_CONFIG_NULL_OK},
    {TK_CONFIG_INT, "-digits", "digits", "Digits",
	DEF_SCALE_DIGITS, Tk_Offset(TkScale, digits), 0},
    {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_FONT, "-font", "font", "Font",



	DEF_SCALE_FONT, Tk_Offset(TkScale, tkfont),






	0},

    {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",

	DEF_SCALE_FG_COLOR, Tk_Offset(TkScale, textColorPtr),
	TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
	DEF_SCALE_FG_MONO, Tk_Offset(TkScale, textColorPtr),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_DOUBLE, "-from", "from", "From",
	DEF_SCALE_FROM, Tk_Offset(TkScale, fromValue), 0},
    {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
	"HighlightBackground", DEF_SCALE_HIGHLIGHT_BG,
	Tk_Offset(TkScale, highlightBgColorPtr), 0},

    {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
	DEF_SCALE_HIGHLIGHT, Tk_Offset(TkScale, highlightColorPtr), 0},

    {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
	"HighlightThickness",
	DEF_SCALE_HIGHLIGHT_WIDTH, Tk_Offset(TkScale, highlightWidth), 0},
    {TK_CONFIG_STRING, "-label", "label", "Label",
	DEF_SCALE_LABEL, Tk_Offset(TkScale, label), TK_CONFIG_NULL_OK},
    {TK_CONFIG_PIXELS, "-length", "length", "Length",
	DEF_SCALE_LENGTH, Tk_Offset(TkScale, length), 0},
    {TK_CONFIG_UID, "-orient", "orient", "Orient",
	DEF_SCALE_ORIENT, Tk_Offset(TkScale, orientUid), 0},

    {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
	DEF_SCALE_RELIEF, Tk_Offset(TkScale, relief), 0},
    {TK_CONFIG_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
	DEF_SCALE_REPEAT_DELAY, Tk_Offset(TkScale, repeatDelay), 0},

    {TK_CONFIG_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
	DEF_SCALE_REPEAT_INTERVAL, Tk_Offset(TkScale, repeatInterval), 0},

    {TK_CONFIG_DOUBLE, "-resolution", "resolution", "Resolution",
	DEF_SCALE_RESOLUTION, Tk_Offset(TkScale, resolution), 0},

    {TK_CONFIG_BOOLEAN, "-showvalue", "showValue", "ShowValue",
	DEF_SCALE_SHOW_VALUE, Tk_Offset(TkScale, showValue), 0},

    {TK_CONFIG_PIXELS, "-sliderlength", "sliderLength", "SliderLength",
	DEF_SCALE_SLIDER_LENGTH, Tk_Offset(TkScale, sliderLength), 0},

    {TK_CONFIG_RELIEF, "-sliderrelief", "sliderRelief", "SliderRelief",
	DEF_SCALE_SLIDER_RELIEF, Tk_Offset(TkScale, sliderRelief),
	TK_CONFIG_DONT_SET_DEFAULT},
    {TK_CONFIG_UID, "-state", "state", "State",
	DEF_SCALE_STATE, Tk_Offset(TkScale, state), 0},

    {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
	DEF_SCALE_TAKE_FOCUS, Tk_Offset(TkScale, takeFocus),
	TK_CONFIG_NULL_OK},
    {TK_CONFIG_DOUBLE, "-tickinterval", "tickInterval", "TickInterval",
	DEF_SCALE_TICK_INTERVAL, Tk_Offset(TkScale, tickInterval), 0},

    {TK_CONFIG_DOUBLE, "-to", "to", "To",
	DEF_SCALE_TO, Tk_Offset(TkScale, toValue), 0},
    {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
	DEF_SCALE_TROUGH_COLOR, Tk_Offset(TkScale, troughColorPtr),
	TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
	DEF_SCALE_TROUGH_MONO, Tk_Offset(TkScale, troughColorPtr),
	TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_STRING, "-variable", "variable", "Variable",
	DEF_SCALE_VARIABLE, Tk_Offset(TkScale, varName), TK_CONFIG_NULL_OK},

    {TK_CONFIG_PIXELS, "-width", "width", "Width",
	DEF_SCALE_WIDTH, Tk_Offset(TkScale, width), 0},
    {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, 0}















};

/*
 * Forward declarations for procedures defined later in this file:
 */

static void		ComputeFormat _ANSI_ARGS_((TkScale *scalePtr));
static void		ComputeScaleGeometry _ANSI_ARGS_((TkScale *scalePtr));
static int		ConfigureScale _ANSI_ARGS_((Tcl_Interp *interp,
			    TkScale *scalePtr, int argc, char **argv,
			    int flags));
static void		DestroyScale _ANSI_ARGS_((char *memPtr));
static void		ScaleCmdDeletedProc _ANSI_ARGS_((
			    ClientData clientData));
static void		ScaleEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static char *		ScaleVarProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, char *name1, char *name2,
			    int flags));
static int		ScaleWidgetCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));

static void		ScaleWorldChanged _ANSI_ARGS_((
			    ClientData instanceData));

/*
 * The structure below defines scale class behavior by means of procedures
 * that can be invoked from generic window code.
 */

static TkClassProcs scaleClass = {
    NULL,			/* createProc. */
    ScaleWorldChanged,		/* geometryProc. */
    NULL			/* modalProc. */
};


/*
 *--------------------------------------------------------------
 *
 * Tk_ScaleCmd --
 *
 *	This procedure is invoked to process the "scale" Tcl
 *	command.  See the user documentation for details on what
 *	it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_ScaleCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    Tk_Window tkwin = (Tk_Window) clientData;
    register TkScale *scalePtr;

    Tk_Window new;





    if (argc < 2) {






	Tcl_AppendResult(interp, "wrong # args: should be \"",






		argv[0], " pathName ?options?\"", (char *) NULL);


	return TCL_ERROR;
    }

    new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);

    if (new == NULL) {
	return TCL_ERROR;
    }


    scalePtr = TkpCreateScale(new);

    /*
     * Initialize fields that won't be initialized by ConfigureScale,
     * or which ConfigureScale expects to have reasonable values
     * (e.g. resource pointers).
     */

    scalePtr->tkwin = new;
    scalePtr->display = Tk_Display(new);
    scalePtr->interp = interp;
    scalePtr->widgetCmd = Tcl_CreateCommand(interp,
	    Tk_PathName(scalePtr->tkwin), ScaleWidgetCmd,
	    (ClientData) scalePtr, ScaleCmdDeletedProc);

    scalePtr->orientUid = NULL;
    scalePtr->vertical = 0;
    scalePtr->width = 0;
    scalePtr->length = 0;
    scalePtr->value = 0;
    scalePtr->varName = NULL;
    scalePtr->fromValue = 0;
    scalePtr->toValue = 0;
    scalePtr->tickInterval = 0;
    scalePtr->resolution = 1;

    scalePtr->bigIncrement = 0.0;
    scalePtr->command = NULL;
    scalePtr->repeatDelay = 0;
    scalePtr->repeatInterval = 0;
    scalePtr->label = NULL;
    scalePtr->labelLength = 0;
    scalePtr->state = tkNormalUid;
    scalePtr->borderWidth = 0;
    scalePtr->bgBorder = NULL;
    scalePtr->activeBorder = NULL;
    scalePtr->sliderRelief = TK_RELIEF_RAISED;
    scalePtr->troughColorPtr = NULL;
    scalePtr->troughGC = None;
    scalePtr->copyGC = None;
    scalePtr->tkfont = NULL;
    scalePtr->textColorPtr = NULL;
    scalePtr->textGC = None;
    scalePtr->relief = TK_RELIEF_FLAT;
    scalePtr->highlightWidth = 0;
    scalePtr->highlightBgColorPtr = NULL;
    scalePtr->highlightColorPtr = NULL;
    scalePtr->inset = 0;
    scalePtr->sliderLength = 0;
    scalePtr->showValue = 0;
    scalePtr->horizLabelY = 0;
    scalePtr->horizValueY = 0;
    scalePtr->horizTroughY = 0;
    scalePtr->horizTickY = 0;
    scalePtr->vertTickRightX = 0;
    scalePtr->vertValueRightX = 0;
    scalePtr->vertTroughX = 0;
    scalePtr->vertLabelX = 0;
    scalePtr->cursor = None;
    scalePtr->takeFocus = NULL;
    scalePtr->flags = NEVER_SET;

    Tk_SetClass(scalePtr->tkwin, "Scale");
    TkSetClassProcs(scalePtr->tkwin, &scaleClass, (ClientData) scalePtr);
    Tk_CreateEventHandler(scalePtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    ScaleEventProc, (ClientData) scalePtr);
    if (ConfigureScale(interp, scalePtr, argc-2, argv+2, 0) != TCL_OK) {
	goto error;
    }


    interp->result = Tk_PathName(scalePtr->tkwin);
    return TCL_OK;

    error:

    Tk_DestroyWindow(scalePtr->tkwin);
    return TCL_ERROR;




}

/*
 *--------------------------------------------------------------
 *
 * ScaleWidgetCmd --
 *
 *	This procedure is invoked to process the Tcl command
 *	that corresponds to a widget managed by this module.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
ScaleWidgetCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Information about scale
					 * widget. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    register TkScale *scalePtr = (TkScale *) clientData;
    int result = TCL_OK;
    size_t length;
    int c;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option ?arg arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }





    Tcl_Preserve((ClientData) scalePtr);
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
	    && (length >= 2)) {

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " cget option\"",
		    (char *) NULL);
	    goto error;
	}
	result = Tk_ConfigureValue(interp, scalePtr->tkwin, configSpecs,
		(char *) scalePtr, argv[2], 0);
    } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
	    && (length >= 3)) {
	if (argc == 2) {
	    result = Tk_ConfigureInfo(interp, scalePtr->tkwin, configSpecs,
		    (char *) scalePtr, (char *) NULL, 0);

	} else if (argc == 3) {






	    result = Tk_ConfigureInfo(interp, scalePtr->tkwin, configSpecs,


		    (char *) scalePtr, argv[2], 0);


	} else {



	    result = ConfigureScale(interp, scalePtr, argc-2, argv+2,
		    TK_CONFIG_ARGV_ONLY);
	}
    } else if ((c == 'c') && (strncmp(argv[1], "coords", length) == 0)
	    && (length >= 3)) {



	int x, y ;
	double value;


	if ((argc != 2) && (argc != 3)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " coords ?value?\"", (char *) NULL);
	    goto error;
	}
	if (argc == 3) {

	    if (Tcl_GetDouble(interp, argv[2], &value) != TCL_OK) {
		goto error;
	    }
	} else {
	    value = scalePtr->value;
	}
	if (scalePtr->vertical) {
	    x = scalePtr->vertTroughX + scalePtr->width/2
		    + scalePtr->borderWidth;
	    y = TkpValueToPixel(scalePtr, value);
	} else {
	    x = TkpValueToPixel(scalePtr, value);
	    y = scalePtr->horizTroughY + scalePtr->width/2
		    + scalePtr->borderWidth;
	}
	sprintf(interp->result, "%d %d", x, y);
    } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {



	double value;
	int x, y;


	if ((argc != 2) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " get ?x y?\"", (char *) NULL);
	    goto error;
	}
	if (argc == 2) {
	    value = scalePtr->value;
	} else {
	    if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)

		    || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
		goto error;
	    }
	    value = TkpPixelToValue(scalePtr, x, y);
	}
	sprintf(interp->result, scalePtr->format, value);
    } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) {




	int x, y, thing;

	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " identify x y\"", (char *) NULL);
	    goto error;
	}
	if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
	    goto error;
	}
	thing = TkpScaleElement(scalePtr, x,y);
	switch (thing) {
	    case TROUGH1:	interp->result = "trough1";	break;


	    case SLIDER:	interp->result = "slider";	break;


	    case TROUGH2:	interp->result = "trough2";	break;


	}
    } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) {



	double value;

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " set value\"", (char *) NULL);
	    goto error;
	}
	if (Tcl_GetDouble(interp, argv[2], &value) != TCL_OK) {
	    goto error;
	}
	if (scalePtr->state != tkDisabledUid) {
	    TkpSetScaleValue(scalePtr, value, 1, 1);
	}
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be cget, configure, coords, get, identify, or set",
		(char *) NULL);
	goto error;

    }
    Tcl_Release((ClientData) scalePtr);
    return result;

    error:
    Tcl_Release((ClientData) scalePtr);
    return TCL_ERROR;







|




|








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









|
|








|
|
>


















|















|
|
<

|
|

<

>
|

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



|
>
|


>
>
|







|
|

|
|

>
|
<


|
|
|
|
|

>

|


|

|












|













|


<




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





|















|



|
|

|
|
<
|

|
<
|


>
>
>
>
>

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

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

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

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

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







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52


53

54
55

56
57
58








59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131


132

133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212

213
214
215
216

217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267

268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312

313
314
315
316


317
318
319
320
321
322

323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359

360
361
362

363
364
365
366
367
368
369
370
371
372


373
374
375
376


377
378

379



380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400

401


402
403
404
405
406
407
408
409

410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440

441
442
443
444
445
446
447
448
449
450
451
452
453

454
455
456
457
458
459
460

461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479

480
481
482
483
484
485
486

487
488
489
490
491
492
493
494
495




496
497
498
499
500
501
502
503
 *	
 *	The modifications to use floating-point values are based on
 *	an implementation by Paul Mackerras.  The -variable option
 *	is due to Henning Schulzrinne.  All of these are used with
 *	permission.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkScale.c,v 1.1.4.8 1999/03/30 23:56:57 stanton Exp $
 */

#include "tkPort.h"
#include "default.h"
#include "tkInt.h"
#include "tclMath.h"
#include "tkScale.h"

/*
 * The following table defines the legal values for the -orient option.
 * It is used together with the "enum orient" declaration in tkScale.h.
 */

static char *orientStrings[] = {
    "horizontal", "vertical", (char *) NULL
};

/*
 * The following table defines the legal values for the -state option.
 * It is used together with the "enum state" declaration in tkScale.h.
 */

static char *stateStrings[] = {
    "active", "disabled", "normal", (char *) NULL
};

static Tk_OptionSpec optionSpecs[] = {
    {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
	DEF_SCALE_ACTIVE_BG_COLOR, -1, Tk_Offset(TkScale, activeBorder),
	0, (ClientData) DEF_SCALE_ACTIVE_BG_MONO, 0},
    {TK_OPTION_BORDER, "-background", "background", "Background",
	DEF_SCALE_BG_COLOR, -1, Tk_Offset(TkScale, bgBorder),


	0, (ClientData) DEF_SCALE_BG_MONO, 0},

    {TK_OPTION_DOUBLE, "-bigincrement", "bigIncrement", "BigIncrement",
        DEF_SCALE_BIG_INCREMENT, -1, Tk_Offset(TkScale, bigIncrement), 

        0, 0, 0},
    {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},








    {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	DEF_SCALE_BORDER_WIDTH, -1, Tk_Offset(TkScale, borderWidth), 
        0, 0, 0},
    {TK_OPTION_STRING, "-command", "command", "Command",
	DEF_SCALE_COMMAND, Tk_Offset(TkScale, commandPtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
	DEF_SCALE_CURSOR, -1, Tk_Offset(TkScale, cursor),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_INT, "-digits", "digits", "Digits", 
	DEF_SCALE_DIGITS, -1, Tk_Offset(TkScale, digits), 
        0, 0, 0},
    {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
	(char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
    {TK_OPTION_FONT, "-font", "font", "Font",
	DEF_SCALE_FONT, -1, Tk_Offset(TkScale, tkfont), 0, 0, 0},

    {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
	DEF_SCALE_FG_COLOR, -1, Tk_Offset(TkScale, textColorPtr), 0, 
        (ClientData) DEF_SCALE_FG_MONO, 0},
    {TK_OPTION_DOUBLE, "-from", "from", "From", DEF_SCALE_FROM, -1, 
        Tk_Offset(TkScale, fromValue), 0, 0, 0},
    {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
	"HighlightBackground", DEF_SCALE_HIGHLIGHT_BG_COLOR,
	-1, Tk_Offset(TkScale, highlightBorder), 
        0, (ClientData) DEF_SCALE_HIGHLIGHT_BG_MONO, 0},
    {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
	DEF_SCALE_HIGHLIGHT, -1, Tk_Offset(TkScale, highlightColorPtr),
	0, 0, 0},
    {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
	"HighlightThickness", DEF_SCALE_HIGHLIGHT_WIDTH, -1, 
	Tk_Offset(TkScale, highlightWidth), 0, 0, 0},
    {TK_OPTION_STRING, "-label", "label", "Label",
	DEF_SCALE_LABEL, Tk_Offset(TkScale, labelPtr), -1, 0, 0, 0},
    {TK_OPTION_PIXELS, "-length", "length", "Length",
	DEF_SCALE_LENGTH, -1, Tk_Offset(TkScale, length), 0, 0, 0},
    {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient",
        DEF_SCALE_ORIENT, -1, Tk_Offset(TkScale, orient), 
        0, (ClientData) orientStrings, 0},
    {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
	DEF_SCALE_RELIEF, -1, Tk_Offset(TkScale, relief), 0, 0, 0},
    {TK_OPTION_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
        DEF_SCALE_REPEAT_DELAY, -1, Tk_Offset(TkScale, repeatDelay),
        0, 0, 0},
    {TK_OPTION_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
        DEF_SCALE_REPEAT_INTERVAL, -1, Tk_Offset(TkScale, repeatInterval),
        0, 0, 0},
    {TK_OPTION_DOUBLE, "-resolution", "resolution", "Resolution",
        DEF_SCALE_RESOLUTION, -1, Tk_Offset(TkScale, resolution),
        0, 0, 0},
    {TK_OPTION_BOOLEAN, "-showvalue", "showValue", "ShowValue",
        DEF_SCALE_SHOW_VALUE, -1, Tk_Offset(TkScale, showValue),
        0, 0, 0},
    {TK_OPTION_PIXELS, "-sliderlength", "sliderLength", "SliderLength",
        DEF_SCALE_SLIDER_LENGTH, -1, Tk_Offset(TkScale, sliderLength),
        0, 0, 0},
    {TK_OPTION_RELIEF, "-sliderrelief", "sliderRelief", "SliderRelief",
	DEF_SCALE_SLIDER_RELIEF, -1, Tk_Offset(TkScale, sliderRelief), 
        0, 0, 0},
    {TK_OPTION_STRING_TABLE, "-state", "state", "State",
        DEF_SCALE_STATE, -1, Tk_Offset(TkScale, state), 
        0, (ClientData) stateStrings, 0},
    {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
	DEF_SCALE_TAKE_FOCUS, Tk_Offset(TkScale, takeFocusPtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_DOUBLE, "-tickinterval", "tickInterval", "TickInterval",
        DEF_SCALE_TICK_INTERVAL, -1, Tk_Offset(TkScale, tickInterval),
        0, 0, 0},
    {TK_OPTION_DOUBLE, "-to", "to", "To",
        DEF_SCALE_TO, -1, Tk_Offset(TkScale, toValue), 0, 0, 0},
    {TK_OPTION_COLOR, "-troughcolor", "troughColor", "Background",
        DEF_SCALE_TROUGH_COLOR, -1, Tk_Offset(TkScale, troughColorPtr),


        0, (ClientData) DEF_SCALE_TROUGH_MONO, 0},

    {TK_OPTION_STRING, "-variable", "variable", "Variable",
	DEF_SCALE_VARIABLE, Tk_Offset(TkScale, varNamePtr), -1,
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_PIXELS, "-width", "width", "Width",
	DEF_SCALE_WIDTH, -1, Tk_Offset(TkScale, width), 0, 0, 0},
    {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, -1, 0, 0, 0}
};

/*
 * The following tables define the scale widget commands and map the 
 * indexes into the string tables into a single enumerated type used 
 * to dispatch the scale widget command.
 */

static char *commandNames[] = {
    "cget", "configure", "coords", "get", "identify", "set", (char *) NULL
};

enum command {
    COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_COORDS, COMMAND_GET,
    COMMAND_IDENTIFY, COMMAND_SET
};

/*
 * Forward declarations for procedures defined later in this file:
 */

static void		ComputeFormat _ANSI_ARGS_((TkScale *scalePtr));
static void		ComputeScaleGeometry _ANSI_ARGS_((TkScale *scalePtr));
static int		ConfigureScale _ANSI_ARGS_((Tcl_Interp *interp,
			    TkScale *scalePtr, int objc,
			    Tcl_Obj *CONST objv[]));
static void		DestroyScale _ANSI_ARGS_((char *memPtr));
static void		ScaleCmdDeletedProc _ANSI_ARGS_((
			    ClientData clientData));
static void		ScaleEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static char *		ScaleVarProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, char *name1, char *name2,
			    int flags));
static int		ScaleWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
static void		ScaleWorldChanged _ANSI_ARGS_((
			    ClientData instanceData));

/*
 * The structure below defines scale class behavior by means of procedures
 * that can be invoked from generic window code.
 */

static TkClassProcs scaleClass = {
    NULL,			/* createProc. */
    ScaleWorldChanged,		/* geometryProc. */
    NULL			/* modalProc. */
};


/*
 *--------------------------------------------------------------
 *
 * Tk_ScaleObjCmd --
 *
 *	This procedure is invoked to process the "scale" Tcl
 *	command.  See the user documentation for details on what
 *	it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_ScaleObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Either NULL or pointer to option table. */

    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument values. */
{

    register TkScale *scalePtr;
    Tk_OptionTable optionTable;
    Tk_Window tkwin;

    optionTable = (Tk_OptionTable) clientData;
    if (optionTable == NULL) {
	Tcl_CmdInfo info;
	char *name;

	/*
	 * We haven't created the option table for this widget class
	 * yet.  Do it now and save the table as the clientData for
	 * the command, so we'll have access to it in future
	 * invocations of the command.
	 */

	optionTable = Tk_CreateOptionTable(interp, optionSpecs);
	name = Tcl_GetString(objv[0]);
	Tcl_GetCommandInfo(interp, name, &info);
	info.objClientData = (ClientData) optionTable;
	Tcl_SetCommandInfo(interp, name, &info);
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
	return TCL_ERROR;
    }

    tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
            Tcl_GetString(objv[1]), (char *) NULL);
    if (tkwin == NULL) {
	return TCL_ERROR;
    }

    Tk_SetClass(tkwin, "Scale");
    scalePtr = TkpCreateScale(tkwin);

    /*
     * Initialize fields that won't be initialized by ConfigureScale,
     * or which ConfigureScale expects to have reasonable values
     * (e.g. resource pointers).
     */

    scalePtr->tkwin = tkwin;
    scalePtr->display = Tk_Display(tkwin);
    scalePtr->interp = interp;
    scalePtr->widgetCmd = Tcl_CreateObjCommand(interp,
	    Tk_PathName(scalePtr->tkwin), ScaleWidgetObjCmd,
	    (ClientData) scalePtr, ScaleCmdDeletedProc);
    scalePtr->optionTable = optionTable;
    scalePtr->orient = ORIENT_VERTICAL;

    scalePtr->width = 0;
    scalePtr->length = 0;
    scalePtr->value = 0.0;
    scalePtr->varNamePtr = NULL;
    scalePtr->fromValue = 0.0;
    scalePtr->toValue = 0.0;
    scalePtr->tickInterval = 0.0;
    scalePtr->resolution = 1;
    scalePtr->digits = 0;
    scalePtr->bigIncrement = 0.0;
    scalePtr->commandPtr = NULL;
    scalePtr->repeatDelay = 0;
    scalePtr->repeatInterval = 0;
    scalePtr->labelPtr = NULL;
    scalePtr->labelLength = 0;
    scalePtr->state = STATE_NORMAL;
    scalePtr->borderWidth = 0;
    scalePtr->bgBorder = NULL;
    scalePtr->activeBorder = NULL;
    scalePtr->sliderRelief = TK_RELIEF_RAISED;
    scalePtr->troughColorPtr = NULL;
    scalePtr->troughGC = None;
    scalePtr->copyGC = None;
    scalePtr->tkfont = NULL;
    scalePtr->textColorPtr = NULL;
    scalePtr->textGC = None;
    scalePtr->relief = TK_RELIEF_FLAT;
    scalePtr->highlightWidth = 0;
    scalePtr->highlightBorder = NULL;
    scalePtr->highlightColorPtr = NULL;
    scalePtr->inset = 0;
    scalePtr->sliderLength = 0;
    scalePtr->showValue = 0;
    scalePtr->horizLabelY = 0;
    scalePtr->horizValueY = 0;
    scalePtr->horizTroughY = 0;
    scalePtr->horizTickY = 0;
    scalePtr->vertTickRightX = 0;
    scalePtr->vertValueRightX = 0;
    scalePtr->vertTroughX = 0;
    scalePtr->vertLabelX = 0;
    scalePtr->cursor = None;
    scalePtr->takeFocusPtr = NULL;
    scalePtr->flags = NEVER_SET;


    TkSetClassProcs(scalePtr->tkwin, &scaleClass, (ClientData) scalePtr);
    Tk_CreateEventHandler(scalePtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    ScaleEventProc, (ClientData) scalePtr);



    if (Tk_InitOptions(interp, (char *) scalePtr, optionTable, tkwin)
	    != TCL_OK) {
	Tk_DestroyWindow(scalePtr->tkwin);
	return TCL_ERROR;
    }

    if (ConfigureScale(interp, scalePtr, objc - 2, objv + 2) != TCL_OK) {
	Tk_DestroyWindow(scalePtr->tkwin);
	return TCL_ERROR;
    }
    Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(scalePtr->tkwin),
	    -1);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ScaleWidgetObjCmd --
 *
 *	This procedure is invoked to process the Tcl command
 *	that corresponds to a widget managed by this module.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
ScaleWidgetObjCmd(clientData, interp, objc, objv)
    ClientData clientData;		/* Information about scale
					 * widget. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj *CONST objv[];		/* Argument strings. */
{
    TkScale *scalePtr = (TkScale *) clientData;
    Tcl_Obj *objPtr;

    int index, result;

    if (objc < 2) {

        Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
	return TCL_ERROR;
    }
    result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
            "option", 0, &index);
    if (result != TCL_OK) {
	return result;
    }
    Tcl_Preserve((ClientData) scalePtr);



    switch (index) {
        case COMMAND_CGET: {
  	    if (objc != 3) {
	        Tcl_WrongNumArgs(interp, 1, objv, "cget option");


		goto error;
	    }

	    objPtr = Tk_GetOptionValue(interp, (char *) scalePtr,



		    scalePtr->optionTable, objv[2], scalePtr->tkwin);
	    if (objPtr == NULL) {
		 goto error;
	    } else {
		Tcl_SetObjResult(interp, objPtr);
	    }
	    break;
	}
        case COMMAND_CONFIGURE: {
	    if (objc <= 3) {
		objPtr = Tk_GetOptionInfo(interp, (char *) scalePtr,
			scalePtr->optionTable,
			(objc == 3) ? objv[2] : (Tcl_Obj *) NULL,
			scalePtr->tkwin);
		if (objPtr == NULL) {
		    goto error;
		} else {
		    Tcl_SetObjResult(interp, objPtr);
		}
	    } else {
		result = ConfigureScale(interp, scalePtr, objc-2, objv+2);

	    }


	    break;
	}
        case COMMAND_COORDS: {
	    int x, y ;
	    double value;
	    char buf[TCL_INTEGER_SPACE * 2];

	    if ((objc != 2) && (objc != 3)) {

	        Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?");
		goto error;
	    }
	    if (objc == 3) {
	        if (Tcl_GetDoubleFromObj(interp, objv[2], &value) 
                        != TCL_OK) {
		    goto error;
		}
	    } else {
	        value = scalePtr->value;
	    }
	    if (scalePtr->orient == ORIENT_VERTICAL) {
	        x = scalePtr->vertTroughX + scalePtr->width/2
		        + scalePtr->borderWidth;
		y = TkpValueToPixel(scalePtr, value);
	    } else {
	        x = TkpValueToPixel(scalePtr, value);
		y = scalePtr->horizTroughY + scalePtr->width/2
                        + scalePtr->borderWidth;
	    }
	    sprintf(buf, "%d %d", x, y);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
            break;
        }
        case COMMAND_GET: {
	    double value;
	    int x, y;
	    char buf[TCL_DOUBLE_SPACE];

	    if ((objc != 2) && (objc != 4)) {
	        Tcl_WrongNumArgs(interp, 1, objv, "get ?x y?");

		goto error;
	    }
	    if (objc == 2) {
	        value = scalePtr->value;
	    } else {
	        if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
		        || (Tcl_GetIntFromObj(interp, objv[3], &y) 
                        != TCL_OK)) {
		    goto error;
		}
		value = TkpPixelToValue(scalePtr, x, y);
	    }
	    sprintf(buf, scalePtr->format, value);

	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
            break;
        }
        case COMMAND_IDENTIFY: {
	    int x, y, thing;

	    if (objc != 4) {

	        Tcl_WrongNumArgs(interp, 1, objv, "identify x y");
		goto error;
	    }
	    if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
                    || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
	        goto error;
	    }
	    thing = TkpScaleElement(scalePtr, x,y);
	    switch (thing) {
	        case TROUGH1:
		    Tcl_SetResult(interp, "trough1", TCL_STATIC);
		    break;
	        case SLIDER:
		    Tcl_SetResult(interp, "slider", TCL_STATIC);
		    break;
	        case TROUGH2:
		    Tcl_SetResult(interp, "trough2", TCL_STATIC);
		    break;
	    }

            break;
        }
        case COMMAND_SET: {
	    double value;

	    if (objc != 3) {
	        Tcl_WrongNumArgs(interp, 1, objv, "set value");

		goto error;
	    }
	    if (Tcl_GetDoubleFromObj(interp, objv[2], &value) != TCL_OK) {
	        goto error;
	    }
	    if ((scalePtr->state != STATE_DISABLED)) {
	      TkpSetScaleValue(scalePtr, value, 1, 1);
	    }
	    break;




        } 
    }
    Tcl_Release((ClientData) scalePtr);
    return result;

    error:
    Tcl_Release((ClientData) scalePtr);
    return TCL_ERROR;
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469

470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502


503

504
505
506
507
508
509
510
511
512
513
514





515
516

517

518
519
520
521
522
523
524
525










526
527
528

529
530

531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558

559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583

584
585
586
587
588
589
590
591
592
593

594
595
596


597
598



599
600


601
602
603
604
605





606

607
608
609
610
611
612
613

    /*
     * Free up all the stuff that requires special handling, then
     * let Tk_FreeOptions handle all the standard option-related
     * stuff.
     */

    if (scalePtr->varName != NULL) {
	Tcl_UntraceVar(scalePtr->interp, scalePtr->varName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ScaleVarProc, (ClientData) scalePtr);
    }
    if (scalePtr->troughGC != None) {
	Tk_FreeGC(scalePtr->display, scalePtr->troughGC);
    }
    if (scalePtr->copyGC != None) {
	Tk_FreeGC(scalePtr->display, scalePtr->copyGC);
    }
    if (scalePtr->textGC != None) {
	Tk_FreeGC(scalePtr->display, scalePtr->textGC);
    }
    Tk_FreeOptions(configSpecs, (char *) scalePtr, scalePtr->display, 0);

    TkpDestroyScale(scalePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureScale --
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a scale widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, border width,
 *	etc. get set for scalePtr;  old resources get freed,
 *	if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureScale(interp, scalePtr, argc, argv, flags)
    Tcl_Interp *interp;		/* Used for error reporting. */
    register TkScale *scalePtr;	/* Information about widget;  may or may
				 * not already have values for some fields. */
    int argc;			/* Number of valid entries in argv. */
    char **argv;		/* Arguments. */
    int flags;			/* Flags to pass to Tk_ConfigureWidget. */
{


    size_t length;


    /*
     * Eliminate any existing trace on a variable monitored by the scale.
     */

    if (scalePtr->varName != NULL) {
	Tcl_UntraceVar(interp, scalePtr->varName, 
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ScaleVarProc, (ClientData) scalePtr);
    }






    if (Tk_ConfigureWidget(interp, scalePtr->tkwin, configSpecs,
	    argc, argv, (char *) scalePtr, flags) != TCL_OK) {

	return TCL_ERROR;

    }

    /*
     * If the scale is tied to the value of a variable, then set up
     * a trace on the variable's value and set the scale's value from
     * the value of the variable, if it exists.
     */











    if (scalePtr->varName != NULL) {
	char *stringValue, *end;
	double value;


	stringValue = Tcl_GetVar(interp, scalePtr->varName, TCL_GLOBAL_ONLY);

	if (stringValue != NULL) {
	    value = strtod(stringValue, &end);
	    if ((end != stringValue) && (*end == 0)) {
		scalePtr->value = TkRoundToResolution(scalePtr, value);
	    }
	}
	Tcl_TraceVar(interp, scalePtr->varName,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ScaleVarProc, (ClientData) scalePtr);
    }

    /*
     * Several options need special processing, such as parsing the
     * orientation and creating GCs.
     */

    length = strlen(scalePtr->orientUid);
    if (strncmp(scalePtr->orientUid, "vertical", length) == 0) {
	scalePtr->vertical = 1;
    } else if (strncmp(scalePtr->orientUid, "horizontal", length) == 0) {
	scalePtr->vertical = 0;
    } else {
	Tcl_AppendResult(interp, "bad orientation \"", scalePtr->orientUid,
		"\": must be vertical or horizontal", (char *) NULL);
	return TCL_ERROR;
    }

    scalePtr->fromValue = TkRoundToResolution(scalePtr, scalePtr->fromValue);

    scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue);
    scalePtr->tickInterval = TkRoundToResolution(scalePtr,
	    scalePtr->tickInterval);

    /*
     * Make sure that the tick interval has the right sign so that
     * addition moves from fromValue to toValue.
     */

    if ((scalePtr->tickInterval < 0)
	    ^ ((scalePtr->toValue - scalePtr->fromValue) <  0)) {
	scalePtr->tickInterval = -scalePtr->tickInterval;
    }

    /*
     * Set the scale value to itself;  all this does is to make sure
     * that the scale's value is within the new acceptable range for
     * the scale and reflect the value in the associated variable,
     * if any.
     */

    ComputeFormat(scalePtr);
    TkpSetScaleValue(scalePtr, scalePtr->value, 1, 1);

    if (scalePtr->label != NULL) {

	scalePtr->labelLength = strlen(scalePtr->label);
    } else {
	scalePtr->labelLength = 0;
    }

    if ((scalePtr->state != tkNormalUid)
	    && (scalePtr->state != tkDisabledUid)
	    && (scalePtr->state != tkActiveUid)) {
	Tcl_AppendResult(interp, "bad state value \"", scalePtr->state,
		"\": must be normal, active, or disabled", (char *) NULL);

	scalePtr->state = tkNormalUid;
	return TCL_ERROR;
    }



    Tk_SetBackgroundFromBorder(scalePtr->tkwin, scalePtr->bgBorder);




    if (scalePtr->highlightWidth < 0) {


	scalePtr->highlightWidth = 0;
    }
    scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;

    ScaleWorldChanged((ClientData) scalePtr);





    return TCL_OK;

}

/*
 *---------------------------------------------------------------------------
 *
 * ScaleWorldChanged --
 *







|
|












|
>














|










|



|
|
<

>
>
|
>





|
|




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

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

|
>
|
<
<
|

<
|
<
<
|

|
|
|
|

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

|
|
|
|

|
|
|
|

|
|
|
|
|
|

|
|

|
>
|
|
|
|

|
|
|
|
<
>
|
|

>
>
|
|
>
>
>

|
>
>
|

<


>
>
>
>
>
|
>







529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582

583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611


612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632


633
634

635


636
637
638
639
640
641
642











643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679

680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696

697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712

    /*
     * Free up all the stuff that requires special handling, then
     * let Tk_FreeOptions handle all the standard option-related
     * stuff.
     */

    if (scalePtr->varNamePtr != NULL) {
	Tcl_UntraceVar(scalePtr->interp, Tcl_GetString(scalePtr->varNamePtr),
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ScaleVarProc, (ClientData) scalePtr);
    }
    if (scalePtr->troughGC != None) {
	Tk_FreeGC(scalePtr->display, scalePtr->troughGC);
    }
    if (scalePtr->copyGC != None) {
	Tk_FreeGC(scalePtr->display, scalePtr->copyGC);
    }
    if (scalePtr->textGC != None) {
	Tk_FreeGC(scalePtr->display, scalePtr->textGC);
    }
    Tk_FreeConfigOptions((char *) scalePtr, scalePtr->optionTable,
	    scalePtr->tkwin);
    TkpDestroyScale(scalePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureScale --
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a scale widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, border width,
 *	etc. get set for scalePtr;  old resources get freed,
 *	if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureScale(interp, scalePtr, objc, objv)
    Tcl_Interp *interp;		/* Used for error reporting. */
    register TkScale *scalePtr;	/* Information about widget;  may or may
				 * not already have values for some fields. */
    int objc;			/* Number of valid entries in objv. */
    Tcl_Obj *CONST objv[];	/* Argument values. */

{
    Tk_SavedOptions savedOptions;
    Tcl_Obj *errorResult = NULL;
    int error;
    char *label;

    /*
     * Eliminate any existing trace on a variable monitored by the scale.
     */

    if (scalePtr->varNamePtr != NULL) {
	Tcl_UntraceVar(interp, Tcl_GetString(scalePtr->varNamePtr), 
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		ScaleVarProc, (ClientData) scalePtr);
    }

    for (error = 0; error <= 1; error++) {
	if (!error) {
	    /*
	     * First pass: set options to new values.
	     */

	    if (Tk_SetOptions(interp, (char *) scalePtr,
		    scalePtr->optionTable, objc, objv,
		    scalePtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
		continue;
	    }
	} else {
	    /*


	     * Second pass: restore options to old values.
	     */

	    errorResult = Tcl_GetObjResult(interp);
	    Tcl_IncrRefCount(errorResult);
	    Tk_RestoreSavedOptions(&savedOptions);
	}

	/*
	 * If the scale is tied to the value of a variable, then set 
	 * the scale's value from the value of the variable, if it exists.
	 */

	if (scalePtr->varNamePtr != NULL) {
	    char *name;
	    double value;
	    Tcl_Obj *valuePtr;

	    name = Tcl_GetString(scalePtr->varNamePtr);
	    valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
	    if (valuePtr != NULL) {


	        Tcl_GetDoubleFromObj(interp, valuePtr, &value);
	    }

	    scalePtr->value = TkRoundToResolution(scalePtr, value);


	}

	/*
	 * Several options need special processing, such as parsing the
	 * orientation and creating GCs.
	 */












	scalePtr->fromValue = TkRoundToResolution(scalePtr, 
                scalePtr->fromValue);
	scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue);
	scalePtr->tickInterval = TkRoundToResolution(scalePtr,
	        scalePtr->tickInterval);

	/*
	 * Make sure that the tick interval has the right sign so that
	 * addition moves from fromValue to toValue.
	 */

	if ((scalePtr->tickInterval < 0)
	    ^     ((scalePtr->toValue - scalePtr->fromValue) <  0)) {
	  scalePtr->tickInterval = -scalePtr->tickInterval;
	}

	/*
	 * Set the scale value to itself;  all this does is to make sure
	 * that the scale's value is within the new acceptable range for
	 * the scale and reflect the value in the associated variable,
	 * if any.
	 */

	ComputeFormat(scalePtr);
	TkpSetScaleValue(scalePtr, scalePtr->value, 1, 1);

	if (scalePtr->labelPtr != NULL) {
	    label = Tcl_GetString(scalePtr->labelPtr);
	    scalePtr->labelLength = strlen(label);
	} else {
	    scalePtr->labelLength = 0;
	}

	Tk_SetBackgroundFromBorder(scalePtr->tkwin, scalePtr->bgBorder);

	if (scalePtr->highlightWidth < 0) {
	    scalePtr->highlightWidth = 0;

	}
	scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;
	break;
    }
    if (!error) {
        Tk_FreeSavedOptions(&savedOptions);
    }

    /*
     * Reestablish the variable trace, if it is needed.
     */

    if (scalePtr->varNamePtr != NULL) {
        Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),
	        TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	        ScaleVarProc, (ClientData) scalePtr);
    }


    ScaleWorldChanged((ClientData) scalePtr);
    if (error) {
        Tcl_SetObjResult(interp, errorResult);
	Tcl_DecrRefCount(errorResult);
	return TCL_ERROR;
    } else {
      return TCL_OK;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * ScaleWorldChanged --
 *
797
798
799
800
801
802
803

804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
static void
ComputeScaleGeometry(scalePtr)
    register TkScale *scalePtr;		/* Information about widget. */
{
    char valueString[PRINT_CHARS];
    int tmp, valuePixels, x, y, extraSpace;
    Tk_FontMetrics fm;


    /*
     * Horizontal scales are simpler than vertical ones because
     * all sizes are the same (the height of a line of text);
     * handle them first and then quit.
     */

    Tk_GetFontMetrics(scalePtr->tkfont, &fm);
    if (!scalePtr->vertical) {
	y = scalePtr->inset;
	extraSpace = 0;
	if (scalePtr->labelLength != 0) {
	    scalePtr->horizLabelY = y + SPACING;
	    y += fm.linespace + SPACING;
	    extraSpace = SPACING;
	}







>








|







896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
static void
ComputeScaleGeometry(scalePtr)
    register TkScale *scalePtr;		/* Information about widget. */
{
    char valueString[PRINT_CHARS];
    int tmp, valuePixels, x, y, extraSpace;
    Tk_FontMetrics fm;
    char *label;

    /*
     * Horizontal scales are simpler than vertical ones because
     * all sizes are the same (the height of a line of text);
     * handle them first and then quit.
     */

    Tk_GetFontMetrics(scalePtr->tkfont, &fm);
    if (!scalePtr->orient == ORIENT_VERTICAL) {
	y = scalePtr->inset;
	extraSpace = 0;
	if (scalePtr->labelLength != 0) {
	    scalePtr->horizLabelY = y + SPACING;
	    y += fm.linespace + SPACING;
	    extraSpace = SPACING;
	}
877
878
879
880
881
882
883

884
885
886
887
888
889
890
891
892
    }
    scalePtr->vertTroughX = x;
    x += 2*scalePtr->borderWidth + scalePtr->width;
    if (scalePtr->labelLength == 0) {
	scalePtr->vertLabelX = 0;
    } else {
	scalePtr->vertLabelX = x + fm.ascent/2;

	x = scalePtr->vertLabelX + fm.ascent/2
		+ Tk_TextWidth(scalePtr->tkfont, scalePtr->label,
			scalePtr->labelLength);
    }
    Tk_GeometryRequest(scalePtr->tkwin, x + scalePtr->inset,
	    scalePtr->length + 2*scalePtr->inset);
    Tk_SetInternalBorder(scalePtr->tkwin, scalePtr->inset);
}








>

|







977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
    }
    scalePtr->vertTroughX = x;
    x += 2*scalePtr->borderWidth + scalePtr->width;
    if (scalePtr->labelLength == 0) {
	scalePtr->vertLabelX = 0;
    } else {
	scalePtr->vertLabelX = x + fm.ascent/2;
	label = Tcl_GetString(scalePtr->labelPtr);
	x = scalePtr->vertLabelX + fm.ascent/2
		+ Tk_TextWidth(scalePtr->tkfont, label,
			scalePtr->labelLength);
    }
    Tk_GeometryRequest(scalePtr->tkwin, x + scalePtr->inset,
	    scalePtr->length + 2*scalePtr->inset);
    Tk_SetInternalBorder(scalePtr->tkwin, scalePtr->inset);
}

1085
1086
1087
1088
1089
1090
1091
1092
1093




1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120

1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
    ClientData clientData;	/* Information about button. */
    Tcl_Interp *interp;		/* Interpreter containing variable. */
    char *name1;		/* Name of variable. */
    char *name2;		/* Second part of variable name. */
    int flags;			/* Information about what happened. */
{
    register TkScale *scalePtr = (TkScale *) clientData;
    char *stringValue, *end, *result;
    double value;





    /*
     * If the variable is unset, then immediately recreate it unless
     * the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
	    Tcl_TraceVar(interp, scalePtr->varName,
		    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		    ScaleVarProc, clientData);
	    scalePtr->flags |= NEVER_SET;
	    TkpSetScaleValue(scalePtr, scalePtr->value, 1, 0);
	}
	return (char *) NULL;
    }

    /*
     * If we came here because we updated the variable (in TkpSetScaleValue),
     * then ignore the trace.  Otherwise update the scale with the value
     * of the variable.
     */

    if (scalePtr->flags & SETTING_VAR) {
	return (char *) NULL;
    }
    result = NULL;

    stringValue = Tcl_GetVar(interp, scalePtr->varName, TCL_GLOBAL_ONLY);
    if (stringValue != NULL) {
	value = strtod(stringValue, &end);
	if ((end == stringValue) || (*end != 0)) {
	    result = "can't assign non-numeric value to scale variable";
	} else {
	    scalePtr->value = TkRoundToResolution(scalePtr, value);
	}

	/*
	 * This code is a bit tricky because it sets the scale's value before
	 * calling TkpSetScaleValue.  This way, TkpSetScaleValue won't bother 
	 * to set the variable again or to invoke the -command.  However, it
	 * also won't redisplay the scale, so we have to ask for that
	 * explicitly.
	 */

	TkpSetScaleValue(scalePtr, scalePtr->value, 1, 0);
	TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);
    }

    return result;
}







|

>
>
>
>








|

















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

|
|


|

1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227

1228
1229
1230
1231
1232
1233

1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
    ClientData clientData;	/* Information about button. */
    Tcl_Interp *interp;		/* Interpreter containing variable. */
    char *name1;		/* Name of variable. */
    char *name2;		/* Second part of variable name. */
    int flags;			/* Information about what happened. */
{
    register TkScale *scalePtr = (TkScale *) clientData;
    char *resultStr, *name;
    double value;
    Tcl_Obj *valuePtr;
    int result;

    name = Tcl_GetString(scalePtr->varNamePtr);

    /*
     * If the variable is unset, then immediately recreate it unless
     * the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
	    Tcl_TraceVar(interp, name,
		    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
		    ScaleVarProc, clientData);
	    scalePtr->flags |= NEVER_SET;
	    TkpSetScaleValue(scalePtr, scalePtr->value, 1, 0);
	}
	return (char *) NULL;
    }

    /*
     * If we came here because we updated the variable (in TkpSetScaleValue),
     * then ignore the trace.  Otherwise update the scale with the value
     * of the variable.
     */

    if (scalePtr->flags & SETTING_VAR) {
	return (char *) NULL;
    }
    resultStr = NULL;
    valuePtr = Tcl_GetVar2Ex(interp, name, NULL, 
            TCL_GLOBAL_ONLY);

    result = Tcl_GetDoubleFromObj(interp, valuePtr, &value);
    if (result != TCL_OK) {
        resultStr = "can't assign non-numeric value to scale variable";
    } else {
      scalePtr->value = TkRoundToResolution(scalePtr, value);
      

      /*
       * This code is a bit tricky because it sets the scale's value before
       * calling TkpSetScaleValue.  This way, TkpSetScaleValue won't bother 
       * to set the variable again or to invoke the -command.  However, it
       * also won't redisplay the scale, so we have to ask for that
       * explicitly.
       */

      TkpSetScaleValue(scalePtr, scalePtr->value, 1, 0);
      TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);
    }

    return resultStr;
}

Changes to generic/tkScale.h.

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
/*
 * tkScale.h --
 *
 *	Declarations of types and functions used to implement
 *	the scale widget.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkScale.h 1.5 96/07/08 12:56:56
 */

#ifndef _TKSCALE
#define _TKSCALE

#ifndef _TK
#include "tk.h"
#endif






















/*
 * A data structure of the following type is kept for each scale
 * widget managed by this file:
 */

typedef struct TkScale {
    Tk_Window tkwin;		/* Window that embodies the scale.  NULL
				 * means that the window has been destroyed
				 * but the data structures haven't yet been
				 * cleaned up.*/
    Display *display;		/* Display containing widget.  Used, among
				 * other things, so that resources can be
				 * freed even after tkwin has gone away. */
    Tcl_Interp *interp;		/* Interpreter associated with scale. */
    Tcl_Command widgetCmd;	/* Token for scale's widget command. */


    Tk_Uid orientUid;		/* Orientation for window ("vertical" or
				 * "horizontal"). */
    int vertical;		/* Non-zero means vertical orientation,
				 * zero means horizontal. */
    int width;			/* Desired narrow dimension of scale,
				 * in pixels. */
    int length;			/* Desired long dimension of scale,
				 * in pixels. */
    double value;		/* Current value of scale. */
    char *varName;		/* Name of variable (malloc'ed) or NULL.
				 * If non-NULL, scale's value tracks
				 * the contents of this variable and
				 * vice versa. */
    double fromValue;		/* Value corresponding to left or top of
				 * scale. */
    double toValue;		/* Value corresponding to right or bottom
				 * of scale. */
    double tickInterval;	/* Distance between tick marks;  0 means
				 * don't display any tick marks. */
    double resolution;		/* If > 0, all values are rounded to an
				 * even multiple of this value. */
    int digits;			/* Number of significant digits to print
				 * in values.  0 means we get to choose the
				 * number based on resolution and/or the
				 * range of the scale. */
    char format[10];		/* Sprintf conversion specifier computed from
				 * digits and other information. */
    double bigIncrement;	/* Amount to use for large increments to
				 * scale value.  (0 means we pick a value). */
    char *command;		/* Command prefix to use when invoking Tcl
				 * commands because the scale value changed.
				 * NULL means don't invoke commands.
				 * Malloc'ed. */
    int repeatDelay;		/* How long to wait before auto-repeating
				 * on scrolling actions (in ms). */
    int repeatInterval;		/* Interval between autorepeats (in ms). */
    char *label;		/* Label to display above or to right of
				 * scale;  NULL means don't display a
				 * label.  Malloc'ed. */
    int labelLength;		/* Number of non-NULL chars. in label. */
    Tk_Uid state;		/* Normal or disabled.  Value cannot be

				 * changed when scale is disabled. */

    /*
     * Information used when displaying widget:
     */

    int borderWidth;		/* Width of 3-D border around window. */
    Tk_3DBorder bgBorder;	/* Used for drawing slider and other
				 * background areas. */
    Tk_3DBorder activeBorder;	/* For drawing the slider when active. */
    int sliderRelief;		/* Is slider to be drawn raised, sunken, etc. */

    XColor *troughColorPtr;	/* Color for drawing trough. */
    GC troughGC;		/* For drawing trough. */
    GC copyGC;			/* Used for copying from pixmap onto screen. */
    Tk_Font tkfont;		/* Information about text font, or NULL. */
    XColor *textColorPtr;	/* Color for drawing text. */
    GC textGC;			/* GC for drawing text in normal mode. */
    int relief;			/* Indicates whether window as a whole is
				 * raised, sunken, or flat. */
    int highlightWidth;		/* Width in pixels of highlight to draw
				 * around widget when it has the focus.
				 * <= 0 means don't draw a highlight. */
    XColor *highlightBgColorPtr;

				/* Color for drawing traversal highlight
				 * area when highlight is off. */
    XColor *highlightColorPtr;	/* Color for drawing traversal highlight. */
    int inset;			/* Total width of all borders, including
				 * traversal highlight and 3-D border.
				 * Indicates how much interior stuff must
				 * be offset from outside edges to leave
				 * room for borders. */
    int sliderLength;		/* Length of slider, measured in pixels along











|








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
















>
>
|
|
<
<




|
|



















|

|
<



|

|

|
>
|









|
>











|
>
|
|







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
/*
 * tkScale.h --
 *
 *	Declarations of types and functions used to implement
 *	the scale widget.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkScale.h,v 1.1.4.3 1999/02/13 05:09:35 lfb Exp $
 */

#ifndef _TKSCALE
#define _TKSCALE

#ifndef _TK
#include "tk.h"
#endif

#ifdef BUILD_tk
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * Legal values for the "orient" field of TkScale records.
 */

enum orient {
    ORIENT_HORIZONTAL, ORIENT_VERTICAL
};

/*
 * Legal values for the "state" field of TkScale records.
 */

enum state {
    STATE_ACTIVE, STATE_DISABLED, STATE_NORMAL
};

/*
 * A data structure of the following type is kept for each scale
 * widget managed by this file:
 */

typedef struct TkScale {
    Tk_Window tkwin;		/* Window that embodies the scale.  NULL
				 * means that the window has been destroyed
				 * but the data structures haven't yet been
				 * cleaned up.*/
    Display *display;		/* Display containing widget.  Used, among
				 * other things, so that resources can be
				 * freed even after tkwin has gone away. */
    Tcl_Interp *interp;		/* Interpreter associated with scale. */
    Tcl_Command widgetCmd;	/* Token for scale's widget command. */
    Tk_OptionTable optionTable;	/* Table that defines configuration options
				 * available for this widget. */
    enum orient orient;		/* Orientation for window (vertical or
				 * horizontal). */


    int width;			/* Desired narrow dimension of scale,
				 * in pixels. */
    int length;			/* Desired long dimension of scale,
				 * in pixels. */
    double value;               /* Current value of scale. */
    Tcl_Obj *varNamePtr;	/* Name of variable or NULL.
				 * If non-NULL, scale's value tracks
				 * the contents of this variable and
				 * vice versa. */
    double fromValue;		/* Value corresponding to left or top of
				 * scale. */
    double toValue;		/* Value corresponding to right or bottom
				 * of scale. */
    double tickInterval;	/* Distance between tick marks;  0 means
				 * don't display any tick marks. */
    double resolution;		/* If > 0, all values are rounded to an
				 * even multiple of this value. */
    int digits;			/* Number of significant digits to print
				 * in values.  0 means we get to choose the
				 * number based on resolution and/or the
				 * range of the scale. */
    char format[10];		/* Sprintf conversion specifier computed from
				 * digits and other information. */
    double bigIncrement;	/* Amount to use for large increments to
				 * scale value.  (0 means we pick a value). */
    Tcl_Obj *commandPtr;        /* Command prefix to use when invoking Tcl
				 * commands because the scale value changed.
				 * NULL means don't invoke commands. */

    int repeatDelay;		/* How long to wait before auto-repeating
				 * on scrolling actions (in ms). */
    int repeatInterval;		/* Interval between autorepeats (in ms). */
    Tcl_Obj *labelPtr;		/* Label to display above or to right of
				 * scale;  NULL means don't display a
				 * label.  */
    int labelLength;		/* Number of non-NULL chars. in label. */
    enum state state;		/* Values are active, normal, or disabled.
				 * Value of scale cannot be changed when 
				 * disabled. */

    /*
     * Information used when displaying widget:
     */

    int borderWidth;		/* Width of 3-D border around window. */
    Tk_3DBorder bgBorder;	/* Used for drawing slider and other
				 * background areas. */
    Tk_3DBorder activeBorder;	/* For drawing the slider when active. */
    int sliderRelief;		/* Is slider to be drawn raised, sunken, 
				 * etc. */
    XColor *troughColorPtr;	/* Color for drawing trough. */
    GC troughGC;		/* For drawing trough. */
    GC copyGC;			/* Used for copying from pixmap onto screen. */
    Tk_Font tkfont;		/* Information about text font, or NULL. */
    XColor *textColorPtr;	/* Color for drawing text. */
    GC textGC;			/* GC for drawing text in normal mode. */
    int relief;			/* Indicates whether window as a whole is
				 * raised, sunken, or flat. */
    int highlightWidth;		/* Width in pixels of highlight to draw
				 * around widget when it has the focus.
				 * <= 0 means don't draw a highlight. */
    Tk_3DBorder highlightBorder;/* Value of -highlightbackground option:
				 * specifies background with which to draw 3-D
				 * default ring and focus highlight area when
				 * highlight is off. */
    XColor *highlightColorPtr;	/* Color for drawing traversal highlight. */
    int inset;			/* Total width of all borders, including
				 * traversal highlight and 3-D border.
				 * Indicates how much interior stuff must
				 * be offset from outside edges to leave
				 * room for borders. */
    int sliderLength;		/* Length of slider, measured in pixels along
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
    int vertLabelX;		/* X-location of origin of label. */

    /*
     * Miscellaneous information:
     */

    Tk_Cursor cursor;		/* Current cursor for window, or None. */
    char *takeFocus;		/* Value of -takefocus option;  not used in
				 * the C code, but used by keyboard traversal
				 * scripts.  Malloc'ed, but may be NULL. */
    int flags;			/* Various flags;  see below for
				 * definitions. */
} TkScale;

/*
 * Flag bits for scales:
 *







|

|







155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
    int vertLabelX;		/* X-location of origin of label. */

    /*
     * Miscellaneous information:
     */

    Tk_Cursor cursor;		/* Current cursor for window, or None. */
    Tcl_Obj *takeFocusPtr;	/* Value of -takefocus option;  not used in
				 * the C code, but used by keyboard traversal
				 * scripts.  May be NULL. */
    int flags;			/* Various flags;  see below for
				 * definitions. */
} TkScale;

/*
 * Flag bits for scales:
 *
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224



225
 * How many characters of space to provide when formatting the
 * scale's value:
 */

#define PRINT_CHARS 150

/*
 * Declaration of procedures used in the implementation of the scrollbar
 * widget. 
 */

EXTERN void		TkEventuallyRedrawScale _ANSI_ARGS_((TkScale *scalePtr,
			    int what));
EXTERN double		TkRoundToResolution _ANSI_ARGS_((TkScale *scalePtr,
			    double value));
EXTERN TkScale *	TkpCreateScale _ANSI_ARGS_((Tk_Window tkwin));
EXTERN void		TkpDestroyScale _ANSI_ARGS_((TkScale *scalePtr));
EXTERN void		TkpDisplayScale _ANSI_ARGS_((ClientData clientData));
EXTERN double		TkpPixelToValue _ANSI_ARGS_((TkScale *scalePtr, 
			    int x, int y));
EXTERN int		TkpScaleElement _ANSI_ARGS_((TkScale *scalePtr,
			     int x, int y));
EXTERN void		TkpSetScaleValue _ANSI_ARGS_((TkScale *scalePtr,
			    double value, int setVar, int invokeCommand));
EXTERN int		TkpValueToPixel _ANSI_ARGS_((TkScale *scalePtr,
			    double value));




#endif /* _TKSCALE */







|



















>
>
>

221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
 * How many characters of space to provide when formatting the
 * scale's value:
 */

#define PRINT_CHARS 150

/*
 * Declaration of procedures used in the implementation of the scale
 * widget. 
 */

EXTERN void		TkEventuallyRedrawScale _ANSI_ARGS_((TkScale *scalePtr,
			    int what));
EXTERN double		TkRoundToResolution _ANSI_ARGS_((TkScale *scalePtr,
			    double value));
EXTERN TkScale *	TkpCreateScale _ANSI_ARGS_((Tk_Window tkwin));
EXTERN void		TkpDestroyScale _ANSI_ARGS_((TkScale *scalePtr));
EXTERN void		TkpDisplayScale _ANSI_ARGS_((ClientData clientData));
EXTERN double		TkpPixelToValue _ANSI_ARGS_((TkScale *scalePtr, 
			    int x, int y));
EXTERN int		TkpScaleElement _ANSI_ARGS_((TkScale *scalePtr,
			     int x, int y));
EXTERN void		TkpSetScaleValue _ANSI_ARGS_((TkScale *scalePtr,
			    double value, int setVar, int invokeCommand));
EXTERN int		TkpValueToPixel _ANSI_ARGS_((TkScale *scalePtr,
			    double value));

# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TKSCALE */

Changes to generic/tkScrollbar.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkScrollbar.c 1.94 97/07/31 09:12:44
 */

#include "tkPort.h"
#include "tkScrollbar.h"
#include "default.h"

/*







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkScrollbar.c,v 1.1.4.2 1998/09/30 02:17:17 stanton Exp $
 */

#include "tkPort.h"
#include "tkScrollbar.h"
#include "default.h"

/*
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
    scrollPtr->flags = 0;

    if (ConfigureScrollbar(interp, scrollPtr, argc-2, argv+2, 0) != TCL_OK) {
	Tk_DestroyWindow(scrollPtr->tkwin);
	return TCL_ERROR;
    }

    interp->result = Tk_PathName(scrollPtr->tkwin);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ScrollbarWidgetCmd --







|







189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
    scrollPtr->flags = 0;

    if (ConfigureScrollbar(interp, scrollPtr, argc-2, argv+2, 0) != TCL_OK) {
	Tk_DestroyWindow(scrollPtr->tkwin);
	return TCL_ERROR;
    }

    Tcl_SetResult(interp, Tk_PathName(scrollPtr->tkwin), TCL_STATIC);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * ScrollbarWidgetCmd --
236
237
238
239
240
241
242
243


244


245


246
247
248
249
250
251
252
    Tcl_Preserve((ClientData) scrollPtr);
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)) {
	int oldActiveField;
	if (argc == 2) {
	    switch (scrollPtr->activeField) {
		case TOP_ARROW:		interp->result = "arrow1";	break;


		case SLIDER:		interp->result = "slider";	break;


		case BOTTOM_ARROW:	interp->result = "arrow2";	break;


	    }
	    goto done;
	}
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " activate element\"", (char *) NULL);
	    goto error;







|
>
>
|
>
>
|
>
>







236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
    Tcl_Preserve((ClientData) scrollPtr);
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)) {
	int oldActiveField;
	if (argc == 2) {
	    switch (scrollPtr->activeField) {
		case TOP_ARROW:
		    Tcl_SetResult(interp, "arrow1", TCL_STATIC);
		    break;
		case SLIDER:
		    Tcl_SetResult(interp, "slider", TCL_STATIC);
		    break;
		case BOTTOM_ARROW:
		    Tcl_SetResult(interp, "arrow2", TCL_STATIC);
		    break;
	    }
	    goto done;
	}
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " activate element\"", (char *) NULL);
	    goto error;
288
289
290
291
292
293
294

295
296
297
298
299
300
301
	} else {
	    result = ConfigureScrollbar(interp, scrollPtr, argc-2, argv+2,
		    TK_CONFIG_ARGV_ONLY);
	}
    } else if ((c == 'd') && (strncmp(argv[1], "delta", length) == 0)) {
	int xDelta, yDelta, pixels, length;
	double fraction;


	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " delta xDelta yDelta\"", (char *) NULL);
	    goto error;
	}
	if ((Tcl_GetInt(interp, argv[2], &xDelta) != TCL_OK)







>







294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
	} else {
	    result = ConfigureScrollbar(interp, scrollPtr, argc-2, argv+2,
		    TK_CONFIG_ARGV_ONLY);
	}
    } else if ((c == 'd') && (strncmp(argv[1], "delta", length) == 0)) {
	int xDelta, yDelta, pixels, length;
	double fraction;
	char buf[TCL_DOUBLE_SPACE];

	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " delta xDelta yDelta\"", (char *) NULL);
	    goto error;
	}
	if ((Tcl_GetInt(interp, argv[2], &xDelta) != TCL_OK)
312
313
314
315
316
317
318
319

320
321
322

323
324
325
326
327
328
329
		    - 2*(scrollPtr->arrowLength + scrollPtr->inset);
	}
	if (length == 0) {
	    fraction = 0.0;
	} else {
	    fraction = ((double) pixels / (double) length);
	}
	sprintf(interp->result, "%g", fraction);

    } else if ((c == 'f') && (strncmp(argv[1], "fraction", length) == 0)) {
	int x, y, pos, length;
	double fraction;


	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " fraction x y\"", (char *) NULL);
	    goto error;
	}
	if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)







|
>



>







319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
		    - 2*(scrollPtr->arrowLength + scrollPtr->inset);
	}
	if (length == 0) {
	    fraction = 0.0;
	} else {
	    fraction = ((double) pixels / (double) length);
	}
	sprintf(buf, "%g", fraction);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'f') && (strncmp(argv[1], "fraction", length) == 0)) {
	int x, y, pos, length;
	double fraction;
	char buf[TCL_DOUBLE_SPACE];

	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " fraction x y\"", (char *) NULL);
	    goto error;
	}
	if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
345
346
347
348
349
350
351
352

353
354
355
356
357
358
359
360
361
362
363
364
365


366
367
368

369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384


385


386


387


388


389
390
391
392
393
394
395
	    fraction = ((double) pos / (double) length);
	}
	if (fraction < 0) {
	    fraction = 0;
	} else if (fraction > 1.0) {
	    fraction = 1.0;
	}
	sprintf(interp->result, "%g", fraction);

    } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
	if (argc != 2) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " get\"", (char *) NULL);
	    goto error;
	}
	if (scrollPtr->flags & NEW_STYLE_COMMANDS) {
	    char first[TCL_DOUBLE_SPACE], last[TCL_DOUBLE_SPACE];

	    Tcl_PrintDouble(interp, scrollPtr->firstFraction, first);
	    Tcl_PrintDouble(interp, scrollPtr->lastFraction, last);
	    Tcl_AppendResult(interp, first, " ", last, (char *) NULL);
	} else {


	    sprintf(interp->result, "%d %d %d %d", scrollPtr->totalUnits,
		    scrollPtr->windowUnits, scrollPtr->firstUnit,
		    scrollPtr->lastUnit);

	}
    } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) {
	int x, y, thing;

	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " identify x y\"", (char *) NULL);
	    goto error;
	}
	if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
	    goto error;
	}
	thing = TkpScrollbarPosition(scrollPtr, x,y);
	switch (thing) {
	    case TOP_ARROW:	interp->result = "arrow1";	break;


	    case TOP_GAP:	interp->result = "trough1";	break;


	    case SLIDER:	interp->result = "slider";	break;


	    case BOTTOM_GAP:	interp->result = "trough2";	break;


	    case BOTTOM_ARROW:	interp->result = "arrow2";	break;


	}
    } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) {
	int totalUnits, windowUnits, firstUnit, lastUnit;

	if (argc == 4) {
	    double first, last;








|
>













>
>
|


>















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







354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
	    fraction = ((double) pos / (double) length);
	}
	if (fraction < 0) {
	    fraction = 0;
	} else if (fraction > 1.0) {
	    fraction = 1.0;
	}
	sprintf(buf, "%g", fraction);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
	if (argc != 2) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " get\"", (char *) NULL);
	    goto error;
	}
	if (scrollPtr->flags & NEW_STYLE_COMMANDS) {
	    char first[TCL_DOUBLE_SPACE], last[TCL_DOUBLE_SPACE];

	    Tcl_PrintDouble(interp, scrollPtr->firstFraction, first);
	    Tcl_PrintDouble(interp, scrollPtr->lastFraction, last);
	    Tcl_AppendResult(interp, first, " ", last, (char *) NULL);
	} else {
	    char buf[TCL_INTEGER_SPACE * 4];

	    sprintf(buf, "%d %d %d %d", scrollPtr->totalUnits,
		    scrollPtr->windowUnits, scrollPtr->firstUnit,
		    scrollPtr->lastUnit);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	}
    } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) {
	int x, y, thing;

	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " identify x y\"", (char *) NULL);
	    goto error;
	}
	if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
	    goto error;
	}
	thing = TkpScrollbarPosition(scrollPtr, x,y);
	switch (thing) {
	    case TOP_ARROW:
		Tcl_SetResult(interp, "arrow1", TCL_STATIC);
		break;
	    case TOP_GAP:
		Tcl_SetResult(interp, "trough1", TCL_STATIC);
		break;
	    case SLIDER:
		Tcl_SetResult(interp, "slider", TCL_STATIC);
		break;
	    case BOTTOM_GAP:
		Tcl_SetResult(interp, "trough2", TCL_STATIC);
		break;
	    case BOTTOM_ARROW:
		Tcl_SetResult(interp, "arrow2", TCL_STATIC);
		break;
	}
    } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) {
	int totalUnits, windowUnits, firstUnit, lastUnit;

	if (argc == 4) {
	    double first, last;

484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a scrollbar widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, border width,
 *	etc. get set for scrollPtr;  old resources get freed,
 *	if there were any.
 *
 *----------------------------------------------------------------------







|







507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a scrollbar widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, border width,
 *	etc. get set for scrollPtr;  old resources get freed,
 *	if there were any.
 *
 *----------------------------------------------------------------------

Changes to generic/tkScrollbar.h.

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
/*
 * tkScrollbar.h --
 *
 *	Declarations of types and functions used to implement
 *	the scrollbar widget.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkScrollbar.h 1.8 96/11/05 11:34:58
 */

#ifndef _TKSCROLLBAR
#define _TKSCROLLBAR

#ifndef _TKINT
#include "tkInt.h"
#endif






/*
 * A data structure of the following type is kept for each scrollbar
 * widget.
 */

typedef struct TkScrollbar {











|








>
>
>
>
>







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
/*
 * tkScrollbar.h --
 *
 *	Declarations of types and functions used to implement
 *	the scrollbar widget.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkScrollbar.h,v 1.1.4.1 1998/09/30 02:17:18 stanton Exp $
 */

#ifndef _TKSCROLLBAR
#define _TKSCROLLBAR

#ifndef _TKINT
#include "tkInt.h"
#endif

#ifdef BUILD_tk
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * A data structure of the following type is kept for each scrollbar
 * widget.
 */

typedef struct TkScrollbar {
193
194
195
196
197
198
199



200
EXTERN void		TkpDisplayScrollbar _ANSI_ARGS_((
			    ClientData clientData));
EXTERN void		TkpConfigureScrollbar _ANSI_ARGS_((
			    TkScrollbar *scrollPtr));
EXTERN int		TkpScrollbarPosition _ANSI_ARGS_((
			    TkScrollbar *scrollPtr, int x, int y));




#endif /* _TKSCROLLBAR */







>
>
>

198
199
200
201
202
203
204
205
206
207
208
EXTERN void		TkpDisplayScrollbar _ANSI_ARGS_((
			    ClientData clientData));
EXTERN void		TkpConfigureScrollbar _ANSI_ARGS_((
			    TkScrollbar *scrollPtr));
EXTERN int		TkpScrollbarPosition _ANSI_ARGS_((
			    TkScrollbar *scrollPtr, int x, int y));

# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TKSCROLLBAR */

Changes to generic/tkSelect.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkSelect.c --
 *
 *	This file manages the selection for the Tk toolkit,
 *	translating between the standard X ICCCM conventions
 *	and Tcl commands.
 *
 * Copyright (c) 1990-1993 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkSelect.c 1.57 96/05/03 10:52:40
 */

#include "tkInt.h"
#include "tkSelect.h"

/*
 * When a selection handler is set up by invoking "selection handle",








|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkSelect.c --
 *
 *	This file manages the selection for the Tk toolkit,
 *	translating between the standard X ICCCM conventions
 *	and Tcl commands.
 *
 * Copyright (c) 1990-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkSelect.c,v 1.1.4.3 1998/12/13 08:16:11 lfb Exp $
 */

#include "tkInt.h"
#include "tkSelect.h"

/*
 * When a selection handler is set up by invoking "selection handle",
41
42
43
44
45
46
47

48
49
50

51
52
53


54
55
56
57
58
59
60
    Tcl_Interp *interp;		/* Interpreter in which to invoke command. */
    char command[4];		/* Command to invoke.  Actual space is
				 * allocated as large as necessary.  This
				 * must be the last entry in the structure. */
} LostCommand;

/*

 * Shared variables:
 */


TkSelInProgress *pendingPtr = NULL;
				/* Topmost search in progress, or
				 * NULL if none. */



/*
 * Forward declarations for procedures defined in this file:
 */

static int		HandleTclCommand _ANSI_ARGS_((ClientData clientData,
			    int offset, char *buffer, int maxBytes));







>
|


>
|


>
>







41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
    Tcl_Interp *interp;		/* Interpreter in which to invoke command. */
    char command[4];		/* Command to invoke.  Actual space is
				 * allocated as large as necessary.  This
				 * must be the last entry in the structure. */
} LostCommand;

/*
 * The structure below is used to keep each thread's pending list
 * separate.
 */

typedef struct ThreadSpecificData {
    TkSelInProgress *pendingPtr;
				/* Topmost search in progress, or
				 * NULL if none. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations for procedures defined in this file:
 */

static int		HandleTclCommand _ANSI_ARGS_((ClientData clientData,
			    int offset, char *buffer, int maxBytes));
195
196
197
198
199
200
201


202
203
204
205
206
207
208
					 * is to be removed. */
    Atom target;			/* The target whose selection
					 * handler is to be removed. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    register TkSelHandler *selPtr, *prevPtr;
    register TkSelInProgress *ipPtr;



    /*
     * Find the selection handler to be deleted, or return if it doesn't
     * exist.
     */ 

    for (selPtr = winPtr->selHandlerList, prevPtr = NULL; ;







>
>







199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
					 * is to be removed. */
    Atom target;			/* The target whose selection
					 * handler is to be removed. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    register TkSelHandler *selPtr, *prevPtr;
    register TkSelInProgress *ipPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Find the selection handler to be deleted, or return if it doesn't
     * exist.
     */ 

    for (selPtr = winPtr->selHandlerList, prevPtr = NULL; ;
216
217
218
219
220
221
222

223
224
225
226
227
228
229
230
    }

    /*
     * If ConvertSelection is processing this handler, tell it that the
     * handler is dead.
     */


    for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	if (ipPtr->selPtr == selPtr) {
	    ipPtr->selPtr = NULL;
	}
    }

    /*
     * Free resources associated with the handler.







>
|







222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
    }

    /*
     * If ConvertSelection is processing this handler, tell it that the
     * handler is dead.
     */

    for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL; 
            ipPtr = ipPtr->nextPtr) {
	if (ipPtr->selPtr == selPtr) {
	    ipPtr->selPtr = NULL;
	}
    }

    /*
     * Free resources associated with the handler.
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
 *
 *	Retrieve the value of a selection and pass it off (in
 *	pieces, possibly) to a given procedure.
 *
 * Results:
 *	The return value is a standard Tcl return value.
 *	If an error occurs (such as no selection exists)
 *	then an error message is left in interp->result.
 *
 * Side effects:
 *	The standard X11 protocols are used to retrieve the
 *	selection.  When it arrives, it is passed to proc.  If
 *	the selection is very large, it will be passed to proc
 *	in several pieces.  Proc should have the following
 *	structure:







|







434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
 *
 *	Retrieve the value of a selection and pass it off (in
 *	pieces, possibly) to a given procedure.
 *
 * Results:
 *	The return value is a standard Tcl return value.
 *	If an error occurs (such as no selection exists)
 *	then an error message is left in the interp's result.
 *
 * Side effects:
 *	The standard X11 protocols are used to retrieve the
 *	selection.  When it arrives, it is passed to proc.  If
 *	the selection is very large, it will be passed to proc
 *	in several pieces.  Proc should have the following
 *	structure:
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
 *	The portion argument points to a character string
 *	containing part of the selection, and numBytes indicates
 *	the length of the portion, not including the terminating
 *	NULL character.  If the selection arrives in several pieces,
 *	the "portion" arguments in separate calls will contain
 *	successive parts of the selection.  Proc should normally
 *	return TCL_OK.  If it detects an error then it should return
 *	TCL_ERROR and leave an error message in interp->result; the
 *	remainder of the selection retrieval will be aborted.
 *
 *--------------------------------------------------------------
 */

int
Tk_GetSelection(interp, tkwin, selection, target, proc, clientData)







|







460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
 *	The portion argument points to a character string
 *	containing part of the selection, and numBytes indicates
 *	the length of the portion, not including the terminating
 *	NULL character.  If the selection arrives in several pieces,
 *	the "portion" arguments in separate calls will contain
 *	successive parts of the selection.  Proc should normally
 *	return TCL_OK.  If it detects an error then it should return
 *	TCL_ERROR and leave an error message in the interp's result; the
 *	remainder of the selection retrieval will be aborted.
 *
 *--------------------------------------------------------------
 */

int
Tk_GetSelection(interp, tkwin, selection, target, proc, clientData)
476
477
478
479
480
481
482


483
484
485
486
487
488
489
    Tk_GetSelProc *proc;	/* Procedure to call to process the
				 * selection, once it has been retrieved. */
    ClientData clientData;	/* Arbitrary value to pass to proc. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    TkDisplay *dispPtr = winPtr->dispPtr;
    TkSelectionInfo *infoPtr;



    if (dispPtr->multipleAtom == None) {
	TkSelInit(tkwin);
    }

    /*
     * If the selection is owned by a window managed by this







>
>







483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
    Tk_GetSelProc *proc;	/* Procedure to call to process the
				 * selection, once it has been retrieved. */
    ClientData clientData;	/* Arbitrary value to pass to proc. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    TkDisplay *dispPtr = winPtr->dispPtr;
    TkSelectionInfo *infoPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (dispPtr->multipleAtom == None) {
	TkSelInit(tkwin);
    }

    /*
     * If the selection is owned by a window managed by this
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
	    }
	    buffer[count] = 0;
	    result = (*proc)(clientData, interp, buffer);
	} else {
	    offset = 0;
	    result = TCL_OK;
	    ip.selPtr = selPtr;
	    ip.nextPtr = pendingPtr;
	    pendingPtr = &ip;
	    while (1) {
		count = (selPtr->proc)(selPtr->clientData, offset, buffer,
			TK_SEL_BYTES_AT_ONCE);
		if ((count < 0) || (ip.selPtr == NULL)) {
		    pendingPtr = ip.nextPtr;
		    goto cantget;
		}
		if (count > TK_SEL_BYTES_AT_ONCE) {
		    panic("selection handler returned too many bytes");
		}
		buffer[count] = '\0';
		result = (*proc)(clientData, interp, buffer);
		if ((result != TCL_OK) || (count < TK_SEL_BYTES_AT_ONCE)
			|| (ip.selPtr == NULL)) {
		    break;
		}
		offset += count;
	    }
	    pendingPtr = ip.nextPtr;
	}
	return result;
    }

    /*
     * The selection is owned by some other process.
     */







|
|




|













|







533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
	    }
	    buffer[count] = 0;
	    result = (*proc)(clientData, interp, buffer);
	} else {
	    offset = 0;
	    result = TCL_OK;
	    ip.selPtr = selPtr;
	    ip.nextPtr = tsdPtr->pendingPtr;
	    tsdPtr->pendingPtr = &ip;
	    while (1) {
		count = (selPtr->proc)(selPtr->clientData, offset, buffer,
			TK_SEL_BYTES_AT_ONCE);
		if ((count < 0) || (ip.selPtr == NULL)) {
		    tsdPtr->pendingPtr = ip.nextPtr;
		    goto cantget;
		}
		if (count > TK_SEL_BYTES_AT_ONCE) {
		    panic("selection handler returned too many bytes");
		}
		buffer[count] = '\0';
		result = (*proc)(clientData, interp, buffer);
		if ((result != TCL_OK) || (count < TK_SEL_BYTES_AT_ONCE)
			|| (ip.selPtr == NULL)) {
		    break;
		}
		offset += count;
	    }
	    tsdPtr->pendingPtr = ip.nextPtr;
	}
	return result;
    }

    /*
     * The selection is owned by some other process.
     */
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
    Atom selection;
    char *selName = NULL;
    int c, count;
    size_t length;
    char **args;

    if (argc < 2) {
	sprintf(interp->result,
		"wrong # args: should be \"%.50s option ?arg arg ...?\"",
		argv[0]);
	return TCL_ERROR;
    }
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) {
	for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
	    if (args[0][0] != '-') {







|
|
<







607
608
609
610
611
612
613
614
615

616
617
618
619
620
621
622
    Atom selection;
    char *selName = NULL;
    int c, count;
    size_t length;
    char **args;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?arg arg ...?\"", (char *) NULL);

	return TCL_ERROR;
    }
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) {
	for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
	    if (args[0][0] != '-') {
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864

	    /*
	     * Ignore the internal clipboard window.
	     */

	    if ((infoPtr != NULL)
		    && (infoPtr->owner != winPtr->dispPtr->clipWindow)) {
		interp->result = Tk_PathName(infoPtr->owner);
	    }
	    return TCL_OK;
	}
	tkwin = Tk_NameToWindow(interp, args[0], tkwin);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}







|







858
859
860
861
862
863
864
865
866
867
868
869
870
871
872

	    /*
	     * Ignore the internal clipboard window.
	     */

	    if ((infoPtr != NULL)
		    && (infoPtr->owner != winPtr->dispPtr->clipWindow)) {
		Tcl_SetResult(interp, Tk_PathName(infoPtr->owner), TCL_STATIC);
	    }
	    return TCL_OK;
	}
	tkwin = Tk_NameToWindow(interp, args[0], tkwin);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
874
875
876
877
878
879
880
881
882
883
884
885
886






















































887
888
889
890
891
892
893
	lostPtr = (LostCommand *) ckalloc((unsigned) (sizeof(LostCommand)
		-3 + cmdLength));
	lostPtr->interp = interp;
	strcpy(lostPtr->command, script);
	Tk_OwnSelection(tkwin, selection, LostSelection, (ClientData) lostPtr);
	return TCL_OK;
    } else {
	sprintf(interp->result,
		"bad option \"%.50s\": must be clear, get, handle, or own",
		argv[1]);
	return TCL_ERROR;
    }
}























































/*
 *----------------------------------------------------------------------
 *
 * TkSelDeadWindow --
 *
 *	This procedure is invoked just before a TkWindow is deleted.







|
|
<



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







882
883
884
885
886
887
888
889
890

891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
	lostPtr = (LostCommand *) ckalloc((unsigned) (sizeof(LostCommand)
		-3 + cmdLength));
	lostPtr->interp = interp;
	strcpy(lostPtr->command, script);
	Tk_OwnSelection(tkwin, selection, LostSelection, (ClientData) lostPtr);
	return TCL_OK;
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be clear, get, handle, or own", (char *) NULL);

	return TCL_ERROR;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkSelGetInProgress --
 *
 *	This procedure returns a pointer to the thread-local
 *      list of pending searches.
 *
 * Results:
 *	The return value is a pointer to the first search in progress, 
 *      or NULL if there are none. 
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

TkSelInProgress *
TkSelGetInProgress(void)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    return tsdPtr->pendingPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TkSelSetInProgress --
 *
 *	This procedure is used to set the thread-local list of pending 
 *      searches.  It is required because the pending list is kept
 *      in thread local storage.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
void
TkSelSetInProgress(pendingPtr)
    TkSelInProgress *pendingPtr;
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

   tsdPtr->pendingPtr = pendingPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TkSelDeadWindow --
 *
 *	This procedure is invoked just before a TkWindow is deleted.
905
906
907
908
909
910
911


912
913
914
915
916
917
918
919
920
921

922
923
924
925
926
927
928
929
void
TkSelDeadWindow(winPtr)
    register TkWindow *winPtr;	/* Window that's being deleted. */
{
    register TkSelHandler *selPtr;
    register TkSelInProgress *ipPtr;
    TkSelectionInfo *infoPtr, *prevPtr, *nextPtr;



    /*
     * While deleting all the handlers, be careful to check whether
     * ConvertSelection or TkSelPropProc are about to process one of the
     * deleted handlers.
     */

    while (winPtr->selHandlerList != NULL) {
	selPtr = winPtr->selHandlerList;
	winPtr->selHandlerList = selPtr->nextPtr;

	for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->selPtr == selPtr) {
		ipPtr->selPtr = NULL;
	    }
	}
	if (selPtr->proc == HandleTclCommand) {
	    ckfree((char *) selPtr->clientData);
	}







>
>










>
|







966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
void
TkSelDeadWindow(winPtr)
    register TkWindow *winPtr;	/* Window that's being deleted. */
{
    register TkSelHandler *selPtr;
    register TkSelInProgress *ipPtr;
    TkSelectionInfo *infoPtr, *prevPtr, *nextPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * While deleting all the handlers, be careful to check whether
     * ConvertSelection or TkSelPropProc are about to process one of the
     * deleted handlers.
     */

    while (winPtr->selHandlerList != NULL) {
	selPtr = winPtr->selHandlerList;
	winPtr->selHandlerList = selPtr->nextPtr;
	for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL; 
                ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->selPtr == selPtr) {
		ipPtr->selPtr = NULL;
	    }
	}
	if (selPtr->proc == HandleTclCommand) {
	    ckfree((char *) selPtr->clientData);
	}
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162

1163
1164
1165
1166
1167
1168
1169
     * Execute the command.  Be sure to restore the state of the
     * interpreter after executing the command.
     */

    Tcl_DStringInit(&oldResult);
    Tcl_DStringGetResult(interp, &oldResult);
    if (TkCopyAndGlobalEval(interp, command) == TCL_OK) {
	length = strlen(interp->result);
	if (length > maxBytes) {
	    length = maxBytes;
	}
	memcpy((VOID *) buffer, (VOID *) interp->result, (size_t) length);

	buffer[length] = '\0';
    } else {
	length = -1;
    }
    Tcl_DStringResult(interp, &oldResult);

    if (command != staticSpace) {







|



|
>







1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
     * Execute the command.  Be sure to restore the state of the
     * interpreter after executing the command.
     */

    Tcl_DStringInit(&oldResult);
    Tcl_DStringGetResult(interp, &oldResult);
    if (TkCopyAndGlobalEval(interp, command) == TCL_OK) {
	length = strlen(Tcl_GetStringResult(interp));
	if (length > maxBytes) {
	    length = maxBytes;
	}
	memcpy((VOID *) buffer, (VOID *) Tcl_GetStringResult(interp),
		(size_t) length);
	buffer[length] = '\0';
    } else {
	length = -1;
    }
    Tcl_DStringResult(interp, &oldResult);

    if (command != staticSpace) {
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
 */

static void
LostSelection(clientData)
    ClientData clientData;		/* Pointer to CommandInfo structure. */
{
    LostCommand *lostPtr = (LostCommand *) clientData;
    char *oldResultString;
    Tcl_FreeProc *oldFreeProc;
    Tcl_Interp *interp;

    interp = lostPtr->interp;
    Tcl_Preserve((ClientData) interp);
    
    /*
     * Execute the command.  Save the interpreter's result, if any, and
     * restore it after executing the command.
     */

    oldFreeProc = interp->freeProc;
    if (oldFreeProc != TCL_STATIC) {
	oldResultString = interp->result;
    } else {
	oldResultString = (char *) ckalloc((unsigned)
		(strlen(interp->result) + 1));
	strcpy(oldResultString, interp->result);
	oldFreeProc = TCL_DYNAMIC;
    }
    interp->freeProc = TCL_STATIC;
    if (TkCopyAndGlobalEval(interp, lostPtr->command) != TCL_OK) {
	Tcl_BackgroundError(interp);
    }
    Tcl_FreeResult(interp);
    interp->result = oldResultString;
    interp->freeProc = oldFreeProc;

    Tcl_Release((ClientData) interp);
    
    /*
     * Free the storage for the command, since we're done with it now.
     */

    ckfree((char *) lostPtr);
}







<
|










|
|
<
<
<
|
<
<
|
<



|
|
|









1363
1364
1365
1366
1367
1368
1369

1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382



1383


1384

1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
 */

static void
LostSelection(clientData)
    ClientData clientData;		/* Pointer to CommandInfo structure. */
{
    LostCommand *lostPtr = (LostCommand *) clientData;

    Tcl_Obj *objPtr;
    Tcl_Interp *interp;

    interp = lostPtr->interp;
    Tcl_Preserve((ClientData) interp);
    
    /*
     * Execute the command.  Save the interpreter's result, if any, and
     * restore it after executing the command.
     */

    objPtr = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(objPtr);



    Tcl_ResetResult(interp);




    if (TkCopyAndGlobalEval(interp, lostPtr->command) != TCL_OK) {
	Tcl_BackgroundError(interp);
    }

    Tcl_SetObjResult(interp, objPtr);
    Tcl_DecrRefCount(objPtr);

    Tcl_Release((ClientData) interp);
    
    /*
     * Free the storage for the command, since we're done with it now.
     */

    ckfree((char *) lostPtr);
}

Changes to generic/tkSelect.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * tkSelect.h --
 *
 *	Declarations of types shared among the files that implement
 *	selection support.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkSelect.h 1.4 95/11/03 13:22:41
 */

#ifndef _TKSELECT
#define _TKSELECT

/*
 * When a selection is owned by a window on a given display, one of the











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * tkSelect.h --
 *
 *	Declarations of types shared among the files that implement
 *	selection support.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkSelect.h,v 1.1.4.2 1998/12/13 08:16:11 lfb Exp $
 */

#ifndef _TKSELECT
#define _TKSELECT

/*
 * When a selection is owned by a window on a given display, one of the
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
typedef struct TkSelInProgress {
    TkSelHandler *selPtr;	/* Handler being executed.  If this handler
				 * is deleted, the field is set to NULL. */
    struct TkSelInProgress *nextPtr;
				/* Next higher nested search. */
} TkSelInProgress;

/*
 * Declarations for variables shared among the selection-related files:
 */

extern TkSelInProgress *pendingPtr;
				/* Topmost search in progress, or
				 * NULL if none. */

/*
 * Chunk size for retrieving selection.  It's defined both in
 * words and in bytes;  the word size is used to allocate
 * buffer space that's guaranteed to be word-aligned and that
 * has an extra character for the terminating NULL.
 */

#define TK_SEL_BYTES_AT_ONCE 4000
#define TK_SEL_WORDS_AT_ONCE 1001

/*
 * Declarations for procedures that are used by the selection-related files
 * but shouldn't be used anywhere else in Tk (or by Tk clients):
 */






extern void		TkSelClearSelection _ANSI_ARGS_((Tk_Window tkwin,
			    XEvent *eventPtr));
extern int		TkSelDefaultSelection _ANSI_ARGS_((
			    TkSelectionInfo *infoPtr, Atom target,
			    char *buffer, int maxBytes, Atom *typePtr));
extern int		TkSelGetSelection _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Atom selection, Atom target,







<
<
<
<
<
<
<
<















>
>
>
>
>







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
typedef struct TkSelInProgress {
    TkSelHandler *selPtr;	/* Handler being executed.  If this handler
				 * is deleted, the field is set to NULL. */
    struct TkSelInProgress *nextPtr;
				/* Next higher nested search. */
} TkSelInProgress;









/*
 * Chunk size for retrieving selection.  It's defined both in
 * words and in bytes;  the word size is used to allocate
 * buffer space that's guaranteed to be word-aligned and that
 * has an extra character for the terminating NULL.
 */

#define TK_SEL_BYTES_AT_ONCE 4000
#define TK_SEL_WORDS_AT_ONCE 1001

/*
 * Declarations for procedures that are used by the selection-related files
 * but shouldn't be used anywhere else in Tk (or by Tk clients):
 */

extern TkSelInProgress * 
                        TkSelGetInProgress _ANSI_ARGS_((void));
extern void             TkSelSetInProgress _ANSI_ARGS_((
                            TkSelInProgress *pendingPtr));

extern void		TkSelClearSelection _ANSI_ARGS_((Tk_Window tkwin,
			    XEvent *eventPtr));
extern int		TkSelDefaultSelection _ANSI_ARGS_((
			    TkSelectionInfo *infoPtr, Atom target,
			    char *buffer, int maxBytes, Atom *typePtr));
extern int		TkSelGetSelection _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, Atom selection, Atom target,

Changes to generic/tkSquare.c.

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
/* 
 * tkSquare.c --
 *
 *	This module implements "square" widgets.  A "square" is
 *	a widget that displays a single square that can be moved
 *	around and resized.  This file is intended as an example
 *	of how to build a widget;  it isn't included in the
 *	normal wish, but it is included in "tktest".
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkSquare.c 1.19 97/07/31 09:13:13
 */

#include "tkPort.h"

#include "tk.h"


/*
 * A data structure of the following type is kept for each square
 * widget managed by this file:
 */

typedef struct {
    Tk_Window tkwin;		/* Window that embodies the square.  NULL
				 * means window has been deleted but
				 * widget record hasn't been cleaned up yet. */
    Display *display;		/* X's token for the window's display. */
    Tcl_Interp *interp;		/* Interpreter associated with widget. */
    Tcl_Command widgetCmd;	/* Token for square's widget command. */


    int x, y;			/* Position of square's upper-left corner
				 * within widget. */

    int size;			/* Width and height of square. */

    /*
     * Information used when displaying widget:
     */

    int borderWidth;		/* Width of 3-D border around whole widget. */
    Tk_3DBorder bgBorder;	/* Used for drawing background. */
    Tk_3DBorder fgBorder;	/* For drawing square. */
    int relief;			/* Indicates whether window as a whole is
				 * raised, sunken, or flat. */
    GC gc;			/* Graphics context for copying from
				 * off-screen pixmap onto screen. */
    int doubleBuffer;		/* Non-zero means double-buffer redisplay
				 * with pixmap;  zero means draw straight
				 * onto the display. */
    int updatePending;		/* Non-zero means a call to SquareDisplay
				 * has already been scheduled. */
} Square;

/*
 * Information used for argv parsing.
 */

static Tk_ConfigSpec configSpecs[] = {
    {TK_CONFIG_BORDER, "-background", "background", "Background",
	"#d9d9d9", Tk_Offset(Square, bgBorder), TK_CONFIG_COLOR_ONLY},
    {TK_CONFIG_BORDER, "-background", "background", "Background",
	"white", Tk_Offset(Square, bgBorder), TK_CONFIG_MONO_ONLY},
    {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	"2", Tk_Offset(Square, borderWidth), 0},
    {TK_CONFIG_INT, "-dbl", "doubleBuffer", "DoubleBuffer",
	"1", Tk_Offset(Square, doubleBuffer), 0},
    {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
	(char *) NULL, 0, 0},
    {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground",
	"#b03060", Tk_Offset(Square, fgBorder), TK_CONFIG_COLOR_ONLY},

    {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground",
	"black", Tk_Offset(Square, fgBorder), TK_CONFIG_MONO_ONLY},


    {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
	"raised", Tk_Offset(Square, relief), 0},


    {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, 0}
};

/*
 * Forward declarations for procedures defined later in this file:
 */

int			SquareCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));

static void		SquareCmdDeletedProc _ANSI_ARGS_((
			    ClientData clientData));
static int		SquareConfigure _ANSI_ARGS_((Tcl_Interp *interp,
			    Square *squarePtr, int argc, char **argv,
			    int flags));
static void		SquareDestroy _ANSI_ARGS_((char *memPtr));
static void		SquareDisplay _ANSI_ARGS_((ClientData clientData));
static void		KeepInWindow _ANSI_ARGS_((Square *squarePtr));
static void		SquareEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static int		SquareWidgetCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *, int argc, char **argv));

/*
 *--------------------------------------------------------------
 *
 * SquareCmd --
 *
 *	This procedure is invoked to process the "square" Tcl
 *	command.  It creates a new "square" widget.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A new widget is created and configured.
 *
 *--------------------------------------------------------------
 */

int
SquareCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    Tk_Window main = (Tk_Window) clientData;
    Square *squarePtr;
    Tk_Window tkwin;











    if (argc < 2) {






	Tcl_AppendResult(interp, "wrong # args: should be \"",

		argv[0], " pathName ?options?\"", (char *) NULL);
	return TCL_ERROR;
    }

    tkwin = Tk_CreateWindowFromPath(interp, main, argv[1], (char *) NULL);

    if (tkwin == NULL) {
	return TCL_ERROR;
    }
    Tk_SetClass(tkwin, "Square");

    /*
     * Allocate and initialize the widget record.
     */

    squarePtr = (Square *) ckalloc(sizeof(Square));
    squarePtr->tkwin = tkwin;
    squarePtr->display = Tk_Display(tkwin);
    squarePtr->interp = interp;
    squarePtr->widgetCmd = Tcl_CreateCommand(interp,
	    Tk_PathName(squarePtr->tkwin), SquareWidgetCmd,
	    (ClientData) squarePtr, SquareCmdDeletedProc);


    squarePtr->x = 0;
    squarePtr->y = 0;
    squarePtr->size = 20;
    squarePtr->borderWidth = 0;
    squarePtr->bgBorder = NULL;
    squarePtr->fgBorder = NULL;
    squarePtr->relief = TK_RELIEF_FLAT;
    squarePtr->gc = None;
    squarePtr->doubleBuffer = 1;
    squarePtr->updatePending = 0;


    Tk_CreateEventHandler(squarePtr->tkwin, ExposureMask|StructureNotifyMask,
	    SquareEventProc, (ClientData) squarePtr);
    if (SquareConfigure(interp, squarePtr, argc-2, argv+2, 0) != TCL_OK) {
	Tk_DestroyWindow(squarePtr->tkwin);

	return TCL_ERROR;
    }











    interp->result = Tk_PathName(squarePtr->tkwin);

    return TCL_OK;




}

/*
 *--------------------------------------------------------------
 *
 * SquareWidgetCmd --
 *



|
|
|



<
|




|



>

>













>
>
|

>
|





|
|
|
|
<


|










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






|
|
>
|


|
<



|


|



















|



|
|

<


>
>
>

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



|
>













|

|
>
>


|
|
|
|
|

|

>

<
|
|

>



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

>
>
>
>







1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88

89
90
91
92
93
94
95
96
97
98
99
100
101

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134

135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192

193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
/* 
 * tkSquare.c --
 *
 *	This module implements "square" widgets that are object
 *	based.  A "square" is a widget that displays a single square that can 
 *	be moved around and resized.  This file is intended as an example
 *	of how to build a widget;  it isn't included in the
 *	normal wish, but it is included in "tktest".
 *

 * Copyright (c) 1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkSquare.c,v 1.1.4.3 1998/11/20 02:53:03 stanton Exp $
 */

#include "tkPort.h"
#define __NO_OLD_CONFIG
#include "tk.h"
#include "tkInt.h"

/*
 * A data structure of the following type is kept for each square
 * widget managed by this file:
 */

typedef struct {
    Tk_Window tkwin;		/* Window that embodies the square.  NULL
				 * means window has been deleted but
				 * widget record hasn't been cleaned up yet. */
    Display *display;		/* X's token for the window's display. */
    Tcl_Interp *interp;		/* Interpreter associated with widget. */
    Tcl_Command widgetCmd;	/* Token for square's widget command. */
    Tk_OptionTable optionTable;	/* Token representing the configuration
				 * specifications. */
    Tcl_Obj *xPtr, *yPtr;	/* Position of square's upper-left corner
				 * within widget. */
    int x, y;
    Tcl_Obj *sizeObjPtr;	/* Width and height of square. */

    /*
     * Information used when displaying widget:
     */

    Tcl_Obj *borderWidthPtr;	/* Width of 3-D border around whole widget. */
    Tcl_Obj *bgBorderPtr;
    Tcl_Obj *fgBorderPtr;
    Tcl_Obj *reliefPtr;

    GC gc;			/* Graphics context for copying from
				 * off-screen pixmap onto screen. */
    Tcl_Obj *doubleBufferPtr;	/* Non-zero means double-buffer redisplay
				 * with pixmap;  zero means draw straight
				 * onto the display. */
    int updatePending;		/* Non-zero means a call to SquareDisplay
				 * has already been scheduled. */
} Square;

/*
 * Information used for argv parsing.
 */

static Tk_OptionSpec configSpecs[] = {
    {TK_OPTION_BORDER, "-background", "background", "Background",
	    "#d9d9d9", Tk_Offset(Square, bgBorderPtr), -1, 0,

	    (ClientData) "white"},
    {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
	    (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth"},
    {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
	    (char *) NULL, 0, -1, 0, (ClientData) "-background"},
    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
	    "2", Tk_Offset(Square, borderWidthPtr), -1},
    {TK_OPTION_BOOLEAN, "-dbl", "doubleBuffer", "DoubleBuffer",
	    "1", Tk_Offset(Square, doubleBufferPtr), -1},
    {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL,
	    (char *) NULL, 0, -1, 0, (ClientData) "-foreground"},
    {TK_OPTION_BORDER, "-foreground", "foreground", "Foreground",
	    "#b03060", Tk_Offset(Square, fgBorderPtr), -1, 0,
	    (ClientData) "black"},
    {TK_OPTION_PIXELS, "-posx", "posx", "PosX", "0",
	    Tk_Offset(Square, xPtr), -1},
    {TK_OPTION_PIXELS, "-posy", "posy", "PosY", "0",
	    Tk_Offset(Square, yPtr), -1},
    {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
	    "raised", Tk_Offset(Square, reliefPtr), -1},
    {TK_OPTION_PIXELS, "-size", "size", "Size", "20",
	    Tk_Offset(Square, sizeObjPtr), -1},
    {TK_OPTION_END}

};

/*
 * Forward declarations for procedures defined later in this file:
 */

int			SquareObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj * CONST objv[]));
static void		SquareDeletedProc _ANSI_ARGS_((
			    ClientData clientData));
static int		SquareConfigure _ANSI_ARGS_((Tcl_Interp *interp,
			    Square *squarePtr));

static void		SquareDestroy _ANSI_ARGS_((char *memPtr));
static void		SquareDisplay _ANSI_ARGS_((ClientData clientData));
static void		KeepInWindow _ANSI_ARGS_((Square *squarePtr));
static void		SquareObjEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static int		SquareWidgetCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *, int objc, Tcl_Obj * CONST objv[]));

/*
 *--------------------------------------------------------------
 *
 * SquareCmd --
 *
 *	This procedure is invoked to process the "square" Tcl
 *	command.  It creates a new "square" widget.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A new widget is created and configured.
 *
 *--------------------------------------------------------------
 */

int
SquareObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj * CONST objv[];	/* Argument objects. */
{

    Square *squarePtr;
    Tk_Window tkwin;
    Tk_OptionTable optionTable = (Tk_OptionTable) clientData;
    Tcl_CmdInfo info;
    char *commandName;

    if (optionTable == NULL) {
	/*
	 * The first time this procedure is invoked, optionTable will
	 * be NULL.  We then create the option table from the template
	 * and store the table pointer as the command's clinical so
	 * we'll have easy access to it in the future.
	 */

	optionTable = Tk_CreateOptionTable(interp, configSpecs);
	commandName = Tcl_GetStringFromObj(objv[0], (int *) NULL);
	Tcl_GetCommandInfo(interp, commandName, &info);
	info.clientData = (ClientData) optionTable;
	Tcl_SetCommandInfo(interp, commandName, &info);
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
	return TCL_ERROR;
    }

    tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp), 
	    Tcl_GetStringFromObj(objv[1], NULL), (char *) NULL);
    if (tkwin == NULL) {
	return TCL_ERROR;
    }
    Tk_SetClass(tkwin, "Square");

    /*
     * Allocate and initialize the widget record.
     */

    squarePtr = (Square *) ckalloc(sizeof(Square));
    squarePtr->tkwin = tkwin;
    squarePtr->display = Tk_Display(tkwin);
    squarePtr->interp = interp;
    squarePtr->widgetCmd = Tcl_CreateObjCommand(interp,
	    Tk_PathName(squarePtr->tkwin), SquareWidgetCmd,
	    (ClientData) squarePtr, SquareDeletedProc);
    squarePtr->xPtr = NULL;
    squarePtr->yPtr = NULL;
    squarePtr->x = 0;
    squarePtr->y = 0;
    squarePtr->sizeObjPtr = NULL;
    squarePtr->borderWidthPtr = NULL;
    squarePtr->bgBorderPtr = NULL;
    squarePtr->fgBorderPtr = NULL;
    squarePtr->reliefPtr = NULL;
    squarePtr->gc = None;
    squarePtr->doubleBufferPtr = NULL;
    squarePtr->updatePending = 0;
    squarePtr->optionTable = optionTable;


    if (Tk_InitOptions(interp, (char *) squarePtr, optionTable, tkwin)
	    != TCL_OK) {
	Tk_DestroyWindow(squarePtr->tkwin);
	ckfree((char *) squarePtr);
	return TCL_ERROR;
    }

    Tk_CreateEventHandler(squarePtr->tkwin, ExposureMask|StructureNotifyMask,
	    SquareObjEventProc, (ClientData) squarePtr);
    if (Tk_SetOptions(interp, (char *) squarePtr, optionTable, objc - 2,
	    objv + 2, tkwin, NULL, (int *) NULL) != TCL_OK) {
	goto error;
    }
    if (SquareConfigure(interp, squarePtr) != TCL_OK) {
	goto error;
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(squarePtr->tkwin),
	    -1));
    return TCL_OK;

error:
    Tk_DestroyWindow(squarePtr->tkwin);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * SquareWidgetCmd --
 *
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204

205



206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223


224
225
226
227
228
229


230

231
232
233
234
235
236
237
238
239
240
241
242
243


244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276

277
278


279
280
281
282






283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325



326
327
328
329
330
331


332
333

334
335
336
337
338
339
340
341
342
343
344
345
346
347


348
349
350
351
352

353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393





394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
SquareWidgetCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Information about square widget. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    Square *squarePtr = (Square *) clientData;
    int result = TCL_OK;

    size_t length;



    char c;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option ?arg arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    Tcl_Preserve((ClientData) squarePtr);
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " cget option\"",
		    (char *) NULL);
	    goto error;
	}


	result = Tk_ConfigureValue(interp, squarePtr->tkwin, configSpecs,
		(char *) squarePtr, argv[2], 0);
    } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
	    && (length >= 2)) {
	if (argc == 2) {
	    result = Tk_ConfigureInfo(interp, squarePtr->tkwin, configSpecs,


		    (char *) squarePtr, (char *) NULL, 0);

	} else if (argc == 3) {
	    result = Tk_ConfigureInfo(interp, squarePtr->tkwin, configSpecs,
		    (char *) squarePtr, argv[2], 0);
	} else {
	    result = SquareConfigure(interp, squarePtr, argc-2, argv+2,
		    TK_CONFIG_ARGV_ONLY);
	}
    } else if ((c == 'p') && (strncmp(argv[1], "position", length) == 0)) {
	if ((argc != 2) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " position ?x y?\"", (char *) NULL);
	    goto error;
	}


	if (argc == 4) {
	    if ((Tk_GetPixels(interp, squarePtr->tkwin, argv[2],
		    &squarePtr->x) != TCL_OK) || (Tk_GetPixels(interp,
		    squarePtr->tkwin, argv[3], &squarePtr->y) != TCL_OK)) {
		goto error;
	    }
	    KeepInWindow(squarePtr);
	}
	sprintf(interp->result, "%d %d", squarePtr->x, squarePtr->y);
    } else if ((c == 's') && (strncmp(argv[1], "size", length) == 0)) {
	if ((argc != 2) && (argc != 3)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " size ?amount?\"", (char *) NULL);
	    goto error;
	}
	if (argc == 3) {
	    int i;

	    if (Tk_GetPixels(interp, squarePtr->tkwin, argv[2], &i) != TCL_OK) {
		goto error;
	    }
	    if ((i <= 0) || (i > 100)) {
		Tcl_AppendResult(interp, "bad size \"", argv[2],
			"\"", (char *) NULL);
		goto error;
	    }
	    squarePtr->size = i;
	    KeepInWindow(squarePtr);
	}
	sprintf(interp->result, "%d", squarePtr->size);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be cget, configure, position, or size",

		(char *) NULL);
	goto error;


    }
    if (!squarePtr->updatePending) {
	Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
	squarePtr->updatePending = 1;






    }
    Tcl_Release((ClientData) squarePtr);
    return result;

    error:
    Tcl_Release((ClientData) squarePtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * SquareConfigure --
 *
 *	This procedure is called to process an argv/argc list in
 *	conjunction with the Tk option database to configure (or
 *	reconfigure) a square widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, border width,
 *	etc. get set for squarePtr;  old resources get freed,
 *	if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
SquareConfigure(interp, squarePtr, argc, argv, flags)
    Tcl_Interp *interp;			/* Used for error reporting. */
    Square *squarePtr;			/* Information about widget. */
    int argc;				/* Number of valid entries in argv. */
    char **argv;			/* Arguments. */
    int flags;				/* Flags to pass to
					 * Tk_ConfigureWidget. */
{
    if (Tk_ConfigureWidget(interp, squarePtr->tkwin, configSpecs,
	    argc, argv, (char *) squarePtr, flags) != TCL_OK) {
	return TCL_ERROR;
    }




    /*
     * Set the background for the window and create a graphics context
     * for use during redisplay.
     */



    Tk_SetWindowBackground(squarePtr->tkwin,
	    Tk_3DBorderColor(squarePtr->bgBorder)->pixel);

    if ((squarePtr->gc == None) && (squarePtr->doubleBuffer)) {
	XGCValues gcValues;
	gcValues.function = GXcopy;
	gcValues.graphics_exposures = False;
	squarePtr->gc = Tk_GetGC(squarePtr->tkwin,
		GCFunction|GCGraphicsExposures, &gcValues);
    }

    /*
     * Register the desired geometry for the window.  Then arrange for
     * the window to be redisplayed.
     */

    Tk_GeometryRequest(squarePtr->tkwin, 200, 150);


    Tk_SetInternalBorder(squarePtr->tkwin, squarePtr->borderWidth);
    if (!squarePtr->updatePending) {
	Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
	squarePtr->updatePending = 1;
    }

    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * SquareEventProc --
 *
 *	This procedure is invoked by the Tk dispatcher for various
 *	events on squares.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	When the window gets deleted, internal structures get
 *	cleaned up.  When it gets exposed, it is redisplayed.
 *
 *--------------------------------------------------------------
 */

static void
SquareEventProc(clientData, eventPtr)
    ClientData clientData;	/* Information about window. */
    XEvent *eventPtr;		/* Information about event. */
{
    Square *squarePtr = (Square *) clientData;

    if (eventPtr->type == Expose) {
	if (!squarePtr->updatePending) {
	    Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
	    squarePtr->updatePending = 1;
	}
    } else if (eventPtr->type == ConfigureNotify) {
	KeepInWindow(squarePtr);
	if (!squarePtr->updatePending) {
	    Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
	    squarePtr->updatePending = 1;
	}
    } else if (eventPtr->type == DestroyNotify) {
	if (squarePtr->tkwin != NULL) {





	    squarePtr->tkwin = NULL;
	    Tcl_DeleteCommandFromToken(squarePtr->interp,
		    squarePtr->widgetCmd);
	}
	if (squarePtr->updatePending) {
	    Tcl_CancelIdleCall(SquareDisplay, (ClientData) squarePtr);
	}
	Tcl_EventuallyFree((ClientData) squarePtr, SquareDestroy);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SquareCmdDeletedProc --
 *
 *	This procedure is invoked when a widget command is deleted.  If
 *	the widget isn't already in the process of being destroyed,
 *	this command destroys it.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The widget is destroyed.
 *
 *----------------------------------------------------------------------
 */

static void
SquareCmdDeletedProc(clientData)
    ClientData clientData;	/* Pointer to widget record for widget. */
{
    Square *squarePtr = (Square *) clientData;
    Tk_Window tkwin = squarePtr->tkwin;

    /*
     * This procedure could be invoked either because the window was
     * destroyed and the command was then deleted (in which case tkwin
     * is NULL) or because the command was deleted, and then this procedure
     * destroys the widget.
     */

    if (tkwin != NULL) {
	squarePtr->tkwin = NULL;
	Tk_DestroyWindow(tkwin);
    }
}

/*
 *--------------------------------------------------------------
 *







|


|
|



>
|
>
>
>
|

|
|
<


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

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




















|










|


<
<
<
<

<
<
<
<
>
>
>






>
>

|
>
|













>
>
|




>






|















|


















>
>
>
>
>














|















|













<







231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254

255
256
257
258



259

260


261
262
263
264
265
266

267
268
269
270
271
272
273
274

275
276

277




278
279
280
281
282
283
284
285


286

287





288
289

290
291




292


293

294

295
296

297
298

299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344




345




346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471

472
473
474
475
476
477
478
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
SquareWidgetCmd(clientData, interp, objc, objv)
    ClientData clientData;		/* Information about square widget. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int objc;				/* Number of arguments. */
    Tcl_Obj * CONST objv[];		/* Argument objects. */
{
    Square *squarePtr = (Square *) clientData;
    int result = TCL_OK;
    static char *squareOptions[] = {"cget", "configure", (char *) NULL};
    enum {
	SQUARE_CGET, SQUARE_CONFIGURE
    };
    Tcl_Obj *resultObjPtr;
    int index;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg...?");

	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], squareOptions, "command",



	    0, &index) != TCL_OK) {

	return TCL_ERROR;


    }

    Tcl_Preserve((ClientData) squarePtr);
    
    switch (index) {
	case SQUARE_CGET: {

	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "option");
		goto error;
	    }
	    resultObjPtr = Tk_GetOptionValue(interp, (char *) squarePtr,
		    squarePtr->optionTable, objv[2], squarePtr->tkwin);
	    if (resultObjPtr == NULL) {
		result = TCL_ERROR;

	    } else {
		Tcl_SetObjResult(interp, resultObjPtr);

	    }




	    break;
	}
	case SQUARE_CONFIGURE: {
	    resultObjPtr = NULL;
	    if (objc == 2) {
		resultObjPtr = Tk_GetOptionInfo(interp, (char *) squarePtr,
			squarePtr->optionTable, (Tcl_Obj *) NULL,
			squarePtr->tkwin);


		if (resultObjPtr == NULL) {

		    result = TCL_ERROR;





		}
	    } else if (objc == 3) {

		resultObjPtr = Tk_GetOptionInfo(interp, (char *) squarePtr,
			squarePtr->optionTable, objv[2], squarePtr->tkwin);




		if (resultObjPtr == NULL) {


		    result = TCL_ERROR;

		}

	    } else {
		result = Tk_SetOptions(interp, (char *) squarePtr,

			squarePtr->optionTable, objc - 2, objv + 2,
			squarePtr->tkwin, NULL, (int *) NULL);

		if (result == TCL_OK) {
		    result = SquareConfigure(interp, squarePtr);
		}
		if (!squarePtr->updatePending) {
		    Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
		    squarePtr->updatePending = 1;
		}
	    }
	    if (resultObjPtr != NULL) {
		Tcl_SetObjResult(interp, resultObjPtr);
	    }
	}
    }
    Tcl_Release((ClientData) squarePtr);
    return result;

    error:
    Tcl_Release((ClientData) squarePtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * SquareConfigure --
 *
 *	This procedure is called to process an argv/argc list in
 *	conjunction with the Tk option database to configure (or
 *	reconfigure) a square widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as colors, border width,
 *	etc. get set for squarePtr;  old resources get freed,
 *	if there were any.
 *
 *----------------------------------------------------------------------
 */

static int
SquareConfigure(interp, squarePtr)
    Tcl_Interp *interp;			/* Used for error reporting. */
    Square *squarePtr;			/* Information about widget. */




{




    int borderWidth;
    Tk_3DBorder bgBorder;
    int doubleBuffer;

    /*
     * Set the background for the window and create a graphics context
     * for use during redisplay.
     */

    bgBorder = Tk_Get3DBorderFromObj(squarePtr->tkwin, 
	    squarePtr->bgBorderPtr);
    Tk_SetWindowBackground(squarePtr->tkwin,
	    Tk_3DBorderColor(bgBorder)->pixel);
    Tcl_GetBooleanFromObj(NULL, squarePtr->doubleBufferPtr, &doubleBuffer);
    if ((squarePtr->gc == None) && (doubleBuffer)) {
	XGCValues gcValues;
	gcValues.function = GXcopy;
	gcValues.graphics_exposures = False;
	squarePtr->gc = Tk_GetGC(squarePtr->tkwin,
		GCFunction|GCGraphicsExposures, &gcValues);
    }

    /*
     * Register the desired geometry for the window.  Then arrange for
     * the window to be redisplayed.
     */

    Tk_GeometryRequest(squarePtr->tkwin, 200, 150);
    Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->borderWidthPtr,
	    &borderWidth);
    Tk_SetInternalBorder(squarePtr->tkwin, borderWidth);
    if (!squarePtr->updatePending) {
	Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
	squarePtr->updatePending = 1;
    }
    KeepInWindow(squarePtr);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * SquareObjEventProc --
 *
 *	This procedure is invoked by the Tk dispatcher for various
 *	events on squares.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	When the window gets deleted, internal structures get
 *	cleaned up.  When it gets exposed, it is redisplayed.
 *
 *--------------------------------------------------------------
 */

static void
SquareObjEventProc(clientData, eventPtr)
    ClientData clientData;	/* Information about window. */
    XEvent *eventPtr;		/* Information about event. */
{
    Square *squarePtr = (Square *) clientData;

    if (eventPtr->type == Expose) {
	if (!squarePtr->updatePending) {
	    Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
	    squarePtr->updatePending = 1;
	}
    } else if (eventPtr->type == ConfigureNotify) {
	KeepInWindow(squarePtr);
	if (!squarePtr->updatePending) {
	    Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
	    squarePtr->updatePending = 1;
	}
    } else if (eventPtr->type == DestroyNotify) {
	if (squarePtr->tkwin != NULL) {
	    Tk_FreeConfigOptions((char *) squarePtr, squarePtr->optionTable,
		    squarePtr->tkwin);
	    if (squarePtr->gc != None) {
		Tk_FreeGC(squarePtr->display, squarePtr->gc);
	    }
	    squarePtr->tkwin = NULL;
	    Tcl_DeleteCommandFromToken(squarePtr->interp,
		    squarePtr->widgetCmd);
	}
	if (squarePtr->updatePending) {
	    Tcl_CancelIdleCall(SquareDisplay, (ClientData) squarePtr);
	}
	Tcl_EventuallyFree((ClientData) squarePtr, SquareDestroy);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SquareDeletedProc --
 *
 *	This procedure is invoked when a widget command is deleted.  If
 *	the widget isn't already in the process of being destroyed,
 *	this command destroys it.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The widget is destroyed.
 *
 *----------------------------------------------------------------------
 */

static void
SquareDeletedProc(clientData)
    ClientData clientData;	/* Pointer to widget record for widget. */
{
    Square *squarePtr = (Square *) clientData;
    Tk_Window tkwin = squarePtr->tkwin;

    /*
     * This procedure could be invoked either because the window was
     * destroyed and the command was then deleted (in which case tkwin
     * is NULL) or because the command was deleted, and then this procedure
     * destroys the widget.
     */

    if (tkwin != NULL) {

	Tk_DestroyWindow(tkwin);
    }
}

/*
 *--------------------------------------------------------------
 *
462
463
464
465
466
467
468



469
470
471
472
473
474
475
476
477
478

479
480
481
482
483
484
485
486
487
488
489
490
491





492
493
494
495
496
497
498


499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
SquareDisplay(clientData)
    ClientData clientData;	/* Information about window. */
{
    Square *squarePtr = (Square *) clientData;
    Tk_Window tkwin = squarePtr->tkwin;
    Pixmap pm = None;
    Drawable d;




    squarePtr->updatePending = 0;
    if (!Tk_IsMapped(tkwin)) {
	return;
    }

    /*
     * Create a pixmap for double-buffering, if necessary.
     */


    if (squarePtr->doubleBuffer) {
	pm = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
		Tk_Width(tkwin), Tk_Height(tkwin),
		DefaultDepthOfScreen(Tk_Screen(tkwin)));
	d = pm;
    } else {
	d = Tk_WindowId(tkwin);
    }

    /*
     * Redraw the widget's background and border.
     */






    Tk_Fill3DRectangle(tkwin, d, squarePtr->bgBorder, 0, 0, Tk_Width(tkwin),
	    Tk_Height(tkwin), squarePtr->borderWidth, squarePtr->relief);

    /*
     * Display the square.
     */



    Tk_Fill3DRectangle(tkwin, d, squarePtr->fgBorder, squarePtr->x,
	    squarePtr->y, squarePtr->size, squarePtr->size,
	    squarePtr->borderWidth, TK_RELIEF_RAISED);

    /*
     * If double-buffered, copy to the screen and release the pixmap.
     */

    if (squarePtr->doubleBuffer) {
	XCopyArea(Tk_Display(tkwin), pm, Tk_WindowId(tkwin), squarePtr->gc,
		0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
		0, 0);
	Tk_FreePixmap(Tk_Display(tkwin), pm);
    }
}








>
>
>










>
|












>
>
>
>
>
|
|





>
>
|
|
|





|







495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
SquareDisplay(clientData)
    ClientData clientData;	/* Information about window. */
{
    Square *squarePtr = (Square *) clientData;
    Tk_Window tkwin = squarePtr->tkwin;
    Pixmap pm = None;
    Drawable d;
    int borderWidth, size, relief;
    Tk_3DBorder bgBorder, fgBorder;
    int doubleBuffer;

    squarePtr->updatePending = 0;
    if (!Tk_IsMapped(tkwin)) {
	return;
    }

    /*
     * Create a pixmap for double-buffering, if necessary.
     */

    Tcl_GetBooleanFromObj(NULL, squarePtr->doubleBufferPtr, &doubleBuffer);
    if (doubleBuffer) {
	pm = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
		Tk_Width(tkwin), Tk_Height(tkwin),
		DefaultDepthOfScreen(Tk_Screen(tkwin)));
	d = pm;
    } else {
	d = Tk_WindowId(tkwin);
    }

    /*
     * Redraw the widget's background and border.
     */

    Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->borderWidthPtr,
	    &borderWidth);
    bgBorder = Tk_Get3DBorderFromObj(squarePtr->tkwin, 
	    squarePtr->bgBorderPtr);
    Tk_GetReliefFromObj(NULL, squarePtr->reliefPtr, &relief);
    Tk_Fill3DRectangle(tkwin, d, bgBorder, 0, 0, Tk_Width(tkwin),
	    Tk_Height(tkwin), borderWidth, relief);

    /*
     * Display the square.
     */

    Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->sizeObjPtr, &size);
    fgBorder = Tk_Get3DBorderFromObj(squarePtr->tkwin, 
	    squarePtr->fgBorderPtr);
    Tk_Fill3DRectangle(tkwin, d, fgBorder, squarePtr->x, squarePtr->y, size, 
	    size, borderWidth, TK_RELIEF_RAISED);

    /*
     * If double-buffered, copy to the screen and release the pixmap.
     */

    if (doubleBuffer) {
	XCopyArea(Tk_Display(tkwin), pm, Tk_WindowId(tkwin), squarePtr->gc,
		0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
		0, 0);
	Tk_FreePixmap(Tk_Display(tkwin), pm);
    }
}

531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
 */

static void
SquareDestroy(memPtr)
    char *memPtr;		/* Info about square widget. */
{
    Square *squarePtr = (Square *) memPtr;

    Tk_FreeOptions(configSpecs, (char *) squarePtr, squarePtr->display, 0);
    if (squarePtr->gc != None) {
	Tk_FreeGC(squarePtr->display, squarePtr->gc);
    }
    ckfree((char *) squarePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * KeepInWindow --







|
<
<
<
<







575
576
577
578
579
580
581
582




583
584
585
586
587
588
589
 */

static void
SquareDestroy(memPtr)
    char *memPtr;		/* Info about square widget. */
{
    Square *squarePtr = (Square *) memPtr;
    




    ckfree((char *) squarePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * KeepInWindow --
561
562
563
564
565
566
567
568










569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
 *----------------------------------------------------------------------
 */

static void
KeepInWindow(squarePtr)
    register Square *squarePtr;		/* Pointer to widget record. */
{
    int i, bd;










    bd = 0;
    if (squarePtr->relief != TK_RELIEF_FLAT) {
	bd = squarePtr->borderWidth;
    }
    i = (Tk_Width(squarePtr->tkwin) - bd) - (squarePtr->x + squarePtr->size);
    if (i < 0) {
	squarePtr->x += i;
    }
    i = (Tk_Height(squarePtr->tkwin) - bd) - (squarePtr->y + squarePtr->size);
    if (i < 0) {
	squarePtr->y += i;
    }
    if (squarePtr->x < bd) {
	squarePtr->x = bd;
    }
    if (squarePtr->y < bd) {
	squarePtr->y = bd;
    }
}







|
>
>
>
>
>
>
>
>
>
>

|
|

|



|










601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
 *----------------------------------------------------------------------
 */

static void
KeepInWindow(squarePtr)
    register Square *squarePtr;		/* Pointer to widget record. */
{
    int i, bd, relief;
    int borderWidth, size;

    Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->borderWidthPtr,
	    &borderWidth);
    Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->xPtr, 
	    &squarePtr->x);
    Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->yPtr, 
	    &squarePtr->y);
    Tk_GetPixelsFromObj(NULL, squarePtr->tkwin, squarePtr->sizeObjPtr, &size);
    Tk_GetReliefFromObj(NULL, squarePtr->reliefPtr, &relief);
    bd = 0;
    if (relief != TK_RELIEF_FLAT) {
	bd = borderWidth;
    }
    i = (Tk_Width(squarePtr->tkwin) - bd) - (squarePtr->x + size);
    if (i < 0) {
	squarePtr->x += i;
    }
    i = (Tk_Height(squarePtr->tkwin) - bd) - (squarePtr->y + size);
    if (i < 0) {
	squarePtr->y += i;
    }
    if (squarePtr->x < bd) {
	squarePtr->x = bd;
    }
    if (squarePtr->y < bd) {
	squarePtr->y = bd;
    }
}

Added generic/tkStubInit.c.



































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
/* 
 * tkStubInit.c --
 *
 *	This file contains the initializers for the Tk stub vectors.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkStubInit.c,v 1.2.2.5 1999/04/06 02:48:29 redman Exp $
 */

#include "tkInt.h"
#include "tkPort.h"

#ifdef __WIN32__
#include "tkWinInt.h"
#endif

#include "tkDecls.h"
#include "tkPlatDecls.h"
#include "tkIntDecls.h"
#include "tkIntPlatDecls.h"
#include "tkIntXlibDecls.h"

/*
 * Remove macros that will interfere with the definitions below.
 */

/*
 * WARNING: The contents of this file is automatically generated by the
 * tools/genStubs.tcl script. Any modifications to the function declarations
 * below should be made in the generic/tk.decls script.
 */

/* !BEGIN!: Do not edit below this line. */

static TkStubHooks tkStubHooks;

TkStubs tkStubs = {
    TCL_STUB_MAGIC,
    &tkStubHooks,
    Tk_MainLoop, /* 0 */
    Tk_3DBorderColor, /* 1 */
    Tk_3DBorderGC, /* 2 */
    Tk_3DHorizontalBevel, /* 3 */
    Tk_3DVerticalBevel, /* 4 */
    Tk_AddOption, /* 5 */
    Tk_BindEvent, /* 6 */
    Tk_CanvasDrawableCoords, /* 7 */
    Tk_CanvasEventuallyRedraw, /* 8 */
    Tk_CanvasGetCoord, /* 9 */
    Tk_CanvasGetTextInfo, /* 10 */
    Tk_CanvasPsBitmap, /* 11 */
    Tk_CanvasPsColor, /* 12 */
    Tk_CanvasPsFont, /* 13 */
    Tk_CanvasPsPath, /* 14 */
    Tk_CanvasPsStipple, /* 15 */
    Tk_CanvasPsY, /* 16 */
    Tk_CanvasSetStippleOrigin, /* 17 */
    Tk_CanvasTagsParseProc, /* 18 */
    Tk_CanvasTagsPrintProc, /* 19 */
    Tk_CanvasTkwin, /* 20 */
    Tk_CanvasWindowCoords, /* 21 */
    Tk_ChangeWindowAttributes, /* 22 */
    Tk_CharBbox, /* 23 */
    Tk_ClearSelection, /* 24 */
    Tk_ClipboardAppend, /* 25 */
    Tk_ClipboardClear, /* 26 */
    Tk_ConfigureInfo, /* 27 */
    Tk_ConfigureValue, /* 28 */
    Tk_ConfigureWidget, /* 29 */
    Tk_ConfigureWindow, /* 30 */
    Tk_ComputeTextLayout, /* 31 */
    Tk_CoordsToWindow, /* 32 */
    Tk_CreateBinding, /* 33 */
    Tk_CreateBindingTable, /* 34 */
    Tk_CreateErrorHandler, /* 35 */
    Tk_CreateEventHandler, /* 36 */
    Tk_CreateGenericHandler, /* 37 */
    Tk_CreateImageType, /* 38 */
    Tk_CreateItemType, /* 39 */
    Tk_CreatePhotoImageFormat, /* 40 */
    Tk_CreateSelHandler, /* 41 */
    Tk_CreateWindow, /* 42 */
    Tk_CreateWindowFromPath, /* 43 */
    Tk_DefineBitmap, /* 44 */
    Tk_DefineCursor, /* 45 */
    Tk_DeleteAllBindings, /* 46 */
    Tk_DeleteBinding, /* 47 */
    Tk_DeleteBindingTable, /* 48 */
    Tk_DeleteErrorHandler, /* 49 */
    Tk_DeleteEventHandler, /* 50 */
    Tk_DeleteGenericHandler, /* 51 */
    Tk_DeleteImage, /* 52 */
    Tk_DeleteSelHandler, /* 53 */
    Tk_DestroyWindow, /* 54 */
    Tk_DisplayName, /* 55 */
    Tk_DistanceToTextLayout, /* 56 */
    Tk_Draw3DPolygon, /* 57 */
    Tk_Draw3DRectangle, /* 58 */
    Tk_DrawChars, /* 59 */
    Tk_DrawFocusHighlight, /* 60 */
    Tk_DrawTextLayout, /* 61 */
    Tk_Fill3DPolygon, /* 62 */
    Tk_Fill3DRectangle, /* 63 */
    Tk_FindPhoto, /* 64 */
    Tk_FontId, /* 65 */
    Tk_Free3DBorder, /* 66 */
    Tk_FreeBitmap, /* 67 */
    Tk_FreeColor, /* 68 */
    Tk_FreeColormap, /* 69 */
    Tk_FreeCursor, /* 70 */
    Tk_FreeFont, /* 71 */
    Tk_FreeGC, /* 72 */
    Tk_FreeImage, /* 73 */
    Tk_FreeOptions, /* 74 */
    Tk_FreePixmap, /* 75 */
    Tk_FreeTextLayout, /* 76 */
    Tk_FreeXId, /* 77 */
    Tk_GCForColor, /* 78 */
    Tk_GeometryRequest, /* 79 */
    Tk_Get3DBorder, /* 80 */
    Tk_GetAllBindings, /* 81 */
    Tk_GetAnchor, /* 82 */
    Tk_GetAtomName, /* 83 */
    Tk_GetBinding, /* 84 */
    Tk_GetBitmap, /* 85 */
    Tk_GetBitmapFromData, /* 86 */
    Tk_GetCapStyle, /* 87 */
    Tk_GetColor, /* 88 */
    Tk_GetColorByValue, /* 89 */
    Tk_GetColormap, /* 90 */
    Tk_GetCursor, /* 91 */
    Tk_GetCursorFromData, /* 92 */
    Tk_GetFont, /* 93 */
    Tk_GetFontFromObj, /* 94 */
    Tk_GetFontMetrics, /* 95 */
    Tk_GetGC, /* 96 */
    Tk_GetImage, /* 97 */
    Tk_GetImageMasterData, /* 98 */
    Tk_GetItemTypes, /* 99 */
    Tk_GetJoinStyle, /* 100 */
    Tk_GetJustify, /* 101 */
    Tk_GetNumMainWindows, /* 102 */
    Tk_GetOption, /* 103 */
    Tk_GetPixels, /* 104 */
    Tk_GetPixmap, /* 105 */
    Tk_GetRelief, /* 106 */
    Tk_GetRootCoords, /* 107 */
    Tk_GetScrollInfo, /* 108 */
    Tk_GetScreenMM, /* 109 */
    Tk_GetSelection, /* 110 */
    Tk_GetUid, /* 111 */
    Tk_GetVisual, /* 112 */
    Tk_GetVRootGeometry, /* 113 */
    Tk_Grab, /* 114 */
    Tk_HandleEvent, /* 115 */
    Tk_IdToWindow, /* 116 */
    Tk_ImageChanged, /* 117 */
    Tk_Init, /* 118 */
    Tk_InternAtom, /* 119 */
    Tk_IntersectTextLayout, /* 120 */
    Tk_MaintainGeometry, /* 121 */
    Tk_MainWindow, /* 122 */
    Tk_MakeWindowExist, /* 123 */
    Tk_ManageGeometry, /* 124 */
    Tk_MapWindow, /* 125 */
    Tk_MeasureChars, /* 126 */
    Tk_MoveResizeWindow, /* 127 */
    Tk_MoveWindow, /* 128 */
    Tk_MoveToplevelWindow, /* 129 */
    Tk_NameOf3DBorder, /* 130 */
    Tk_NameOfAnchor, /* 131 */
    Tk_NameOfBitmap, /* 132 */
    Tk_NameOfCapStyle, /* 133 */
    Tk_NameOfColor, /* 134 */
    Tk_NameOfCursor, /* 135 */
    Tk_NameOfFont, /* 136 */
    Tk_NameOfImage, /* 137 */
    Tk_NameOfJoinStyle, /* 138 */
    Tk_NameOfJustify, /* 139 */
    Tk_NameOfRelief, /* 140 */
    Tk_NameToWindow, /* 141 */
    Tk_OwnSelection, /* 142 */
    Tk_ParseArgv, /* 143 */
    Tk_PhotoPutBlock, /* 144 */
    Tk_PhotoPutZoomedBlock, /* 145 */
    Tk_PhotoGetImage, /* 146 */
    Tk_PhotoBlank, /* 147 */
    Tk_PhotoExpand, /* 148 */
    Tk_PhotoGetSize, /* 149 */
    Tk_PhotoSetSize, /* 150 */
    Tk_PointToChar, /* 151 */
    Tk_PostscriptFontName, /* 152 */
    Tk_PreserveColormap, /* 153 */
    Tk_QueueWindowEvent, /* 154 */
    Tk_RedrawImage, /* 155 */
    Tk_ResizeWindow, /* 156 */
    Tk_RestackWindow, /* 157 */
    Tk_RestrictEvents, /* 158 */
    Tk_SafeInit, /* 159 */
    Tk_SetAppName, /* 160 */
    Tk_SetBackgroundFromBorder, /* 161 */
    Tk_SetClass, /* 162 */
    Tk_SetGrid, /* 163 */
    Tk_SetInternalBorder, /* 164 */
    Tk_SetWindowBackground, /* 165 */
    Tk_SetWindowBackgroundPixmap, /* 166 */
    Tk_SetWindowBorder, /* 167 */
    Tk_SetWindowBorderWidth, /* 168 */
    Tk_SetWindowBorderPixmap, /* 169 */
    Tk_SetWindowColormap, /* 170 */
    Tk_SetWindowVisual, /* 171 */
    Tk_SizeOfBitmap, /* 172 */
    Tk_SizeOfImage, /* 173 */
    Tk_StrictMotif, /* 174 */
    Tk_TextLayoutToPostscript, /* 175 */
    Tk_TextWidth, /* 176 */
    Tk_UndefineCursor, /* 177 */
    Tk_UnderlineChars, /* 178 */
    Tk_UnderlineTextLayout, /* 179 */
    Tk_Ungrab, /* 180 */
    Tk_UnmaintainGeometry, /* 181 */
    Tk_UnmapWindow, /* 182 */
    Tk_UnsetGrid, /* 183 */
    Tk_UpdatePointer, /* 184 */
    Tk_AllocBitmapFromObj, /* 185 */
    Tk_Alloc3DBorderFromObj, /* 186 */
    Tk_AllocColorFromObj, /* 187 */
    Tk_AllocCursorFromObj, /* 188 */
    Tk_AllocFontFromObj, /* 189 */
    Tk_CreateOptionTable, /* 190 */
    Tk_DeleteOptionTable, /* 191 */
    Tk_Free3DBorderFromObj, /* 192 */
    Tk_FreeBitmapFromObj, /* 193 */
    Tk_FreeColorFromObj, /* 194 */
    Tk_FreeConfigOptions, /* 195 */
    Tk_FreeSavedOptions, /* 196 */
    Tk_FreeCursorFromObj, /* 197 */
    Tk_FreeFontFromObj, /* 198 */
    Tk_Get3DBorderFromObj, /* 199 */
    Tk_GetAnchorFromObj, /* 200 */
    Tk_GetBitmapFromObj, /* 201 */
    Tk_GetColorFromObj, /* 202 */
    Tk_GetCursorFromObj, /* 203 */
    Tk_GetOptionInfo, /* 204 */
    Tk_GetOptionValue, /* 205 */
    Tk_GetJustifyFromObj, /* 206 */
    Tk_GetMMFromObj, /* 207 */
    Tk_GetPixelsFromObj, /* 208 */
    Tk_GetReliefFromObj, /* 209 */
    Tk_GetScrollInfoObj, /* 210 */
    Tk_InitOptions, /* 211 */
    Tk_MainEx, /* 212 */
    Tk_RestoreSavedOptions, /* 213 */
    Tk_SetOptions, /* 214 */
};

TkIntStubs tkIntStubs = {
    TCL_STUB_MAGIC,
    NULL,
    TkAllocWindow, /* 0 */
    TkBezierPoints, /* 1 */
    TkBezierScreenPoints, /* 2 */
    TkBindDeadWindow, /* 3 */
    TkBindEventProc, /* 4 */
    TkBindFree, /* 5 */
    TkBindInit, /* 6 */
    TkChangeEventWindow, /* 7 */
    TkClipInit, /* 8 */
    TkComputeAnchor, /* 9 */
    TkCopyAndGlobalEval, /* 10 */
    TkCreateBindingProcedure, /* 11 */
    TkCreateCursorFromData, /* 12 */
    TkCreateFrame, /* 13 */
    TkCreateMainWindow, /* 14 */
    TkCurrentTime, /* 15 */
    TkDeleteAllImages, /* 16 */
    TkDoConfigureNotify, /* 17 */
    TkDrawInsetFocusHighlight, /* 18 */
    TkEventDeadWindow, /* 19 */
    TkFillPolygon, /* 20 */
    TkFindStateNum, /* 21 */
    TkFindStateString, /* 22 */
    TkFocusDeadWindow, /* 23 */
    TkFocusFilterEvent, /* 24 */
    TkFocusKeyEvent, /* 25 */
    TkFontPkgInit, /* 26 */
    TkFontPkgFree, /* 27 */
    TkFreeBindingTags, /* 28 */
    TkpFreeCursor, /* 29 */
    TkGetBitmapData, /* 30 */
    TkGetButtPoints, /* 31 */
    TkGetCursorByName, /* 32 */
    TkGetDefaultScreenName, /* 33 */
    TkGetDisplay, /* 34 */
    TkGetDisplayOf, /* 35 */
    TkGetFocusWin, /* 36 */
    TkGetInterpNames, /* 37 */
    TkGetMiterPoints, /* 38 */
    TkGetPointerCoords, /* 39 */
    TkGetServerInfo, /* 40 */
    TkGrabDeadWindow, /* 41 */
    TkGrabState, /* 42 */
    TkIncludePoint, /* 43 */
    TkInOutEvents, /* 44 */
    TkInstallFrameMenu, /* 45 */
    TkKeysymToString, /* 46 */
    TkLineToArea, /* 47 */
    TkLineToPoint, /* 48 */
    TkMakeBezierCurve, /* 49 */
    TkMakeBezierPostscript, /* 50 */
    TkOptionClassChanged, /* 51 */
    TkOptionDeadWindow, /* 52 */
    TkOvalToArea, /* 53 */
    TkOvalToPoint, /* 54 */
    TkpChangeFocus, /* 55 */
    TkpCloseDisplay, /* 56 */
    TkpClaimFocus, /* 57 */
    TkpDisplayWarning, /* 58 */
    TkpGetAppName, /* 59 */
    TkpGetOtherWindow, /* 60 */
    TkpGetWrapperWindow, /* 61 */
    TkpInit, /* 62 */
    TkpInitializeMenuBindings, /* 63 */
    TkpMakeContainer, /* 64 */
    TkpMakeMenuWindow, /* 65 */
    TkpMakeWindow, /* 66 */
    TkpMenuNotifyToplevelCreate, /* 67 */
    TkpOpenDisplay, /* 68 */
    TkPointerEvent, /* 69 */
    TkPolygonToArea, /* 70 */
    TkPolygonToPoint, /* 71 */
    TkPositionInTree, /* 72 */
    TkpRedirectKeyEvent, /* 73 */
    TkpSetMainMenubar, /* 74 */
    TkpUseWindow, /* 75 */
    TkpWindowWasRecentlyDeleted, /* 76 */
    TkQueueEventForAllChildren, /* 77 */
    TkReadBitmapFile, /* 78 */
    TkScrollWindow, /* 79 */
    TkSelDeadWindow, /* 80 */
    TkSelEventProc, /* 81 */
    TkSelInit, /* 82 */
    TkSelPropProc, /* 83 */
    TkSetClassProcs, /* 84 */
    TkSetWindowMenuBar, /* 85 */
    TkStringToKeysym, /* 86 */
    TkThickPolyLineToArea, /* 87 */
    TkWmAddToColormapWindows, /* 88 */
    TkWmDeadWindow, /* 89 */
    TkWmFocusToplevel, /* 90 */
    TkWmMapWindow, /* 91 */
    TkWmNewWindow, /* 92 */
    TkWmProtocolEventProc, /* 93 */
    TkWmRemoveFromColormapWindows, /* 94 */
    TkWmRestackToplevel, /* 95 */
    TkWmSetClass, /* 96 */
    TkWmUnmapWindow, /* 97 */
    TkDebugBitmap, /* 98 */
    TkDebugBorder, /* 99 */
    TkDebugCursor, /* 100 */
    TkDebugColor, /* 101 */
    TkDebugConfig, /* 102 */
    TkDebugFont, /* 103 */
    TkFindStateNumObj, /* 104 */
    TkGetBitmapPredefTable, /* 105 */
    TkGetDisplayList, /* 106 */
    TkGetMainInfoList, /* 107 */
    TkGetWindowFromObj, /* 108 */
    TkpGetString, /* 109 */
    TkpGetSubFonts, /* 110 */
    TkpGetSystemDefault, /* 111 */
    TkpMenuThreadInit, /* 112 */
};

TkIntPlatStubs tkIntPlatStubs = {
    TCL_STUB_MAGIC,
    NULL,
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
    TkCreateXEventSource, /* 0 */
    TkFreeWindowId, /* 1 */
    TkInitXId, /* 2 */
    TkpCmapStressed, /* 3 */
    TkpSync, /* 4 */
    TkUnixContainerId, /* 5 */
    TkUnixDoOneXEvent, /* 6 */
    TkUnixSetMenubar, /* 7 */
#endif /* UNIX */
#ifdef __WIN32__
    TkAlignImageData, /* 0 */
    TkClipBox, /* 1 */
    TkCreateRegion, /* 2 */
    TkDestroyRegion, /* 3 */
    TkGenerateActivateEvents, /* 4 */
    TkIntersectRegion, /* 5 */
    TkpGetMS, /* 6 */
    TkPointerDeadWindow, /* 7 */
    TkpPrintWindowId, /* 8 */
    TkpScanWindowId, /* 9 */
    TkpSetCapture, /* 10 */
    TkpSetCursor, /* 11 */
    TkpWmSetState, /* 12 */
    TkRectInRegion, /* 13 */
    TkSetPixmapColormap, /* 14 */
    TkSetRegion, /* 15 */
    TkUnionRectWithRegion, /* 16 */
    TkWinCancelMouseTimer, /* 17 */
    TkWinClipboardRender, /* 18 */
    TkWinEmbeddedEventProc, /* 19 */
    TkWinFillRect, /* 20 */
    TkWinGetBorderPixels, /* 21 */
    TkWinGetDrawableDC, /* 22 */
    TkWinGetModifierState, /* 23 */
    TkWinGetSystemPalette, /* 24 */
    TkWinGetWrapperWindow, /* 25 */
    TkWinHandleMenuEvent, /* 26 */
    TkWinIndexOfColor, /* 27 */
    TkWinReleaseDrawableDC, /* 28 */
    TkWinResendEvent, /* 29 */
    TkWinSelectPalette, /* 30 */
    TkWinSetMenu, /* 31 */
    TkWinSetWindowPos, /* 32 */
    TkWinWmCleanup, /* 33 */
    TkWinXCleanup, /* 34 */
    TkWinXInit, /* 35 */
    TkWinSetForegroundWindow, /* 36 */
    TkWinDialogDebug, /* 37 */
    TkWinGetMenuSystemDefault, /* 38 */
    TkWinGetPlatformId, /* 39 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    TkClipBox, /* 0 */
    TkCreateRegion, /* 1 */
    TkDestroyRegion, /* 2 */
    TkGenerateActivateEvents, /* 3 */
    TkIntersectRegion, /* 4 */
    TkpCreateNativeBitmap, /* 5 */
    TkpDefineNativeBitmaps, /* 6 */
    TkpGetMS, /* 7 */
    TkpGetNativeAppBitmap, /* 8 */
    TkPointerDeadWindow, /* 9 */
    TkpSetCapture, /* 10 */
    TkpSetCursor, /* 11 */
    TkpWmSetState, /* 12 */
    TkRectInRegion, /* 13 */
    TkSetRegion, /* 14 */
    TkUnionRectWithRegion, /* 15 */
    HandleWMEvent, /* 16 */
    TkAboutDlg, /* 17 */
    TkCreateMacEventSource, /* 18 */
    TkFontList, /* 19 */
    TkGetTransientMaster, /* 20 */
    TkGenerateButtonEvent, /* 21 */
    TkGetCharPositions, /* 22 */
    TkGenWMDestroyEvent, /* 23 */
    TkGenWMConfigureEvent, /* 24 */
    TkMacButtonKeyState, /* 25 */
    TkMacClearMenubarActive, /* 26 */
    TkMacConvertEvent, /* 27 */
    TkMacDispatchMenuEvent, /* 28 */
    TkMacInstallCursor, /* 29 */
    TkMacConvertTkEvent, /* 30 */
    TkMacHandleTearoffMenu, /* 31 */
    tkMacInstallMWConsole, /* 32 */
    TkMacInvalClipRgns, /* 33 */
    TkMacDoHLEvent, /* 34 */
    TkMacFontInfo, /* 35 */
    TkMacGenerateTime, /* 36 */
    TkMacGetDrawablePort, /* 37 */
    TkMacGetScrollbarGrowWindow, /* 38 */
    TkMacGetXWindow, /* 39 */
    TkMacGrowToplevel, /* 40 */
    TkMacHandleMenuSelect, /* 41 */
    TkMacHaveAppearance, /* 42 */
    TkMacInitAppleEvents, /* 43 */
    TkMacInitMenus, /* 44 */
    TkMacInvalidateWindow, /* 45 */
    TkMacIsCharacterMissing, /* 46 */
    TkMacMakeRealWindowExist, /* 47 */
    TkMacMakeStippleMap, /* 48 */
    TkMacMenuClick, /* 49 */
    TkMacRegisterOffScreenWindow, /* 50 */
    TkMacResizable, /* 51 */
    TkMacSetEmbedRgn, /* 52 */
    TkMacSetHelpMenuItemCount, /* 53 */
    TkMacSetScrollbarGrow, /* 54 */
    TkMacSetUpClippingRgn, /* 55 */
    TkMacSetUpGraphicsPort, /* 56 */
    TkMacUpdateClipRgn, /* 57 */
    TkMacUnregisterMacWindow, /* 58 */
    TkMacUseMenuID, /* 59 */
    TkMacVisableClipRgn, /* 60 */
    TkMacWinBounds, /* 61 */
    TkMacWindowOffset, /* 62 */
    TkResumeClipboard, /* 63 */
    TkSetMacColor, /* 64 */
    TkSetWMName, /* 65 */
    TkSuspendClipboard, /* 66 */
    TkWMGrowToplevel, /* 67 */
    TkMacZoomToplevel, /* 68 */
    Tk_TopCoordsToWindow, /* 69 */
    TkMacContainerId, /* 70 */
    TkMacGetHostToplevel, /* 71 */
#endif /* MAC_TCL */
};

TkIntXlibStubs tkIntXlibStubs = {
    TCL_STUB_MAGIC,
    NULL,
#ifdef __WIN32__
    NULL, /* 0 */
    XGetModifierMapping, /* 1 */
    XCreateImage, /* 2 */
    XGetImage, /* 3 */
    XGetAtomName, /* 4 */
    XKeysymToString, /* 5 */
    XCreateColormap, /* 6 */
    XCreatePixmapCursor, /* 7 */
    XCreateGlyphCursor, /* 8 */
    XGContextFromGC, /* 9 */
    XListHosts, /* 10 */
    XKeycodeToKeysym, /* 11 */
    XStringToKeysym, /* 12 */
    XRootWindow, /* 13 */
    XSetErrorHandler, /* 14 */
    XIconifyWindow, /* 15 */
    XWithdrawWindow, /* 16 */
    XGetWMColormapWindows, /* 17 */
    XAllocColor, /* 18 */
    XBell, /* 19 */
    XChangeProperty, /* 20 */
    XChangeWindowAttributes, /* 21 */
    XClearWindow, /* 22 */
    XConfigureWindow, /* 23 */
    XCopyArea, /* 24 */
    XCopyPlane, /* 25 */
    XCreateBitmapFromData, /* 26 */
    XDefineCursor, /* 27 */
    XDeleteProperty, /* 28 */
    XDestroyWindow, /* 29 */
    XDrawArc, /* 30 */
    XDrawLines, /* 31 */
    XDrawRectangle, /* 32 */
    XFillArc, /* 33 */
    XFillPolygon, /* 34 */
    XFillRectangles, /* 35 */
    XForceScreenSaver, /* 36 */
    XFreeColormap, /* 37 */
    XFreeColors, /* 38 */
    XFreeCursor, /* 39 */
    XFreeModifiermap, /* 40 */
    XGetGeometry, /* 41 */
    XGetInputFocus, /* 42 */
    XGetWindowProperty, /* 43 */
    XGetWindowAttributes, /* 44 */
    XGrabKeyboard, /* 45 */
    XGrabPointer, /* 46 */
    XKeysymToKeycode, /* 47 */
    XLookupColor, /* 48 */
    XMapWindow, /* 49 */
    XMoveResizeWindow, /* 50 */
    XMoveWindow, /* 51 */
    XNextEvent, /* 52 */
    XPutBackEvent, /* 53 */
    XQueryColors, /* 54 */
    XQueryPointer, /* 55 */
    XQueryTree, /* 56 */
    XRaiseWindow, /* 57 */
    XRefreshKeyboardMapping, /* 58 */
    XResizeWindow, /* 59 */
    XSelectInput, /* 60 */
    XSendEvent, /* 61 */
    XSetCommand, /* 62 */
    XSetIconName, /* 63 */
    XSetInputFocus, /* 64 */
    XSetSelectionOwner, /* 65 */
    XSetWindowBackground, /* 66 */
    XSetWindowBackgroundPixmap, /* 67 */
    XSetWindowBorder, /* 68 */
    XSetWindowBorderPixmap, /* 69 */
    XSetWindowBorderWidth, /* 70 */
    XSetWindowColormap, /* 71 */
    XTranslateCoordinates, /* 72 */
    XUngrabKeyboard, /* 73 */
    XUngrabPointer, /* 74 */
    XUnmapWindow, /* 75 */
    XWindowEvent, /* 76 */
    XDestroyIC, /* 77 */
    XFilterEvent, /* 78 */
    XmbLookupString, /* 79 */
    TkPutImage, /* 80 */
    NULL, /* 81 */
    XParseColor, /* 82 */
    XCreateGC, /* 83 */
    XFreeGC, /* 84 */
    XInternAtom, /* 85 */
    XSetBackground, /* 86 */
    XSetForeground, /* 87 */
    XSetClipMask, /* 88 */
    XSetClipOrigin, /* 89 */
    XSetTSOrigin, /* 90 */
    XChangeGC, /* 91 */
    XSetFont, /* 92 */
    XSetArcMode, /* 93 */
    XSetStipple, /* 94 */
    XSetFillRule, /* 95 */
    XSetFillStyle, /* 96 */
    XSetFunction, /* 97 */
    XSetLineAttributes, /* 98 */
    _XInitImageFuncPtrs, /* 99 */
    XCreateIC, /* 100 */
    XGetVisualInfo, /* 101 */
    XSetWMClientMachine, /* 102 */
    XStringListToTextProperty, /* 103 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    NULL, /* 0 */
    XGetModifierMapping, /* 1 */
    XCreateImage, /* 2 */
    XGetImage, /* 3 */
    XGetAtomName, /* 4 */
    XKeysymToString, /* 5 */
    XCreateColormap, /* 6 */
    XGContextFromGC, /* 7 */
    XKeycodeToKeysym, /* 8 */
    XStringToKeysym, /* 9 */
    XRootWindow, /* 10 */
    XSetErrorHandler, /* 11 */
    XAllocColor, /* 12 */
    XBell, /* 13 */
    XChangeProperty, /* 14 */
    XChangeWindowAttributes, /* 15 */
    XConfigureWindow, /* 16 */
    XCopyArea, /* 17 */
    XCopyPlane, /* 18 */
    XCreateBitmapFromData, /* 19 */
    XDefineCursor, /* 20 */
    XDestroyWindow, /* 21 */
    XDrawArc, /* 22 */
    XDrawLines, /* 23 */
    XDrawRectangle, /* 24 */
    XFillArc, /* 25 */
    XFillPolygon, /* 26 */
    XFillRectangles, /* 27 */
    XFreeColormap, /* 28 */
    XFreeColors, /* 29 */
    XFreeModifiermap, /* 30 */
    XGetGeometry, /* 31 */
    XGetWindowProperty, /* 32 */
    XGrabKeyboard, /* 33 */
    XGrabPointer, /* 34 */
    XKeysymToKeycode, /* 35 */
    XMapWindow, /* 36 */
    XMoveResizeWindow, /* 37 */
    XMoveWindow, /* 38 */
    XQueryPointer, /* 39 */
    XRaiseWindow, /* 40 */
    XRefreshKeyboardMapping, /* 41 */
    XResizeWindow, /* 42 */
    XSelectInput, /* 43 */
    XSendEvent, /* 44 */
    XSetIconName, /* 45 */
    XSetInputFocus, /* 46 */
    XSetSelectionOwner, /* 47 */
    XSetWindowBackground, /* 48 */
    XSetWindowBackgroundPixmap, /* 49 */
    XSetWindowBorder, /* 50 */
    XSetWindowBorderPixmap, /* 51 */
    XSetWindowBorderWidth, /* 52 */
    XSetWindowColormap, /* 53 */
    XUngrabKeyboard, /* 54 */
    XUngrabPointer, /* 55 */
    XUnmapWindow, /* 56 */
    TkPutImage, /* 57 */
    XParseColor, /* 58 */
    XCreateGC, /* 59 */
    XFreeGC, /* 60 */
    XInternAtom, /* 61 */
    XSetBackground, /* 62 */
    XSetForeground, /* 63 */
    XSetClipMask, /* 64 */
    XSetClipOrigin, /* 65 */
    XSetTSOrigin, /* 66 */
    XChangeGC, /* 67 */
    XSetFont, /* 68 */
    XSetArcMode, /* 69 */
    XSetStipple, /* 70 */
    XSetFillRule, /* 71 */
    XSetFillStyle, /* 72 */
    XSetFunction, /* 73 */
    XSetLineAttributes, /* 74 */
    _XInitImageFuncPtrs, /* 75 */
    XCreateIC, /* 76 */
    XGetVisualInfo, /* 77 */
    XSetWMClientMachine, /* 78 */
    XStringListToTextProperty, /* 79 */
#endif /* MAC_TCL */
};

TkPlatStubs tkPlatStubs = {
    TCL_STUB_MAGIC,
    NULL,
#ifdef __WIN32__
    Tk_AttachHWND, /* 0 */
    Tk_GetHINSTANCE, /* 1 */
    Tk_GetHWND, /* 2 */
    Tk_HWNDToWindow, /* 3 */
    Tk_PointerEvent, /* 4 */
    Tk_TranslateWinEvent, /* 5 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
    Tk_MacSetEmbedHandler, /* 0 */
    Tk_MacTurnOffMenus, /* 1 */
    Tk_MacTkOwnsCursor, /* 2 */
    TkMacInitMenus, /* 3 */
    TkMacInitAppleEvents, /* 4 */
    TkMacConvertEvent, /* 5 */
    TkMacConvertTkEvent, /* 6 */
    TkGenWMConfigureEvent, /* 7 */
    TkMacInvalClipRgns, /* 8 */
    TkMacHaveAppearance, /* 9 */
    TkMacGetDrawablePort, /* 10 */
#endif /* MAC_TCL */
};

static TkStubHooks tkStubHooks = {
    &tkPlatStubs,
    &tkIntStubs,
    &tkIntPlatStubs,
    &tkIntXlibStubs
};


/* !END!: Do not edit above this line. */

Added generic/tkStubLib.c.























































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
/* 
 * tkStubLib.c --
 *
 *	Stub object that will be statically linked into extensions that wish
 *	to access Tk.
 *
 * Copyright (c) 1998 Paul Duffin.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkStubLib.c,v 1.2.2.2 1999/03/14 19:26:03 stanton Exp $
 */

/*
 * We need to ensure that we use the stub macros so that this file contains
 * no references to any of the stub functions.  This will make it possible
 * to build an extension that references Tk_InitStubs but doesn't end up
 * including the rest of the stub functions.
 */


#ifndef USE_TCL_STUBS
#define USE_TCL_STUBS
#endif
#undef USE_TCL_STUB_PROCS

#ifndef USE_TK_STUBS
#define USE_TK_STUBS
#endif
#undef USE_TK_STUB_PROCS

#include "tkInt.h"
#include "tkPort.h"

#ifdef __WIN32__
#include "tkWinInt.h"
#endif

#include "tkDecls.h"
#include "tkIntDecls.h"
#include "tkPlatDecls.h"
#include "tkIntPlatDecls.h"
#include "tkIntXlibDecls.h"

/*
 * Ensure that Tk_InitStubs is built as an exported symbol.  The other stub
 * functions should be built as non-exported symbols.
 */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT

TkStubs *tkStubsPtr;
TkPlatStubs *tkPlatStubsPtr;
TkIntStubs *tkIntStubsPtr;
TkIntPlatStubs *tkIntPlatStubsPtr;
TkIntXlibStubs *tkIntXlibStubsPtr;


/*
 *----------------------------------------------------------------------
 *
 * Tk_InitStubs --
 *
 *	Checks that the correct version of Tk is loaded and that it
 *	supports stubs. It then initialises the stub table pointers.
 *
 * Results:
 *	The actual version of Tk that satisfies the request, or
 *	NULL to indicate that an error occurred.
 *
 * Side effects:
 *	Sets the stub table pointers.
 *
 *----------------------------------------------------------------------
 */

char *
Tk_InitStubs(interp, version, exact)
    Tcl_Interp *interp;
    char *version;
    int exact;
{
    char *actualVersion;

    actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, exact,
		(ClientData *) &tkStubsPtr);
    if (!actualVersion) {
	return NULL;
    }

    if (!tkStubsPtr) {
	Tcl_SetResult(interp,
		"This implementation of Tk does not support stubs",
		TCL_STATIC);
	return NULL;
    }
    
    tkPlatStubsPtr = tkStubsPtr->hooks->tkPlatStubs;
    tkIntStubsPtr = tkStubsPtr->hooks->tkIntStubs;
    tkIntPlatStubsPtr = tkStubsPtr->hooks->tkIntPlatStubs;
    tkIntXlibStubsPtr = tkStubsPtr->hooks->tkIntXlibStubs;
    
    return actualVersion;
}

Changes to generic/tkTest.c.

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
/* 
 * tkTest.c --
 *
 *	This file contains C command procedures for a bunch of additional
 *	Tcl commands that are used for testing out Tcl's C interfaces.
 *	These commands are not normally included in Tcl applications;
 *	they're only used for testing.
 *
 * Copyright (c) 1993-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkTest.c 1.50 97/11/06 16:56:32
 */

#include "tkInt.h"
#include "tkPort.h"	


#ifdef __WIN32__
#include "tkWinInt.h"
#endif

#ifdef MAC_TCL
#include "tkScrollbar.h"










>




|



|
>







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
/* 
 * tkTest.c --
 *
 *	This file contains C command procedures for a bunch of additional
 *	Tcl commands that are used for testing out Tcl's C interfaces.
 *	These commands are not normally included in Tcl applications;
 *	they're only used for testing.
 *
 * Copyright (c) 1993-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkTest.c,v 1.1.4.4 1999/03/09 01:56:01 lfb Exp $
 */

#include "tkInt.h"
#include "tkPort.h"
#include "tkText.h"

#ifdef __WIN32__
#include "tkWinInt.h"
#endif

#ifdef MAC_TCL
#include "tkScrollbar.h"
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
static NewApp *newAppPtr = NULL;
				/* First in list of all new interpreters. */

/*
 * Declaration for the square widget's class command procedure:
 */

extern int SquareCmd _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, int argc, char *argv[]));

typedef struct CBinding {
    Tcl_Interp *interp;
    char *command;
    char *delete;
} CBinding;



























/*
 * Forward declarations for procedures defined later in this file:
 */

static int		CBindingEvalProc _ANSI_ARGS_((ClientData clientData, 
			    Tcl_Interp *interp, XEvent *eventPtr,
			    Tk_Window tkwin, KeySym keySym));
static void		CBindingFreeProc _ANSI_ARGS_((ClientData clientData));
int			Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
static int		ImageCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
static int		TestcbindCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
#ifdef __WIN32__





static int		TestclipboardCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
#endif




static int		TestdeleteappsCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));



static int		TestmakeexistCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
static int		TestmenubarCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
#if defined(__WIN32__) || defined(MAC_TCL)
static int		TestmetricsCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
#endif





static int		TestsendCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
static int		TestpropCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
#if !(defined(__WIN32__) || defined(MAC_TCL))
static int		TestwrapperCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
#endif








/*
 * External (platform specific) initialization routine:
 */

EXTERN int		TkplatformtestInit _ANSI_ARGS_((
			    Tcl_Interp *interp));

#ifndef MAC_TCL

#define TkplatformtestInit(x) TCL_OK
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tktest_Init --
 *
 *	This procedure performs intialization for the Tk test
 *	suite exensions.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error
 *	message in interp->result if an error occurs.
 *
 * Side effects:
 *	Creates several test commands.
 *
 *----------------------------------------------------------------------
 */








|
|






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














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


>
>
>








>
>
>
>
>


|





>
>
>
>
>
>
>





|

>
|
>













|







100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162

163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
static NewApp *newAppPtr = NULL;
				/* First in list of all new interpreters. */

/*
 * Declaration for the square widget's class command procedure:
 */

extern int SquareObjCmd _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));

typedef struct CBinding {
    Tcl_Interp *interp;
    char *command;
    char *delete;
} CBinding;

/*
 * Header for trivial configuration command items.
 */

#define ODD TK_CONFIG_USER_BIT
#define EVEN (TK_CONFIG_USER_BIT << 1)

enum {
    NONE,
    ODD_TYPE, 
    EVEN_TYPE
};

typedef struct TrivialCommandHeader {
    Tcl_Interp *interp;			/* The interp that this command 
					 * lives in. */
    Tk_OptionTable optionTable;		/* The option table that go with
					 * this command. */
    Tk_Window tkwin;			/* For widgets, the window associated
					 * with this widget. */
    Tcl_Command widgetCmd;		/* For widgets, the command associated
					 * with this widget. */
} TrivialCommandHeader;



/*
 * Forward declarations for procedures defined later in this file:
 */

static int		CBindingEvalProc _ANSI_ARGS_((ClientData clientData, 
			    Tcl_Interp *interp, XEvent *eventPtr,
			    Tk_Window tkwin, KeySym keySym));
static void		CBindingFreeProc _ANSI_ARGS_((ClientData clientData));
int			Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
static int		ImageCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
static int		TestcbindCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
static int		TestbitmapObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * CONST objv[]));
static int		TestborderObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * CONST objv[]));
static int		TestcolorObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,

			    Tcl_Obj * CONST objv[]));
static int		TestcursorObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * CONST objv[]));
static int		TestdeleteappsCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
static int		TestfontObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
static int		TestmakeexistCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
static int		TestmenubarCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
#if defined(__WIN32__) || defined(MAC_TCL)
static int		TestmetricsCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
#endif
static int		TestobjconfigObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * CONST objv[]));
static int		TestpropCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
static int		TestsendCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
static int		TesttextCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
#if !(defined(__WIN32__) || defined(MAC_TCL))
static int		TestwrapperCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
#endif
static void		TrivialCmdDeletedProc _ANSI_ARGS_((
			    ClientData clientData));
static int		TrivialConfigObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * CONST objv[]));
static void		TrivialEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));

/*
 * External (platform specific) initialization routine:
 */

extern int		TkplatformtestInit _ANSI_ARGS_((
			    Tcl_Interp *interp));
extern int              TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));

#if !(defined(__WIN32__) || defined(MAC_TCL))
#define TkplatformtestInit(x) TCL_OK
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tktest_Init --
 *
 *	This procedure performs intialization for the Tk test
 *	suite exensions.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error
 *	message in the interp's result if an error occurs.
 *
 * Side effects:
 *	Creates several test commands.
 *
 *----------------------------------------------------------------------
 */

185
186
187
188
189
190
191


192
193
194




195
196
197
198
199
200
201
202




203
204
205
206
207
208
209
210
211
212
213
214
215


216
217
218
219
220






221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
     * Create additional commands for testing Tk.
     */

    if (Tcl_PkgProvide(interp, "Tktest", TK_VERSION) == TCL_ERROR) {
        return TCL_ERROR;
    }



    Tcl_CreateCommand(interp, "square", SquareCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
#ifdef __WIN32__




    Tcl_CreateCommand(interp, "testclipboard", TestclipboardCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
#endif
    Tcl_CreateCommand(interp, "testcbind", TestcbindCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "testdeleteapps", TestdeleteappsCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "testembed", TkpTestembedCmd,




	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "testmakeexist", TestmakeexistCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "testmenubar", TestmenubarCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
#if defined(__WIN32__) || defined(MAC_TCL)
    Tcl_CreateCommand(interp, "testmetrics", TestmetricsCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
#endif
    Tcl_CreateCommand(interp, "testprop", TestpropCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "testsend", TestsendCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);


#if !(defined(__WIN32__) || defined(MAC_TCL))
    Tcl_CreateCommand(interp, "testwrapper", TestwrapperCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
#endif







/*
     * Create test image type.
     */

    if (!initialized) {
	initialized = 1;
	Tk_CreateImageType(&imageType);
    }

    /*
     * And finally add any platform specific test commands.
     */
    
    return TkplatformtestInit(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * TestclipboardCmd --
 *
 *	This procedure implements the testclipboard command. It provides
 *	a way to determine the actual contents of the Windows clipboard.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifdef __WIN32__
static int
TestclipboardCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    TkWindow *winPtr = (TkWindow *) clientData;
    HGLOBAL handle;
    char *data;

    if (OpenClipboard(NULL)) {
	handle = GetClipboardData(CF_TEXT);
	if (handle != NULL) {
	    data = GlobalLock(handle);
	    Tcl_AppendResult(interp, data, (char *) NULL);
	    GlobalUnlock(handle);
	}
	CloseClipboard();
    }
    return TCL_OK;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TestcbindCmd --
 *
 *	This procedure implements the "testcbinding" command.  It provides
 *	a set of functions for testing C bindings in tkBind.c.







>
>
|

<
>
>
>
>
|

<
|




>
>
>
>













>
>





>
>
>
>
>
>
|















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







238
239
240
241
242
243
244
245
246
247
248

249
250
251
252
253
254

255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305










































306
307
308
309
310
311
312
     * Create additional commands for testing Tk.
     */

    if (Tcl_PkgProvide(interp, "Tktest", TK_VERSION) == TCL_ERROR) {
        return TCL_ERROR;
    }

    Tcl_CreateObjCommand(interp, "square", SquareObjCmd,
	    (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "testcbind", TestcbindCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateObjCommand(interp, "testbitmap", TestbitmapObjCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "testborder", TestborderObjCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "testcolor", TestcolorObjCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateObjCommand(interp, "testcursor", TestcursorObjCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "testdeleteapps", TestdeleteappsCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "testembed", TkpTestembedCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "testobjconfig", TestobjconfigObjCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "testfont", TestfontObjCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "testmakeexist", TestmakeexistCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "testmenubar", TestmenubarCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
#if defined(__WIN32__) || defined(MAC_TCL)
    Tcl_CreateCommand(interp, "testmetrics", TestmetricsCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
#endif
    Tcl_CreateCommand(interp, "testprop", TestpropCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "testsend", TestsendCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "testtext", TesttextCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
#if !(defined(__WIN32__) || defined(MAC_TCL))
    Tcl_CreateCommand(interp, "testwrapper", TestwrapperCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
#endif

#ifdef TCL_THREADS
    if (TclThread_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
#endif
    
    /*
     * Create test image type.
     */

    if (!initialized) {
	initialized = 1;
	Tk_CreateImageType(&imageType);
    }

    /*
     * And finally add any platform specific test commands.
     */
    
    return TkplatformtestInit(interp);
}











































/*
 *----------------------------------------------------------------------
 *
 * TestcbindCmd --
 *
 *	This procedure implements the "testcbinding" command.  It provides
 *	a set of functions for testing C bindings in tkBind.c.
382
383
384
385
386
387
388












































































































































389
390
391
392
393
394
395
    ckfree((char *) cbindPtr->command);
    ckfree((char *) cbindPtr);
}

/*
 *----------------------------------------------------------------------
 *












































































































































 * TestdeleteappsCmd --
 *
 *	This procedure implements the "testdeleteapps" command.  It cleans
 *	up all the interpreters left behind by the "testnewapp" command.
 *
 * Results:
 *	A standard Tcl result.







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







409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
    ckfree((char *) cbindPtr->command);
    ckfree((char *) cbindPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TestbitmapObjCmd --
 *
 *	This procedure implements the "testbitmap" command, which is used
 *	to test color resource handling in tkBitmap tmp.c.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestbitmapObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window for application. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "bitmap");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TkDebugBitmap(Tk_MainWindow(interp),
	    Tcl_GetString(objv[1])));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestborderObjCmd --
 *
 *	This procedure implements the "testborder" command, which is used
 *	to test color resource handling in tkBorder.c.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestborderObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window for application. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "border");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TkDebugBorder(Tk_MainWindow(interp),
	    Tcl_GetString(objv[1])));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestcolorObjCmd --
 *
 *	This procedure implements the "testcolor" command, which is used
 *	to test color resource handling in tkColor.c.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestcolorObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window for application. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "color");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TkDebugColor(Tk_MainWindow(interp),
	    Tcl_GetString(objv[1])));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestcursorObjCmd --
 *
 *	This procedure implements the "testcursor" command, which is used
 *	to test color resource handling in tkCursor.c.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestcursorObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window for application. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "cursor");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TkDebugCursor(Tk_MainWindow(interp),
	    Tcl_GetString(objv[1])));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestdeleteappsCmd --
 *
 *	This procedure implements the "testdeleteapps" command.  It cleans
 *	up all the interpreters left behind by the "testnewapp" command.
 *
 * Results:
 *	A standard Tcl result.
413
414
415
416
417
418
419






















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































420
421
422
423
424
425
426

    while (newAppPtr != NULL) {
	nextPtr = newAppPtr->nextPtr;
	Tcl_DeleteInterp(newAppPtr->interp);
	ckfree((char *) newAppPtr);
	newAppPtr = nextPtr;
    }























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







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







580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543

    while (newAppPtr != NULL) {
	nextPtr = newAppPtr->nextPtr;
	Tcl_DeleteInterp(newAppPtr->interp);
	ckfree((char *) newAppPtr);
	newAppPtr = nextPtr;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestobjconfigObjCmd --
 *
 *	This procedure implements the "testobjconfig" command,
 *	which is used to test the procedures in tkConfig.c.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestobjconfigObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window for application. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    static char *options[] = {"alltypes", "chain1", "chain2",
	    "configerror", "delete", "info", "internal", "new",
	    "notenoughparams", "twowindows", (char *) NULL};
    enum {
	ALL_TYPES,
	CHAIN1,
	CHAIN2,
	CONFIG_ERROR,
	DEL,			/* Can't use DELETE: VC++ compiler barfs. */
	INFO,
	INTERNAL,
	NEW,
	NOT_ENOUGH_PARAMS,
	TWO_WINDOWS
    };
    static Tk_OptionTable tables[11];	/* Holds pointers to option tables
					 * created by commands below; indexed
					 * with same values as "options"
					 * array. */
    Tk_Window mainWin = (Tk_Window) clientData;
    Tk_Window tkwin;
    int index, result = TCL_OK;

    /*
     * Structures used by the "chain1" subcommand and also shared by
     * the "chain2" subcommand:
     */

    typedef struct ExtensionWidgetRecord {
	TrivialCommandHeader header;
	Tcl_Obj *base1ObjPtr;
	Tcl_Obj *base2ObjPtr;
	Tcl_Obj *extension3ObjPtr;
	Tcl_Obj *extension4ObjPtr;
	Tcl_Obj *extension5ObjPtr;
    } ExtensionWidgetRecord;
    static Tk_OptionSpec baseSpecs[] = {
	{TK_OPTION_STRING,
		"-one", "one", "One", "one",
		Tk_Offset(ExtensionWidgetRecord, base1ObjPtr), -1},
	{TK_OPTION_STRING,
		"-two", "two", "Two", "two",
		Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1},
	{TK_OPTION_END}
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0, &index)
	    != TCL_OK) {
	return TCL_ERROR;
    }

    switch (index) {
	case ALL_TYPES: {
	    typedef struct TypesRecord {
		TrivialCommandHeader header;
		Tcl_Obj *booleanPtr;
		Tcl_Obj *integerPtr;
		Tcl_Obj *doublePtr;
		Tcl_Obj *stringPtr;
		Tcl_Obj *stringTablePtr;
		Tcl_Obj *colorPtr;
		Tcl_Obj *fontPtr;
		Tcl_Obj *bitmapPtr;
		Tcl_Obj *borderPtr;
		Tcl_Obj *reliefPtr;
		Tcl_Obj *cursorPtr;
		Tcl_Obj *activeCursorPtr;
		Tcl_Obj *justifyPtr;
		Tcl_Obj *anchorPtr;
		Tcl_Obj *pixelPtr;
		Tcl_Obj *mmPtr;
	    } TypesRecord;
	    TypesRecord *recordPtr;
	    static char *stringTable[] = {"one", "two", "three", "four", 
		    (char *) NULL};
	    static Tk_OptionSpec typesSpecs[] = {
		{TK_OPTION_BOOLEAN,
			"-boolean", "boolean", "Boolean",
			"1", Tk_Offset(TypesRecord, booleanPtr), -1, 0, 0, 0x1},
		{TK_OPTION_INT,
			"-integer", "integer", "Integer",
			"7", Tk_Offset(TypesRecord, integerPtr), -1, 0, 0, 0x2},
		{TK_OPTION_DOUBLE,
			"-double", "double", "Double",
			"3.14159", Tk_Offset(TypesRecord, doublePtr), -1, 0, 0,
			0x4},
		{TK_OPTION_STRING,
			"-string", "string", "String",
			"foo", Tk_Offset(TypesRecord, stringPtr), -1, 
			TK_CONFIG_NULL_OK, 0, 0x8},
		{TK_OPTION_STRING_TABLE,
			"-stringtable", "StringTable", "stringTable",
			"one", Tk_Offset(TypesRecord, stringTablePtr), -1,
			TK_CONFIG_NULL_OK, (ClientData) stringTable, 0x10},
		{TK_OPTION_COLOR,
			"-color", "color", "Color",
			"red", Tk_Offset(TypesRecord, colorPtr), -1, 
			TK_CONFIG_NULL_OK, (ClientData) "black", 0x20},
		{TK_OPTION_FONT,
			"-font", "font", "Font",
			"Helvetica 12",
			Tk_Offset(TypesRecord, fontPtr), -1,
			TK_CONFIG_NULL_OK, 0, 0x40},
		{TK_OPTION_BITMAP,
			"-bitmap", "bitmap", "Bitmap",
			"gray50",
			Tk_Offset(TypesRecord, bitmapPtr), -1,
			TK_CONFIG_NULL_OK, 0, 0x80},
		{TK_OPTION_BORDER,
			"-border", "border", "Border",
			"blue", Tk_Offset(TypesRecord, borderPtr), -1,
			TK_CONFIG_NULL_OK, (ClientData) "white", 0x100},
		{TK_OPTION_RELIEF,
			"-relief", "relief", "Relief",
			"raised",
			Tk_Offset(TypesRecord, reliefPtr), -1,
			TK_CONFIG_NULL_OK, 0, 0x200},
		{TK_OPTION_CURSOR,
			"-cursor", "cursor", "Cursor",
			"xterm",
			Tk_Offset(TypesRecord, cursorPtr), -1,
			TK_CONFIG_NULL_OK, 0, 0x400},
		{TK_OPTION_JUSTIFY,
			"-justify", (char *) NULL, (char *) NULL,
			"left",
			Tk_Offset(TypesRecord, justifyPtr), -1,
			TK_CONFIG_NULL_OK, 0, 0x800},
		{TK_OPTION_ANCHOR,
			"-anchor", "anchor", "Anchor",
			(char *) NULL,
			Tk_Offset(TypesRecord, anchorPtr), -1,
			TK_CONFIG_NULL_OK, 0, 0x1000},
		{TK_OPTION_PIXELS,
			"-pixel", "pixel", "Pixel",
			"1", Tk_Offset(TypesRecord, pixelPtr), -1,
			TK_CONFIG_NULL_OK, 0, 0x2000},
		{TK_OPTION_SYNONYM,
			"-synonym", (char *) NULL, (char *) NULL,
			(char *) NULL, 0, -1, 0, (ClientData) "-color",
			0x8000},
		{TK_OPTION_END}
	    };
	    Tk_OptionTable optionTable;
	    Tk_Window tkwin;
	    optionTable = Tk_CreateOptionTable(interp,
		    typesSpecs);
	    tables[index] = optionTable;
	    tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, 
		    Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
	    if (tkwin == NULL) {
		return TCL_ERROR;
	    }
	    Tk_SetClass(tkwin, "Test");

	    recordPtr = (TypesRecord *) ckalloc(sizeof(TypesRecord));
	    recordPtr->header.interp = interp;
	    recordPtr->header.optionTable = optionTable;
	    recordPtr->header.tkwin = tkwin;
	    recordPtr->booleanPtr = NULL;
	    recordPtr->integerPtr = NULL;
	    recordPtr->doublePtr = NULL;
	    recordPtr->stringPtr = NULL;
	    recordPtr->colorPtr = NULL;
	    recordPtr->fontPtr = NULL;
	    recordPtr->bitmapPtr = NULL;
	    recordPtr->borderPtr = NULL;
	    recordPtr->reliefPtr = NULL;
	    recordPtr->cursorPtr = NULL;
	    recordPtr->justifyPtr = NULL;
	    recordPtr->anchorPtr = NULL;
	    recordPtr->pixelPtr = NULL;
	    recordPtr->mmPtr = NULL;
	    recordPtr->stringTablePtr = NULL;
	    result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
		    tkwin);
	    if (result == TCL_OK) {
		recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
			Tcl_GetStringFromObj(objv[2], NULL),
			TrivialConfigObjCmd, (ClientData) recordPtr,
			TrivialCmdDeletedProc);
		Tk_CreateEventHandler(tkwin, StructureNotifyMask,
			TrivialEventProc, (ClientData) recordPtr);
		result = Tk_SetOptions(interp, (char *) recordPtr,
			optionTable, objc - 3, objv + 3, tkwin,
			(Tk_SavedOptions *) NULL, (int *) NULL);
		if (result != TCL_OK) {
		    Tk_DestroyWindow(tkwin);
		}
	    } else {
		Tk_DestroyWindow(tkwin);
		ckfree((char *) recordPtr);
	    }
	    if (result == TCL_OK) {
		Tcl_SetObjResult(interp, objv[2]);
	    }
	    break;
	}

	case CHAIN1: {
	    ExtensionWidgetRecord *recordPtr;
	    Tk_Window tkwin;
	    Tk_OptionTable optionTable;

	    tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, 
		    Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
	    if (tkwin == NULL) {
		return TCL_ERROR;
	    }
	    Tk_SetClass(tkwin, "Test");
	    optionTable = Tk_CreateOptionTable(interp, baseSpecs);
	    tables[index] = optionTable;

	    recordPtr = (ExtensionWidgetRecord *) ckalloc(
	    	    sizeof(ExtensionWidgetRecord));
	    recordPtr->header.interp = interp;
	    recordPtr->header.optionTable = optionTable;
	    recordPtr->header.tkwin = tkwin;
	    recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL;
	    recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL;
	    result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
		    tkwin);
	    if (result == TCL_OK) {
		result = Tk_SetOptions(interp, (char *) recordPtr, optionTable,
			objc - 3, objv + 3, tkwin, (Tk_SavedOptions *) NULL,
			(int *) NULL);
		if (result != TCL_OK) {
		    Tk_FreeConfigOptions((char *) recordPtr, optionTable,
			    tkwin);
		}
	    }
	    if (result == TCL_OK) {
		recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
			Tcl_GetStringFromObj(objv[2], NULL),
			TrivialConfigObjCmd, (ClientData) recordPtr,
			TrivialCmdDeletedProc);
		Tk_CreateEventHandler(tkwin, StructureNotifyMask,
			TrivialEventProc, (ClientData) recordPtr);
		Tcl_SetObjResult(interp, objv[2]);
	    }
	    break;
	}

	case CHAIN2: {
	    ExtensionWidgetRecord *recordPtr;
	    static Tk_OptionSpec extensionSpecs[] = {
		{TK_OPTION_STRING,
			"-three", "three", "Three", "three",
			Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr),
			-1},
		{TK_OPTION_STRING,
			"-four", "four", "Four", "four",
			Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr),
			-1},
		{TK_OPTION_STRING,
			"-two", "two", "Two", "two and a half",
			Tk_Offset(ExtensionWidgetRecord, base2ObjPtr),
			-1},
		{TK_OPTION_STRING,
			"-oneAgain", "oneAgain", "OneAgain", "one again",
			Tk_Offset(ExtensionWidgetRecord, extension5ObjPtr),
			-1},
		{TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
			(char *) NULL, 0, -1, 0, (ClientData) baseSpecs}
	    };
	    Tk_Window tkwin;
	    Tk_OptionTable optionTable;

	    tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, 
		    Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
	    if (tkwin == NULL) {
		return TCL_ERROR;
	    }
	    Tk_SetClass(tkwin, "Test");
	    optionTable = Tk_CreateOptionTable(interp, extensionSpecs);
	    tables[index] = optionTable;

	    recordPtr = (ExtensionWidgetRecord *) ckalloc(
	    	    sizeof(ExtensionWidgetRecord));
	    recordPtr->header.interp = interp;
	    recordPtr->header.optionTable = optionTable;
	    recordPtr->header.tkwin = tkwin;
	    recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL;
	    recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL;
	    recordPtr->extension5ObjPtr = NULL;
	    result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
		    tkwin);
	    if (result == TCL_OK) {
		result = Tk_SetOptions(interp, (char *) recordPtr, optionTable,
			objc - 3, objv + 3, tkwin, (Tk_SavedOptions *) NULL,
			(int *) NULL);
		if (result != TCL_OK) {
		    Tk_FreeConfigOptions((char *) recordPtr, optionTable,
			    tkwin);
		}
	    }
	    if (result == TCL_OK) {
		recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
			Tcl_GetStringFromObj(objv[2], NULL),
			TrivialConfigObjCmd, (ClientData) recordPtr,
			TrivialCmdDeletedProc);
		Tk_CreateEventHandler(tkwin, StructureNotifyMask,
			TrivialEventProc, (ClientData) recordPtr);
		Tcl_SetObjResult(interp, objv[2]);
	    }
	    break;
	}

	case CONFIG_ERROR: {
	    typedef struct ErrorWidgetRecord {
		Tcl_Obj *intPtr;
	    } ErrorWidgetRecord;
	    ErrorWidgetRecord widgetRecord;
	    static Tk_OptionSpec errorSpecs[] = {
		{TK_OPTION_INT, 
			"-int", "integer", "Integer",
			"bogus", Tk_Offset(ErrorWidgetRecord, intPtr)},
		{TK_OPTION_END}
	    };
	    Tk_OptionTable optionTable;

	    widgetRecord.intPtr = NULL;
	    optionTable = Tk_CreateOptionTable(interp, errorSpecs);
	    tables[index] = optionTable;
	    return Tk_InitOptions(interp, (char *) &widgetRecord, optionTable,
		    (Tk_Window) NULL);
	}

	case DEL: {
	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "tableName");
		return TCL_ERROR;
	    }
	    if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (tables[index] != NULL) {
		Tk_DeleteOptionTable(tables[index]);
	    }
	    break;
	}

	case INFO: {
	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "tableName");
		return TCL_ERROR;
	    }
	    if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, TkDebugConfig(interp, tables[index]));
	    break;
	}

	case INTERNAL: {
	    /*
	     * This command is similar to the "alltypes" command except
	     * that it stores all the configuration options as internal
	     * forms instead of objects.
	     */

	    typedef struct InternalRecord {
		TrivialCommandHeader header;
		int boolean;
		int integer;
		double doubleValue;
		char *string;
		int index;
		XColor *colorPtr;
		Tk_Font tkfont;
		Pixmap bitmap;
		Tk_3DBorder border;
		int relief;
		Tk_Cursor cursor;
		Tk_Justify justify;
		Tk_Anchor anchor;
		int pixels;
		double mm;
		Tk_Window tkwin;
	    } InternalRecord;
	    InternalRecord *recordPtr;
	    static char *internalStringTable[] = {
		    "one", "two", "three", "four", (char *) NULL
	    };
	    static Tk_OptionSpec internalSpecs[] = {
		{TK_OPTION_BOOLEAN,
			"-boolean", "boolean", "Boolean",
			"1", -1, Tk_Offset(InternalRecord, boolean), 0, 0, 0x1},
		{TK_OPTION_INT,
			"-integer", "integer", "Integer",
			"148962237", -1, Tk_Offset(InternalRecord, integer),
			0, 0, 0x2},
		{TK_OPTION_DOUBLE,
			"-double", "double", "Double",
			"3.14159", -1, Tk_Offset(InternalRecord, doubleValue),
			0, 0, 0x4},
		{TK_OPTION_STRING,
			"-string", "string", "String",
			"foo", -1, Tk_Offset(InternalRecord, string), 
			TK_CONFIG_NULL_OK, 0, 0x8},
		{TK_OPTION_STRING_TABLE,
			"-stringtable", "StringTable", "stringTable",
			"one", -1, Tk_Offset(InternalRecord, index),
			TK_CONFIG_NULL_OK, (ClientData) internalStringTable,
			0x10},
		{TK_OPTION_COLOR,
			"-color", "color", "Color",
			"red", -1, Tk_Offset(InternalRecord, colorPtr), 
			TK_CONFIG_NULL_OK, (ClientData) "black", 0x20},
		{TK_OPTION_FONT,
			"-font", "font", "Font",
			"Helvetica 12", -1, Tk_Offset(InternalRecord, tkfont),
			TK_CONFIG_NULL_OK, 0, 0x40},
		{TK_OPTION_BITMAP,
			"-bitmap", "bitmap", "Bitmap",
			"gray50", -1, Tk_Offset(InternalRecord, bitmap),
			TK_CONFIG_NULL_OK, 0, 0x80},
		{TK_OPTION_BORDER,
			"-border", "border", "Border",
			"blue", -1, Tk_Offset(InternalRecord, border),
			TK_CONFIG_NULL_OK, (ClientData) "white", 0x100},
		{TK_OPTION_RELIEF,
			"-relief", "relief", "Relief",
			"raised", -1, Tk_Offset(InternalRecord, relief),
			TK_CONFIG_NULL_OK, 0, 0x200},
		{TK_OPTION_CURSOR,
			"-cursor", "cursor", "Cursor",
			"xterm", -1, Tk_Offset(InternalRecord, cursor),
			TK_CONFIG_NULL_OK, 0, 0x400},
		{TK_OPTION_JUSTIFY,
			"-justify", (char *) NULL, (char *) NULL,
			"left", -1, Tk_Offset(InternalRecord, justify),
			TK_CONFIG_NULL_OK, 0, 0x800},
		{TK_OPTION_ANCHOR,
			"-anchor", "anchor", "Anchor",
			(char *) NULL, -1, Tk_Offset(InternalRecord, anchor),
			TK_CONFIG_NULL_OK, 0, 0x1000},
		{TK_OPTION_PIXELS,
			"-pixel", "pixel", "Pixel",
			"1", -1, Tk_Offset(InternalRecord, pixels),
			TK_CONFIG_NULL_OK, 0, 0x2000},
		{TK_OPTION_WINDOW,
			"-window", "window", "Window",
			(char *) NULL, -1, Tk_Offset(InternalRecord, tkwin),
			TK_CONFIG_NULL_OK, 0, 0},
		{TK_OPTION_SYNONYM,
			"-synonym", (char *) NULL, (char *) NULL,
			(char *) NULL, -1, -1, 0, (ClientData) "-color",
			0x8000},
		{TK_OPTION_END}
	    };
	    Tk_OptionTable optionTable;
	    Tk_Window tkwin;
	    optionTable = Tk_CreateOptionTable(interp, internalSpecs);
	    tables[index] = optionTable;
	    tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData, 
		    Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
	    if (tkwin == NULL) {
		return TCL_ERROR;
	    }
	    Tk_SetClass(tkwin, "Test");

	    recordPtr = (InternalRecord *) ckalloc(sizeof(InternalRecord));
	    recordPtr->header.interp = interp;
	    recordPtr->header.optionTable = optionTable;
	    recordPtr->header.tkwin = tkwin;
	    recordPtr->boolean = 0;
	    recordPtr->integer = 0;
	    recordPtr->doubleValue = 0.0;
	    recordPtr->string = NULL;
	    recordPtr->index = 0;
	    recordPtr->colorPtr = NULL;
	    recordPtr->tkfont = NULL;
	    recordPtr->bitmap = None;
	    recordPtr->border = NULL;
	    recordPtr->relief = TK_RELIEF_FLAT;
	    recordPtr->cursor = NULL;
	    recordPtr->justify = TK_JUSTIFY_LEFT;
	    recordPtr->anchor = TK_ANCHOR_N;
	    recordPtr->pixels = 0;
	    recordPtr->mm = 0.0;
	    recordPtr->tkwin = NULL;
	    result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
		    tkwin);
	    if (result == TCL_OK) {
		recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
			Tcl_GetStringFromObj(objv[2], NULL),
			TrivialConfigObjCmd, (ClientData) recordPtr,
			TrivialCmdDeletedProc);
		Tk_CreateEventHandler(tkwin, StructureNotifyMask,
			TrivialEventProc, (ClientData) recordPtr);
		result = Tk_SetOptions(interp, (char *) recordPtr,
			optionTable, objc - 3, objv + 3, tkwin,
			(Tk_SavedOptions *) NULL, (int *) NULL);
		if (result != TCL_OK) {
		    Tk_DestroyWindow(tkwin);
		}
	    } else {
		Tk_DestroyWindow(tkwin);
		ckfree((char *) recordPtr);
	    }
	    if (result == TCL_OK) {
		Tcl_SetObjResult(interp, objv[2]);
	    }
	    break;
	}

	case NEW: {
	    typedef struct FiveRecord {
		TrivialCommandHeader header;
		Tcl_Obj *one;
		Tcl_Obj *two;
		Tcl_Obj *three;
		Tcl_Obj *four;
		Tcl_Obj *five;
	    } FiveRecord;
	    FiveRecord *recordPtr;
	    static Tk_OptionSpec smallSpecs[] = {
		{TK_OPTION_INT,
			"-one", "one", "One",
			"1",
			Tk_Offset(FiveRecord, one), -1},
		{TK_OPTION_INT,
			"-two", "two", "Two",
			"2",
			Tk_Offset(FiveRecord, two), -1},
		{TK_OPTION_INT,
			"-three", "three", "Three",
			"3",
			Tk_Offset(FiveRecord, three), -1},
		{TK_OPTION_INT,
			"-four", "four", "Four",
			"4",
			Tk_Offset(FiveRecord, four), -1},
		{TK_OPTION_STRING,
			"-five", NULL, NULL,
			NULL,
			Tk_Offset(FiveRecord, five), -1},
		{TK_OPTION_END}
	    };

	    if (objc < 3) {
		Tcl_WrongNumArgs(interp, 1, objv, "new name ?options?");
		return TCL_ERROR;
	    }

	    recordPtr = (FiveRecord *) ckalloc(sizeof(FiveRecord));
	    recordPtr->header.interp = interp;
	    recordPtr->header.optionTable = Tk_CreateOptionTable(interp,
		    smallSpecs);
	    tables[index] = recordPtr->header.optionTable;
	    recordPtr->header.tkwin = NULL;
	    recordPtr->one = recordPtr->two = recordPtr->three = NULL;
	    recordPtr->four = recordPtr->five = NULL;
	    Tcl_SetObjResult(interp, objv[2]);
	    result = Tk_InitOptions(interp, (char *) recordPtr, 
		    recordPtr->header.optionTable, (Tk_Window) NULL);
	    if (result == TCL_OK) {
		result = Tk_SetOptions(interp, (char *) recordPtr,
			recordPtr->header.optionTable, objc - 3, objv + 3,
			(Tk_Window) NULL, (Tk_SavedOptions *) NULL,
			(int *) NULL);
		if (result == TCL_OK) {
		    recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp, 
			    Tcl_GetStringFromObj(objv[2], NULL),
			    TrivialConfigObjCmd, (ClientData) recordPtr,
			    TrivialCmdDeletedProc);
		} else {
		    Tk_FreeConfigOptions((char *) recordPtr,
			    recordPtr->header.optionTable, (Tk_Window) NULL);
		}
	    }
	    if (result != TCL_OK) {
		ckfree((char *) recordPtr);
	    }

	    break;
	}
	case NOT_ENOUGH_PARAMS: {
	    typedef struct NotEnoughRecord {
		Tcl_Obj *fooObjPtr;
	    } NotEnoughRecord;
	    NotEnoughRecord record;
	    static Tk_OptionSpec errorSpecs[] = {
		{TK_OPTION_INT, 
			"-foo", "foo", "Foo",
			"0", Tk_Offset(NotEnoughRecord, fooObjPtr)},
		{TK_OPTION_END}
	    };
	    Tcl_Obj *newObjPtr = Tcl_NewStringObj("-foo", -1);
	    Tk_OptionTable optionTable;

	    record.fooObjPtr = NULL;

	    tkwin = Tk_CreateWindowFromPath(interp, mainWin,
		    ".config", (char *) NULL);
	    Tk_SetClass(tkwin, "Config");
	    optionTable = Tk_CreateOptionTable(interp, errorSpecs);
	    tables[index] = optionTable;
	    Tk_InitOptions(interp, (char *) &record, optionTable, tkwin);
	    if (Tk_SetOptions(interp, (char *) &record, optionTable,
		    1, &newObjPtr, tkwin, (Tk_SavedOptions *) NULL,
		    (int *) NULL)
		    != TCL_OK) {
		result = TCL_ERROR;
	    }
	    Tcl_DecrRefCount(newObjPtr);
	    Tk_FreeConfigOptions( (char *) &record, optionTable, tkwin);
	    Tk_DestroyWindow(tkwin);
	    return result;
	}

	case TWO_WINDOWS: {
	    typedef struct SlaveRecord {
		TrivialCommandHeader header;
		Tcl_Obj *windowPtr;
	    } SlaveRecord;
	    SlaveRecord *recordPtr;
	    static Tk_OptionSpec slaveSpecs[] = {
		{TK_OPTION_WINDOW,
			"-window", "window", "Window",
			".bar", Tk_Offset(SlaveRecord, windowPtr), -1,
			TK_CONFIG_NULL_OK},
	       {TK_OPTION_END}
	    };
	    Tk_Window tkwin = Tk_CreateWindowFromPath(interp,
		    (Tk_Window) clientData,
		    Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
	    if (tkwin == NULL) {
		return TCL_ERROR;
	    }
	    Tk_SetClass(tkwin, "Test");

	    recordPtr = (SlaveRecord *) ckalloc(sizeof(SlaveRecord));
	    recordPtr->header.interp = interp;
	    recordPtr->header.optionTable = Tk_CreateOptionTable(interp,
		    slaveSpecs);
	    tables[index] = recordPtr->header.optionTable;
	    recordPtr->header.tkwin = tkwin;
	    recordPtr->windowPtr = NULL;

	    result = Tk_InitOptions(interp,  (char *) recordPtr, 
		    recordPtr->header.optionTable, tkwin);
	    if (result == TCL_OK) {
		result = Tk_SetOptions(interp, (char *) recordPtr, 
			recordPtr->header.optionTable, objc - 3, objv + 3,
			tkwin, (Tk_SavedOptions *) NULL, (int *) NULL);
		if (result == TCL_OK) {
		    recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
			    Tcl_GetStringFromObj(objv[2], NULL),
			    TrivialConfigObjCmd, (ClientData) recordPtr,
			    TrivialCmdDeletedProc);
		    Tk_CreateEventHandler(tkwin, StructureNotifyMask,
			    TrivialEventProc, (ClientData) recordPtr);
		    Tcl_SetObjResult(interp, objv[2]);
		} else {
		    Tk_FreeConfigOptions((char *) recordPtr, 
			    recordPtr->header.optionTable, tkwin);
		}
	    }
	    if (result != TCL_OK) {
		Tk_DestroyWindow(tkwin);
		ckfree((char *) recordPtr);
	    }
		
	}
    }

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TrivialConfigObjCmd --
 *
 *	This command is used to test the configuration package. It only
 *	handles the "configure" and "cget" subcommands.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TrivialConfigObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window for application. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    int result = TCL_OK;
    static char *options[] = {"cget", "configure", "csave", (char *) NULL};
    enum {
	CGET, CONFIGURE, CSAVE
    };
    Tcl_Obj *resultObjPtr;
    int index, mask;
    TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData;
    Tk_Window tkwin = headerPtr->tkwin;
    Tk_SavedOptions saved;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], options, "command",
	    0, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_Preserve(clientData);
    
    switch (index) {
	case CGET: {
	    if (objc != 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "option");
		result = TCL_ERROR;
		goto done;
	    }
	    resultObjPtr = Tk_GetOptionValue(interp, (char *) clientData, 
		    headerPtr->optionTable, objv[2], tkwin);
	    if (resultObjPtr != NULL) {
		Tcl_SetObjResult(interp, resultObjPtr);
		result = TCL_OK;
	    } else {
		result = TCL_ERROR;
	    }
	    break;
	}
	case CONFIGURE: {
	    if (objc == 2) {
		resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData, 
			headerPtr->optionTable, (Tcl_Obj *) NULL, tkwin);
		if (resultObjPtr == NULL) {
		    result = TCL_ERROR;
		} else {
		    Tcl_SetObjResult(interp, resultObjPtr);
		}
	    } else if (objc == 3) {
		resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData,
			headerPtr->optionTable, objv[2], tkwin);
		if (resultObjPtr == NULL) {
		    result = TCL_ERROR;
		} else {
		    Tcl_SetObjResult(interp, resultObjPtr);
		}
	    } else {
		result = Tk_SetOptions(interp, (char *) clientData,
			headerPtr->optionTable, objc - 2, objv + 2, 
			tkwin, (Tk_SavedOptions *) NULL, &mask);
		if (result == TCL_OK) {
		    Tcl_SetIntObj(Tcl_GetObjResult(interp), mask);
		}
	    }
	    break;
	}
	case CSAVE: {
	    result = Tk_SetOptions(interp, (char *) clientData,
			headerPtr->optionTable, objc - 2, objv + 2, 
			tkwin, &saved, &mask);
	    Tk_FreeSavedOptions(&saved);
	    if (result == TCL_OK) {
		Tcl_SetIntObj(Tcl_GetObjResult(interp), mask);
	    }
	    break;
	}
    }
done:
    Tcl_Release(clientData);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TrivialCmdDeletedProc --
 *
 *	This procedure is invoked when a widget command is deleted.  If
 *	the widget isn't already in the process of being destroyed,
 *	this command destroys it.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The widget is destroyed.
 *
 *----------------------------------------------------------------------
 */

static void
TrivialCmdDeletedProc(clientData)
    ClientData clientData;	/* Pointer to widget record for widget. */
{
    TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData;
    Tk_Window tkwin = headerPtr->tkwin;

    if (tkwin != NULL) {
	Tk_DestroyWindow(tkwin);
    } else if (headerPtr->optionTable != NULL) {
	/*
	 * This is a "new" object, which doesn't have a window, so
	 * we can't depend on cleaning up in the event procedure.
	 * Free its resources here.
	 */

	Tk_FreeConfigOptions((char *) clientData,
		headerPtr->optionTable, (Tk_Window) NULL);
	Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
    }
}

/*
 *--------------------------------------------------------------
 *
 * TrivialEventProc --
 *
 *	A dummy event proc.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	When the window gets deleted, internal structures get
 *	cleaned up.
 *
 *--------------------------------------------------------------
 */

static void
TrivialEventProc(clientData, eventPtr)
    ClientData clientData;	/* Information about window. */
    XEvent *eventPtr;		/* Information about event. */
{
    TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData;

    if (eventPtr->type == DestroyNotify) {
	if (headerPtr->tkwin != NULL) {
	    Tk_FreeConfigOptions((char *) clientData,
		    headerPtr->optionTable, headerPtr->tkwin);
	    headerPtr->optionTable = NULL;
	    headerPtr->tkwin = NULL;
	    Tcl_DeleteCommandFromToken(headerPtr->interp,
		    headerPtr->widgetCmd);
	}
	Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TestfontObjCmd --
 *
 *	This procedure implements the "testfont" command, which is used
 *	to test TkFont objects.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestfontObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window for application. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    static char *options[] = {"counts", "subfonts", (char *) NULL};
    enum option {COUNTS, SUBFONTS};
    int index;
    Tk_Window tkwin;
    Tk_Font tkfont;
    
    tkwin = (Tk_Window) clientData;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "option fontName");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0, &index)
	    != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum option) index) {
	case COUNTS: {
	    Tcl_SetObjResult(interp, TkDebugFont(Tk_MainWindow(interp),
		    Tcl_GetString(objv[2])));
	    break;
	}
	case SUBFONTS: {
	    tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
	    if (tkfont == NULL) {
		return TCL_ERROR;
	    }
	    TkpGetSubFonts(interp, tkfont);
	    Tk_FreeFont(tkfont);
	    break;
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
519
520
521
522
523
524
525

526
527
528
529
530
531
532
533
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], "option ?arg arg ...?", (char *) NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "changed") == 0) {
	if (argc != 8) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",

		    argv[0], " changed x y width height imageWidth imageHeight",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[5], &height) != TCL_OK)







>
|







1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], "option ?arg arg ...?", (char *) NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "changed") == 0) {
	if (argc != 8) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0],
		    " changed x y width height imageWidth imageHeight",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[5], &height) != TCL_OK)
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
    int imageX, imageY;		/* Origin of area to redraw, relative to
				 * origin of image. */
    int width, height;		/* Dimensions of area to redraw. */
    int drawableX, drawableY;	/* Coordinates in drawable corresponding to
				 * imageX and imageY. */
{
    TImageInstance *instPtr = (TImageInstance *) clientData;
    char buffer[200];

    sprintf(buffer, "%s display %d %d %d %d %d %d",
	    instPtr->masterPtr->imageName, imageX, imageY, width, height,
	    drawableX, drawableY);
    Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer,
	    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
    if (width > (instPtr->masterPtr->width - imageX)) {







|







1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
    int imageX, imageY;		/* Origin of area to redraw, relative to
				 * origin of image. */
    int width, height;		/* Dimensions of area to redraw. */
    int drawableX, drawableY;	/* Coordinates in drawable corresponding to
				 * imageX and imageY. */
{
    TImageInstance *instPtr = (TImageInstance *) clientData;
    char buffer[200 + TCL_INTEGER_SPACE * 6];

    sprintf(buffer, "%s display %d %d %d %d %d %d",
	    instPtr->masterPtr->imageName, imageX, imageY, width, height,
	    drawableX, drawableY);
    Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer,
	    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
    if (width > (instPtr->masterPtr->width - imageX)) {
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
static int
TestmakeexistCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    Tk_Window main = (Tk_Window) clientData;
    int i;
    Tk_Window tkwin;

    for (i = 1; i < argc; i++) {
	tkwin = Tk_NameToWindow(interp, argv[i], main);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
	Tk_MakeWindowExist(tkwin);
    }

    return TCL_OK;







|




|







1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
static int
TestmakeexistCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    Tk_Window mainWin = (Tk_Window) clientData;
    int i;
    Tk_Window tkwin;

    for (i = 1; i < argc; i++) {
	tkwin = Tk_NameToWindow(interp, argv[i], mainWin);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
	Tk_MakeWindowExist(tkwin);
    }

    return TCL_OK;
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
TestmenubarCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
#ifdef __UNIX__
    Tk_Window main = (Tk_Window) clientData;
    Tk_Window tkwin, menubar;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		" option ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[1], "window") == 0) {
	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		    "window toplevel menubar\"", (char *) NULL);
	    return TCL_ERROR;
	}
	tkwin = Tk_NameToWindow(interp, argv[2], main);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
	if (argv[3][0] == 0) {
	    TkUnixSetMenubar(tkwin, NULL);
	} else {
	    menubar = Tk_NameToWindow(interp, argv[3], main);
	    if (menubar == NULL) {
		return TCL_ERROR;
	    }
	    TkUnixSetMenubar(tkwin, menubar);
	}
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be  window", (char *) NULL);
	return TCL_ERROR;
    }

    return TCL_OK;
#else
    interp->result = "testmenubar is supported only under Unix";

    return TCL_ERROR;
#endif
}

/*
 *----------------------------------------------------------------------
 *







|














|






|













|
>







1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
TestmenubarCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
#ifdef __UNIX__
    Tk_Window mainWin = (Tk_Window) clientData;
    Tk_Window tkwin, menubar;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		" option ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[1], "window") == 0) {
	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		    "window toplevel menubar\"", (char *) NULL);
	    return TCL_ERROR;
	}
	tkwin = Tk_NameToWindow(interp, argv[2], mainWin);
	if (tkwin == NULL) {
	    return TCL_ERROR;
	}
	if (argv[3][0] == 0) {
	    TkUnixSetMenubar(tkwin, NULL);
	} else {
	    menubar = Tk_NameToWindow(interp, argv[3], mainWin);
	    if (menubar == NULL) {
		return TCL_ERROR;
	    }
	    TkUnixSetMenubar(tkwin, menubar);
	}
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be  window", (char *) NULL);
	return TCL_ERROR;
    }

    return TCL_OK;
#else
    Tcl_SetResult(interp, "testmenubar is supported only under Unix",
	    TCL_STATIC);
    return TCL_ERROR;
#endif
}

/*
 *----------------------------------------------------------------------
 *
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
static int
TestmetricsCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    char buf[200];

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		" option ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }








|







1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
static int
TestmetricsCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    char buf[TCL_INTEGER_SPACE];

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		" option ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }

870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    Tk_Window tkwin = (Tk_Window) clientData;
    TkWindow *winPtr;
    char buf[200];

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		" option window\"", (char *) NULL);
	return TCL_ERROR;
    }








|







1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    Tk_Window tkwin = (Tk_Window) clientData;
    TkWindow *winPtr;
    char buf[TCL_INTEGER_SPACE];

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		" option window\"", (char *) NULL);
	return TCL_ERROR;
    }

923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
static int
TestpropCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    Tk_Window main = (Tk_Window) clientData;
    int result, actualFormat;
    unsigned long bytesAfter, length, value;
    Atom actualType, propName;
    char *property, *p, *end;
    Window w;
    char buffer[30];

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		" window property\"", (char *) NULL);
	return TCL_ERROR;
    }

    w = strtoul(argv[1], &end, 0);
    propName = Tk_InternAtom(main, argv[2]);
    property = NULL;
    result = XGetWindowProperty(Tk_Display(main),
	    w, propName, 0, 100000, False, AnyPropertyType,
	    &actualType, &actualFormat, &length,
	    &bytesAfter, (unsigned char **) &property);
    if ((result == Success) && (actualType != None)) {
	if ((actualFormat == 8) && (actualType == XA_STRING)) {
	    for (p = property; ((unsigned long)(p-property)) < length; p++) {
		if (*p == 0) {







|














|

|







2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
static int
TestpropCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    Tk_Window mainWin = (Tk_Window) clientData;
    int result, actualFormat;
    unsigned long bytesAfter, length, value;
    Atom actualType, propName;
    char *property, *p, *end;
    Window w;
    char buffer[30];

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		" window property\"", (char *) NULL);
	return TCL_ERROR;
    }

    w = strtoul(argv[1], &end, 0);
    propName = Tk_InternAtom(mainWin, argv[2]);
    property = NULL;
    result = XGetWindowProperty(Tk_Display(mainWin),
	    w, propName, 0, 100000, False, AnyPropertyType,
	    &actualType, &actualFormat, &length,
	    &bytesAfter, (unsigned char **) &property);
    if ((result == Success) && (actualType != None)) {
	if ((actualFormat == 8) && (actualType == XA_STRING)) {
	    for (p = property; ((unsigned long)(p-property)) < length; p++) {
		if (*p == 0) {
1001
1002
1003
1004
1005
1006
1007

1008

1009
1010
1011
1012
1013
1014
1015
static int
TestsendCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{

    TkWindow *winPtr = (TkWindow *) clientData;


    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		" option ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }








>

>







2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
static int
TestsendCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
#if !(defined(__WIN32__) || defined(MAC_TCL))
    TkWindow *winPtr = (TkWindow *) clientData;
#endif

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args;  must be \"", argv[0],
		" option ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }

1069
1070
1071
1072
1073
1074
1075


1076

1077
1078
1079
1080
1081
1082















































































1083
1084
1085
1086
1087
1088
1089
		}
		XChangeProperty(winPtr->dispPtr->display,
			w, propName, XA_STRING, 8, PropModeReplace,
			(unsigned char *) argv[4], p-argv[4]);
	    }
	}
    } else if (strcmp(argv[1], "serial") == 0) {


	sprintf(interp->result, "%d", tkSendSerial+1);

    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be bogus, prop, or serial", (char *) NULL);
	return TCL_ERROR;
    }
#endif















































































    return TCL_OK;
}

#if !(defined(__WIN32__) || defined(MAC_TCL))
/*
 *----------------------------------------------------------------------
 *







>
>
|
>






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







2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
		}
		XChangeProperty(winPtr->dispPtr->display,
			w, propName, XA_STRING, 8, PropModeReplace,
			(unsigned char *) argv[4], p-argv[4]);
	    }
	}
    } else if (strcmp(argv[1], "serial") == 0) {
	char buf[TCL_INTEGER_SPACE];
	
	sprintf(buf, "%d", tkSendSerial+1);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be bogus, prop, or serial", (char *) NULL);
	return TCL_ERROR;
    }
#endif
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TesttextCmd --
 *
 *	This procedure implements the "testtext" command.  It provides
 *	a set of functions for testing text widgets and the associated
 *	functions in tkText*.c.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Depends on option;  see below.
 *
 *----------------------------------------------------------------------
 */

static int
TesttextCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    TkText *textPtr;
    size_t len;
    int lineIndex, byteIndex, byteOffset;
    TkTextIndex index;
    char buf[64];
    Tcl_CmdInfo info;

    if (argc < 3) {
	return TCL_ERROR;
    }

    if (Tcl_GetCommandInfo(interp, argv[1], &info) == 0) {
	return TCL_ERROR;
    }
    textPtr = (TkText *) info.clientData;
    len = strlen(argv[2]);
    if (strncmp(argv[2], "byteindex", len) == 0) {
	if (argc != 5) {
	    return TCL_ERROR;
	}
	lineIndex = atoi(argv[3]) - 1;
	byteIndex = atoi(argv[4]);

	TkTextMakeByteIndex(textPtr->tree, lineIndex, byteIndex, &index);
    } else if (strncmp(argv[2], "forwbytes", len) == 0) {
	if (argc != 5) {
	    return TCL_ERROR;
	}
	if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	byteOffset = atoi(argv[4]);
	TkTextIndexForwBytes(&index, byteOffset, &index);
    } else if (strncmp(argv[2], "backbytes", len) == 0) {
	if (argc != 5) {
	    return TCL_ERROR;
	}
	if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	byteOffset = atoi(argv[4]);
	TkTextIndexBackBytes(&index, byteOffset, &index);
    } else {
	return TCL_ERROR;
    }

    TkTextSetMark(textPtr, "insert", &index);
    TkTextPrintIndex(&index, buf);
    sprintf(buf + strlen(buf), " %d", index.byteIndex);
    Tcl_AppendResult(interp, buf, NULL);

    return TCL_OK;
}

#if !(defined(__WIN32__) || defined(MAC_TCL))
/*
 *----------------------------------------------------------------------
 *
1123
1124
1125
1126
1127
1128
1129


1130

1131
1132
1133
1134
    winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
    if (winPtr == NULL) {
	return TCL_ERROR;
    }

    wrapperPtr = TkpGetWrapperWindow(winPtr);
    if (wrapperPtr != NULL) {


	TkpPrintWindowId(interp->result, Tk_WindowId(wrapperPtr));

    }
    return TCL_OK;
}
#endif







>
>
|
>




2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
    winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
    if (winPtr == NULL) {
	return TCL_ERROR;
    }

    wrapperPtr = TkpGetWrapperWindow(winPtr);
    if (wrapperPtr != NULL) {
	char buf[TCL_INTEGER_SPACE];

	TkpPrintWindowId(buf, Tk_WindowId(wrapperPtr));
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    }
    return TCL_OK;
}
#endif

Changes to generic/tkText.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkText.c 1.104 97/10/13 15:18:24
 */

#include "default.h"
#include "tkPort.h"
#include "tkInt.h"

#ifdef MAC_TCL







|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkText.c,v 1.1.4.6 1999/04/02 23:51:48 stanton Exp $
 */

#include "default.h"
#include "tkPort.h"
#include "tkInt.h"

#ifdef MAC_TCL
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
    {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
	DEF_TEXT_YSCROLL_COMMAND, Tk_Offset(TkText, yScrollCmd),
	TK_CONFIG_NULL_OK},
    {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, 0}
};

/*
 * Tk_Uid's used to represent text states:
 */

Tk_Uid tkTextCharUid = NULL;
Tk_Uid tkTextDisabledUid = NULL;
Tk_Uid tkTextNoneUid = NULL;
Tk_Uid tkTextNormalUid = NULL;
Tk_Uid tkTextWordUid = NULL;

/*
 * Boolean variable indicating whether or not special debugging code
 * should be executed.
 */

int tkTextDebug = 0;








<
<
<
<
<
<
<
<
<
<







129
130
131
132
133
134
135










136
137
138
139
140
141
142
    {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
	DEF_TEXT_YSCROLL_COMMAND, Tk_Offset(TkText, yScrollCmd),
	TK_CONFIG_NULL_OK},
    {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
	(char *) NULL, 0, 0}
};











/*
 * Boolean variable indicating whether or not special debugging code
 * should be executed.
 */

int tkTextDebug = 0;

227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " pathName ?options?\"", (char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Perform once-only initialization:
     */

    if (tkTextNormalUid == NULL) {
	tkTextCharUid = Tk_GetUid("char");
	tkTextDisabledUid = Tk_GetUid("disabled");
	tkTextNoneUid = Tk_GetUid("none");
	tkTextNormalUid = Tk_GetUid("normal");
	tkTextWordUid = Tk_GetUid("word");
    }

    /*
     * Create the window.
     */

    new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
    if (new == NULL) {
	return TCL_ERROR;







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







217
218
219
220
221
222
223












224
225
226
227
228
229
230

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " pathName ?options?\"", (char *) NULL);
	return TCL_ERROR;
    }













    /*
     * Create the window.
     */

    new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
    if (new == NULL) {
	return TCL_ERROR;
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
	    (ClientData) textPtr, TextCmdDeletedProc);
    textPtr->tree = TkBTreeCreate(textPtr);
    Tcl_InitHashTable(&textPtr->tagTable, TCL_STRING_KEYS);
    textPtr->numTags = 0;
    Tcl_InitHashTable(&textPtr->markTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&textPtr->windowTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&textPtr->imageTable, TCL_STRING_KEYS);
    textPtr->state = tkTextNormalUid;
    textPtr->border = NULL;
    textPtr->borderWidth = 0;
    textPtr->padX = 0;
    textPtr->padY = 0;
    textPtr->relief = TK_RELIEF_FLAT;
    textPtr->highlightWidth = 0;
    textPtr->highlightBgColorPtr = NULL;
    textPtr->highlightColorPtr = NULL;
    textPtr->cursor = None;
    textPtr->fgColor = NULL;
    textPtr->tkfont = NULL;
    textPtr->charWidth = 1;
    textPtr->spacing1 = 0;
    textPtr->spacing2 = 0;
    textPtr->spacing3 = 0;
    textPtr->tabOptionString = NULL;
    textPtr->tabArrayPtr = NULL;
    textPtr->wrapMode = tkTextCharUid;
    textPtr->width = 0;
    textPtr->height = 0;
    textPtr->setGrid = 0;
    textPtr->prevWidth = Tk_Width(new);
    textPtr->prevHeight = Tk_Height(new);
    TkTextCreateDInfo(textPtr);
    TkTextMakeIndex(textPtr->tree, 0, 0, &startIndex);
    TkTextSetYView(textPtr, &startIndex, 0);
    textPtr->selTagPtr = NULL;
    textPtr->selBorder = NULL;
    textPtr->selBdString = NULL;
    textPtr->selFgColorPtr = NULL;
    textPtr->exportSelection = 1;
    textPtr->abortSelections = 0;







|

















|






|







239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
	    (ClientData) textPtr, TextCmdDeletedProc);
    textPtr->tree = TkBTreeCreate(textPtr);
    Tcl_InitHashTable(&textPtr->tagTable, TCL_STRING_KEYS);
    textPtr->numTags = 0;
    Tcl_InitHashTable(&textPtr->markTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&textPtr->windowTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&textPtr->imageTable, TCL_STRING_KEYS);
    textPtr->state = Tk_GetUid("normal");
    textPtr->border = NULL;
    textPtr->borderWidth = 0;
    textPtr->padX = 0;
    textPtr->padY = 0;
    textPtr->relief = TK_RELIEF_FLAT;
    textPtr->highlightWidth = 0;
    textPtr->highlightBgColorPtr = NULL;
    textPtr->highlightColorPtr = NULL;
    textPtr->cursor = None;
    textPtr->fgColor = NULL;
    textPtr->tkfont = NULL;
    textPtr->charWidth = 1;
    textPtr->spacing1 = 0;
    textPtr->spacing2 = 0;
    textPtr->spacing3 = 0;
    textPtr->tabOptionString = NULL;
    textPtr->tabArrayPtr = NULL;
    textPtr->wrapMode = Tk_GetUid("char");
    textPtr->width = 0;
    textPtr->height = 0;
    textPtr->setGrid = 0;
    textPtr->prevWidth = Tk_Width(new);
    textPtr->prevHeight = Tk_Height(new);
    TkTextCreateDInfo(textPtr);
    TkTextMakeByteIndex(textPtr->tree, 0, 0, &startIndex);
    TkTextSetYView(textPtr, &startIndex, 0);
    textPtr->selTagPtr = NULL;
    textPtr->selBorder = NULL;
    textPtr->selBdString = NULL;
    textPtr->selFgColorPtr = NULL;
    textPtr->exportSelection = 1;
    textPtr->abortSelections = 0;
318
319
320
321
322
323
324
325

326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
    textPtr->flags = 0;

    /*
     * Create the "sel" tag and the "current" and "insert" marks.
     */

    textPtr->selTagPtr = TkTextCreateTag(textPtr, "sel");
    textPtr->selTagPtr->reliefString = (char *) ckalloc(7);

    strcpy(textPtr->selTagPtr->reliefString, DEF_TEXT_SELECT_RELIEF);
    textPtr->selTagPtr->relief = TK_RELIEF_RAISED;
    textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &startIndex);
    textPtr->insertMarkPtr = TkTextSetMark(textPtr, "insert", &startIndex);

    Tk_SetClass(textPtr->tkwin, "Text");
    TkSetClassProcs(textPtr->tkwin, &textClass, (ClientData) textPtr);
    Tk_CreateEventHandler(textPtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    TextEventProc, (ClientData) textPtr);
    Tk_CreateEventHandler(textPtr->tkwin, KeyPressMask|KeyReleaseMask
	    |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
	    |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
	    TkTextBindProc, (ClientData) textPtr);
    Tk_CreateSelHandler(textPtr->tkwin, XA_PRIMARY, XA_STRING,
	    TextFetchSelection, (ClientData) textPtr, XA_STRING);
    if (ConfigureText(interp, textPtr, argc-2, argv+2, 0) != TCL_OK) {
	Tk_DestroyWindow(textPtr->tkwin);
	return TCL_ERROR;
    }
    interp->result = Tk_PathName(textPtr->tkwin);

    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *







|
>




















|







296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
    textPtr->flags = 0;

    /*
     * Create the "sel" tag and the "current" and "insert" marks.
     */

    textPtr->selTagPtr = TkTextCreateTag(textPtr, "sel");
    textPtr->selTagPtr->reliefString =
	    (char *) ckalloc(sizeof(DEF_TEXT_SELECT_RELIEF));
    strcpy(textPtr->selTagPtr->reliefString, DEF_TEXT_SELECT_RELIEF);
    textPtr->selTagPtr->relief = TK_RELIEF_RAISED;
    textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &startIndex);
    textPtr->insertMarkPtr = TkTextSetMark(textPtr, "insert", &startIndex);

    Tk_SetClass(textPtr->tkwin, "Text");
    TkSetClassProcs(textPtr->tkwin, &textClass, (ClientData) textPtr);
    Tk_CreateEventHandler(textPtr->tkwin,
	    ExposureMask|StructureNotifyMask|FocusChangeMask,
	    TextEventProc, (ClientData) textPtr);
    Tk_CreateEventHandler(textPtr->tkwin, KeyPressMask|KeyReleaseMask
	    |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
	    |LeaveWindowMask|PointerMotionMask|VirtualEventMask,
	    TkTextBindProc, (ClientData) textPtr);
    Tk_CreateSelHandler(textPtr->tkwin, XA_PRIMARY, XA_STRING,
	    TextFetchSelection, (ClientData) textPtr, XA_STRING);
    if (ConfigureText(interp, textPtr, argc-2, argv+2, 0) != TCL_OK) {
	Tk_DestroyWindow(textPtr->tkwin);
	return TCL_ERROR;
    }
    Tcl_SetResult(interp, Tk_PathName(textPtr->tkwin), TCL_STATIC);

    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
397
398
399
400
401
402
403


404

405
406
407
408
409
410
411
	    goto done;
	}
	if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (TkTextCharBbox(textPtr, &index1, &x, &y, &width, &height) == 0) {


	    sprintf(interp->result, "%d %d %d %d", x, y, width, height);

	}
    } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " cget option\"",
		    (char *) NULL);







>
>
|
>







376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
	    goto done;
	}
	if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (TkTextCharBbox(textPtr, &index1, &x, &y, &width, &height) == 0) {
	    char buf[TCL_INTEGER_SPACE * 4];
	    
	    sprintf(buf, "%d %d %d %d", x, y, width, height);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	}
    } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " cget option\"",
		    (char *) NULL);
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
	} else if ((p[0] == '=') && (p[1] == '=') && (p[2] == 0)) {
	    value = (relation == 0);
	} else if ((p[0] == '!') && (p[1] == '=') && (p[2] == 0)) {
	    value = (relation != 0);
	} else {
	    goto compareError;
	}
	interp->result = (value) ? "1" : "0";
    } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
	    && (length >= 3)) {
	if (argc == 2) {
	    result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
		    (char *) textPtr, (char *) NULL, 0);
	} else if (argc == 3) {
	    result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,







|







437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
	} else if ((p[0] == '=') && (p[1] == '=') && (p[2] == 0)) {
	    value = (relation == 0);
	} else if ((p[0] == '!') && (p[1] == '=') && (p[2] == 0)) {
	    value = (relation != 0);
	} else {
	    goto compareError;
	}
	Tcl_SetResult(interp, ((value) ? "1" : "0"), TCL_STATIC);
    } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
	    && (length >= 3)) {
	if (argc == 2) {
	    result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
		    (char *) textPtr, (char *) NULL, 0);
	} else if (argc == 3) {
	    result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519

520
521

522
523
524
525
526
527
528
	if (argc > 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " debug boolean\"", (char *) NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	if (argc == 2) {
	    interp->result = (tkBTreeDebug) ? "1" : "0";
	} else {
	    if (Tcl_GetBoolean(interp, argv[2], &tkBTreeDebug) != TCL_OK) {
		result = TCL_ERROR;
		goto done;
	    }
	    tkTextDebug = tkBTreeDebug;
	}
    } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)
	    && (length >= 3)) {
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " delete index1 ?index2?\"", (char *) NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	if (textPtr->state == tkTextNormalUid) {
	    result = DeleteChars(textPtr, argv[2],
		    (argc == 4) ? argv[3] : (char *) NULL);
	}
    } else if ((c == 'd') && (strncmp(argv[1], "dlineinfo", length) == 0)
	    && (length >= 2)) {
	int x, y, width, height, base;

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " dlineinfo index\"", (char *) NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (TkTextDLineInfo(textPtr, &index1, &x, &y, &width, &height, &base)
		== 0) {

	    sprintf(interp->result, "%d %d %d %d %d", x, y, width,
		    height, base);

	}
    } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " get index1 ?index2?\"", (char *) NULL);
	    result = TCL_ERROR;
	    goto done;







|















|



















>
|
|
>







459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
	if (argc > 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " debug boolean\"", (char *) NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	if (argc == 2) {
	    Tcl_SetResult(interp, ((tkBTreeDebug) ? "1" : "0"), TCL_STATIC);
	} else {
	    if (Tcl_GetBoolean(interp, argv[2], &tkBTreeDebug) != TCL_OK) {
		result = TCL_ERROR;
		goto done;
	    }
	    tkTextDebug = tkBTreeDebug;
	}
    } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)
	    && (length >= 3)) {
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " delete index1 ?index2?\"", (char *) NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	if (textPtr->state == Tk_GetUid("normal")) {
	    result = DeleteChars(textPtr, argv[2],
		    (argc == 4) ? argv[3] : (char *) NULL);
	}
    } else if ((c == 'd') && (strncmp(argv[1], "dlineinfo", length) == 0)
	    && (length >= 2)) {
	int x, y, width, height, base;

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " dlineinfo index\"", (char *) NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (TkTextDLineInfo(textPtr, &index1, &x, &y, &width, &height, &base)
		== 0) {
	    char buf[TCL_INTEGER_SPACE * 5];
	    
	    sprintf(buf, "%d %d %d %d %d", x, y, width, height, base);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	}
    } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " get index1 ?index2?\"", (char *) NULL);
	    result = TCL_ERROR;
	    goto done;
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572


573
574
575
576
577
578
579
580
581
582
583
584

585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
	    TkTextSegment *segPtr;

	    segPtr = TkTextIndexToSeg(&index1, &offset);
	    last = segPtr->size;
	    if (index1.linePtr == index2.linePtr) {
		int last2;

		if (index2.charIndex == index1.charIndex) {
		    break;
		}
		last2 = index2.charIndex - index1.charIndex + offset;
		if (last2 < last) {
		    last = last2;
		}
	    }
	    if (segPtr->typePtr == &tkTextCharType) {
		savedChar = segPtr->body.chars[last];
		segPtr->body.chars[last] = 0;
		Tcl_AppendResult(interp, segPtr->body.chars + offset,
			(char *) NULL);
		segPtr->body.chars[last] = savedChar;
	    }
	    TkTextIndexForwChars(&index1, last-offset, &index1);
	}
    } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
	    && (length >= 3)) {


	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " index index\"",
		    (char *) NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	TkTextPrintIndex(&index1, interp->result);

    } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
	    && (length >= 3)) {
	int i, j, numTags;
	char **tagNames;
	TkTextTag **oldTagArrayPtr;

	if (argc < 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0],
		    " insert index chars ?tagList chars tagList ...?\"",
		    (char *) NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (textPtr->state == tkTextNormalUid) {
	    for (j = 3;  j < argc; j += 2) {
		InsertChars(textPtr, &index1, argv[j]);
		if (argc > (j+1)) {
		    TkTextIndexForwChars(&index1, (int) strlen(argv[j]),
			    &index2);
		    oldTagArrayPtr = TkBTreeGetTags(&index1, &numTags);
		    if (oldTagArrayPtr != NULL) {
			for (i = 0; i < numTags; i++) {
			    TkBTreeTag(&index1, &index2, oldTagArrayPtr[i], 0);
			}
			ckfree((char *) oldTagArrayPtr);







|


|











|



>
>











|
>


















|



|







531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
	    TkTextSegment *segPtr;

	    segPtr = TkTextIndexToSeg(&index1, &offset);
	    last = segPtr->size;
	    if (index1.linePtr == index2.linePtr) {
		int last2;

		if (index2.byteIndex == index1.byteIndex) {
		    break;
		}
		last2 = index2.byteIndex - index1.byteIndex + offset;
		if (last2 < last) {
		    last = last2;
		}
	    }
	    if (segPtr->typePtr == &tkTextCharType) {
		savedChar = segPtr->body.chars[last];
		segPtr->body.chars[last] = 0;
		Tcl_AppendResult(interp, segPtr->body.chars + offset,
			(char *) NULL);
		segPtr->body.chars[last] = savedChar;
	    }
	    TkTextIndexForwBytes(&index1, last-offset, &index1);
	}
    } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
	    && (length >= 3)) {
	char buf[200];

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " index index\"",
		    (char *) NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	TkTextPrintIndex(&index1, buf);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
	    && (length >= 3)) {
	int i, j, numTags;
	char **tagNames;
	TkTextTag **oldTagArrayPtr;

	if (argc < 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0],
		    " insert index chars ?tagList chars tagList ...?\"",
		    (char *) NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (textPtr->state == Tk_GetUid("normal")) {
	    for (j = 3;  j < argc; j += 2) {
		InsertChars(textPtr, &index1, argv[j]);
		if (argc > (j+1)) {
		    TkTextIndexForwBytes(&index1, (int) strlen(argv[j]),
			    &index2);
		    oldTagArrayPtr = TkBTreeGetTags(&index1, &numTags);
		    if (oldTagArrayPtr != NULL) {
			for (i = 0; i < numTags; i++) {
			    TkBTreeTag(&index1, &index2, oldTagArrayPtr[i], 0);
			}
			ckfree((char *) oldTagArrayPtr);
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a text widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as text string, colors, font,
 *	etc. get set for textPtr;  old resources get freed, if there
 *	were any.
 *
 *----------------------------------------------------------------------







|







728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
 *
 *	This procedure is called to process an argv/argc list, plus
 *	the Tk option database, in order to configure (or
 *	reconfigure) a text widget.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information, such as text string, colors, font,
 *	etc. get set for textPtr;  old resources get freed, if there
 *	were any.
 *
 *----------------------------------------------------------------------
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
    }

    /*
     * A few other options also need special processing, such as parsing
     * the geometry and setting the background from a 3-D border.
     */

    if ((textPtr->state != tkTextNormalUid)
	    && (textPtr->state != tkTextDisabledUid)) {
	Tcl_AppendResult(interp, "bad state value \"", textPtr->state,
		"\": must be normal or disabled", (char *) NULL);
	textPtr->state = tkTextNormalUid;
	return TCL_ERROR;
    }

    if ((textPtr->wrapMode != tkTextCharUid)
	    && (textPtr->wrapMode != tkTextNoneUid)
	    && (textPtr->wrapMode != tkTextWordUid)) {
	Tcl_AppendResult(interp, "bad wrap mode \"", textPtr->wrapMode,
		"\": must be char, none, or word", (char *) NULL);
	textPtr->wrapMode = tkTextCharUid;
	return TCL_ERROR;
    }

    Tk_SetBackgroundFromBorder(textPtr->tkwin, textPtr->border);

    /*
     * Don't allow negative spacings.







|
|


|



|
|
|


|







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
    }

    /*
     * A few other options also need special processing, such as parsing
     * the geometry and setting the background from a 3-D border.
     */

    if ((textPtr->state != Tk_GetUid("normal"))
	    && (textPtr->state != Tk_GetUid("disabled"))) {
	Tcl_AppendResult(interp, "bad state value \"", textPtr->state,
		"\": must be normal or disabled", (char *) NULL);
	textPtr->state = Tk_GetUid("normal");
	return TCL_ERROR;
    }

    if ((textPtr->wrapMode != Tk_GetUid("char"))
	    && (textPtr->wrapMode != Tk_GetUid("none"))
	    && (textPtr->wrapMode != Tk_GetUid("word"))) {
	Tcl_AppendResult(interp, "bad wrap mode \"", textPtr->wrapMode,
		"\": must be char, none, or word", (char *) NULL);
	textPtr->wrapMode = Tk_GetUid("char");
	return TCL_ERROR;
    }

    Tk_SetBackgroundFromBorder(textPtr->tkwin, textPtr->border);

    /*
     * Don't allow negative spacings.
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
     * are tagged characters.
     */

    if (textPtr->exportSelection && (!oldExport)) {
	TkTextSearch search;
	TkTextIndex first, last;

	TkTextMakeIndex(textPtr->tree, 0, 0, &first);
	TkTextMakeIndex(textPtr->tree,
		TkBTreeNumLines(textPtr->tree), 0, &last);
	TkBTreeStartSearch(&first, &last, textPtr->selTagPtr, &search);
	if (TkBTreeCharTagged(&first, textPtr->selTagPtr)
		|| TkBTreeNextTag(&search)) {
	    Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY, TkTextLostSelection,
		    (ClientData) textPtr);
	    textPtr->flags |= GOT_SELECTION;







|
|







865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
     * are tagged characters.
     */

    if (textPtr->exportSelection && (!oldExport)) {
	TkTextSearch search;
	TkTextIndex first, last;

	TkTextMakeByteIndex(textPtr->tree, 0, 0, &first);
	TkTextMakeByteIndex(textPtr->tree,
		TkBTreeNumLines(textPtr->tree), 0, &last);
	TkBTreeStartSearch(&first, &last, textPtr->selTagPtr, &search);
	if (TkBTreeCharTagged(&first, textPtr->selTagPtr)
		|| TkBTreeNextTag(&search)) {
	    Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY, TkTextLostSelection,
		    (ClientData) textPtr);
	    textPtr->flags |= GOT_SELECTION;
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
    /*
     * Don't allow insertions on the last (dummy) line of the text.
     */

    lineIndex = TkBTreeLineIndex(indexPtr->linePtr);
    if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
	lineIndex--;
	TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, indexPtr);
    }

    /*
     * Notify the display module that lines are about to change, then do
     * the insertion.  If the insertion occurs on the top line of the
     * widget (textPtr->topIndex), then we have to recompute topIndex
     * after the insertion, since the insertion could invalidate it.
     */

    resetView = offset = 0;
    if (indexPtr->linePtr == textPtr->topIndex.linePtr) {
	resetView = 1;
	offset = textPtr->topIndex.charIndex;
	if (offset > indexPtr->charIndex) {
	    offset += strlen(string);
	}
    }
    TkTextChanged(textPtr, indexPtr, indexPtr);
    TkBTreeInsertChars(indexPtr, string);
    if (resetView) {
	TkTextMakeIndex(textPtr->tree, lineIndex, 0, &newTop);
	TkTextIndexForwChars(&newTop, offset, &newTop);
	TkTextSetYView(textPtr, &newTop, 0);
    }

    /*
     * Invalidate any selection retrievals in progress.
     */








|












|
|






|
|







1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
    /*
     * Don't allow insertions on the last (dummy) line of the text.
     */

    lineIndex = TkBTreeLineIndex(indexPtr->linePtr);
    if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
	lineIndex--;
	TkTextMakeByteIndex(textPtr->tree, lineIndex, 1000000, indexPtr);
    }

    /*
     * Notify the display module that lines are about to change, then do
     * the insertion.  If the insertion occurs on the top line of the
     * widget (textPtr->topIndex), then we have to recompute topIndex
     * after the insertion, since the insertion could invalidate it.
     */

    resetView = offset = 0;
    if (indexPtr->linePtr == textPtr->topIndex.linePtr) {
	resetView = 1;
	offset = textPtr->topIndex.byteIndex;
	if (offset > indexPtr->byteIndex) {
	    offset += strlen(string);
	}
    }
    TkTextChanged(textPtr, indexPtr, indexPtr);
    TkBTreeInsertChars(indexPtr, string);
    if (resetView) {
	TkTextMakeByteIndex(textPtr->tree, lineIndex, 0, &newTop);
	TkTextIndexForwBytes(&newTop, offset, &newTop);
	TkTextSetYView(textPtr, &newTop, 0);
    }

    /*
     * Invalidate any selection retrievals in progress.
     */

1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
    char *index1String;		/* String describing location of first
				 * character to delete. */
    char *index2String;		/* String describing location of last
				 * character to delete.  NULL means just
				 * delete the one character given by
				 * index1String. */
{
    int line1, line2, line, charIndex, resetView;
    TkTextIndex index1, index2;

    /*
     * Parse the starting and stopping indices.
     */

    if (TkTextGetIndex(textPtr->interp, textPtr, index1String, &index1)







|







1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
    char *index1String;		/* String describing location of first
				 * character to delete. */
    char *index2String;		/* String describing location of last
				 * character to delete.  NULL means just
				 * delete the one character given by
				 * index1String. */
{
    int line1, line2, line, byteIndex, resetView;
    TkTextIndex index1, index2;

    /*
     * Parse the starting and stopping indices.
     */

    if (TkTextGetIndex(textPtr->interp, textPtr, index1String, &index1)
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
	TkTextTag **arrayPtr;
	int arraySize, i;
	TkTextIndex oldIndex2;

	oldIndex2 = index2;
	TkTextIndexBackChars(&oldIndex2, 1, &index2);
	line2--;
	if ((index1.charIndex == 0) && (line1 != 0)) {
	    TkTextIndexBackChars(&index1, 1, &index1);
	    line1--;
	}
	arrayPtr = TkBTreeGetTags(&index2, &arraySize);
	if (arrayPtr != NULL) {
	    for (i = 0; i < arraySize; i++) {
		TkBTreeTag(&index2, &oldIndex2, arrayPtr[i], 0);







|







1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
	TkTextTag **arrayPtr;
	int arraySize, i;
	TkTextIndex oldIndex2;

	oldIndex2 = index2;
	TkTextIndexBackChars(&oldIndex2, 1, &index2);
	line2--;
	if ((index1.byteIndex == 0) && (line1 != 0)) {
	    TkTextIndexBackChars(&index1, 1, &index1);
	    line1--;
	}
	arrayPtr = TkBTreeGetTags(&index2, &arraySize);
	if (arrayPtr != NULL) {
	    for (i = 0; i < arraySize; i++) {
		TkBTreeTag(&index2, &oldIndex2, arrayPtr[i], 0);
1245
1246
1247
1248
1249
1250
1251
1252


1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
     * if the deletion involves the top line on the screen, then
     * we have to reset the view (the deletion will invalidate
     * textPtr->topIndex).  Compute what the new first character
     * will be, then do the deletion, then reset the view.
     */

    TkTextChanged(textPtr, &index1, &index2);
    resetView = line = charIndex = 0;


    if (TkTextIndexCmp(&index2, &textPtr->topIndex) >= 0) {
	if (TkTextIndexCmp(&index1, &textPtr->topIndex) <= 0) {
	    /*
	     * Deletion range straddles topIndex: use the beginning
	     * of the range as the new topIndex.
	     */

	    resetView = 1;
	    line = line1;
	    charIndex = index1.charIndex;
	} else if (index1.linePtr == textPtr->topIndex.linePtr) {
	    /*
	     * Deletion range starts on top line but after topIndex.
	     * Use the current topIndex as the new one.
	     */

	    resetView = 1;
	    line = line1;
	    charIndex = textPtr->topIndex.charIndex;
	}
    } else if (index2.linePtr == textPtr->topIndex.linePtr) {
	/*
	 * Deletion range ends on top line but before topIndex.
	 * Figure out what will be the new character index for
	 * the character currently pointed to by topIndex.
	 */

	resetView = 1;
	line = line2;
	charIndex = textPtr->topIndex.charIndex;
	if (index1.linePtr != index2.linePtr) {
	    charIndex -= index2.charIndex;
	} else {
	    charIndex -= (index2.charIndex - index1.charIndex);
	}
    }
    TkBTreeDeleteChars(&index1, &index2);
    if (resetView) {
	TkTextMakeIndex(textPtr->tree, line, charIndex, &index1);
	TkTextSetYView(textPtr, &index1, 0);
    }

    /*
     * Invalidate any selection retrievals in progress.
     */








|
>
>









|








|










|

|

|




|







1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
     * if the deletion involves the top line on the screen, then
     * we have to reset the view (the deletion will invalidate
     * textPtr->topIndex).  Compute what the new first character
     * will be, then do the deletion, then reset the view.
     */

    TkTextChanged(textPtr, &index1, &index2);
    resetView = 0;
    line = 0;
    byteIndex = 0;
    if (TkTextIndexCmp(&index2, &textPtr->topIndex) >= 0) {
	if (TkTextIndexCmp(&index1, &textPtr->topIndex) <= 0) {
	    /*
	     * Deletion range straddles topIndex: use the beginning
	     * of the range as the new topIndex.
	     */

	    resetView = 1;
	    line = line1;
	    byteIndex = index1.byteIndex;
	} else if (index1.linePtr == textPtr->topIndex.linePtr) {
	    /*
	     * Deletion range starts on top line but after topIndex.
	     * Use the current topIndex as the new one.
	     */

	    resetView = 1;
	    line = line1;
	    byteIndex = textPtr->topIndex.byteIndex;
	}
    } else if (index2.linePtr == textPtr->topIndex.linePtr) {
	/*
	 * Deletion range ends on top line but before topIndex.
	 * Figure out what will be the new character index for
	 * the character currently pointed to by topIndex.
	 */

	resetView = 1;
	line = line2;
	byteIndex = textPtr->topIndex.byteIndex;
	if (index1.linePtr != index2.linePtr) {
	    byteIndex -= index2.byteIndex;
	} else {
	    byteIndex -= (index2.byteIndex - index1.byteIndex);
	}
    }
    TkBTreeDeleteChars(&index1, &index2);
    if (resetView) {
	TkTextMakeByteIndex(textPtr->tree, line, byteIndex, &index1);
	TkTextSetYView(textPtr, &index1, 0);
    }

    /*
     * Invalidate any selection retrievals in progress.
     */

1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
     * the selection is being retrieved in multiple pieces (offset != 0)
     * and some modification has been made to the text that affects the
     * selection then reject the selection request (make 'em start over
     * again).
     */

    if (offset == 0) {
	TkTextMakeIndex(textPtr->tree, 0, 0, &textPtr->selIndex);
	textPtr->abortSelections = 0;
    } else if (textPtr->abortSelections) {
	return 0;
    }
    TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &eof);
    TkBTreeStartSearch(&textPtr->selIndex, &eof, textPtr->selTagPtr, &search);
    if (!TkBTreeCharTagged(&textPtr->selIndex, textPtr->selTagPtr)) {
	if (!TkBTreeNextTag(&search)) {
	    if (offset == 0) {
		return -1;
	    } else {
		return 0;







|




|







1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
     * the selection is being retrieved in multiple pieces (offset != 0)
     * and some modification has been made to the text that affects the
     * selection then reject the selection request (make 'em start over
     * again).
     */

    if (offset == 0) {
	TkTextMakeByteIndex(textPtr->tree, 0, 0, &textPtr->selIndex);
	textPtr->abortSelections = 0;
    } else if (textPtr->abortSelections) {
	return 0;
    }
    TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &eof);
    TkBTreeStartSearch(&textPtr->selIndex, &eof, textPtr->selTagPtr, &search);
    if (!TkBTreeCharTagged(&textPtr->selIndex, textPtr->selTagPtr)) {
	if (!TkBTreeNextTag(&search)) {
	    if (offset == 0) {
		return -1;
	    } else {
		return 0;
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
	    chunkSize = segPtr->size - offsetInSeg;
	    if (chunkSize > maxBytes) {
		chunkSize = maxBytes;
	    }
	    if (textPtr->selIndex.linePtr == search.curIndex.linePtr) {
		int leftInRange;

		leftInRange = search.curIndex.charIndex
			- textPtr->selIndex.charIndex;
		if (leftInRange < chunkSize) {
		    chunkSize = leftInRange;
		    if (chunkSize <= 0) {
			break;
		    }
		}
	    }
	    if (segPtr->typePtr == &tkTextCharType) {
		memcpy((VOID *) buffer, (VOID *) (segPtr->body.chars
			+ offsetInSeg), (size_t) chunkSize);
		buffer += chunkSize;
		maxBytes -= chunkSize;
		count += chunkSize;
	    }
	    TkTextIndexForwChars(&textPtr->selIndex, chunkSize,
		    &textPtr->selIndex);
	}

	/*
	 * Find the beginning of the next range of selected text.
	 */








|
|














|







1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
	    chunkSize = segPtr->size - offsetInSeg;
	    if (chunkSize > maxBytes) {
		chunkSize = maxBytes;
	    }
	    if (textPtr->selIndex.linePtr == search.curIndex.linePtr) {
		int leftInRange;

		leftInRange = search.curIndex.byteIndex
			- textPtr->selIndex.byteIndex;
		if (leftInRange < chunkSize) {
		    chunkSize = leftInRange;
		    if (chunkSize <= 0) {
			break;
		    }
		}
	    }
	    if (segPtr->typePtr == &tkTextCharType) {
		memcpy((VOID *) buffer, (VOID *) (segPtr->body.chars
			+ offsetInSeg), (size_t) chunkSize);
		buffer += chunkSize;
		maxBytes -= chunkSize;
		count += chunkSize;
	    }
	    TkTextIndexForwBytes(&textPtr->selIndex, chunkSize,
		    &textPtr->selIndex);
	}

	/*
	 * Find the beginning of the next range of selected text.
	 */

1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488

    /*
     * On Windows and Mac systems, we want to remember the selection
     * for the next time the focus enters the window.  On Unix, 
     * just remove the "sel" tag from everything in the widget.
     */

    TkTextMakeIndex(textPtr->tree, 0, 0, &start);
    TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &end);
    TkTextRedrawTag(textPtr, &start, &end, textPtr->selTagPtr, 1);
    TkBTreeTag(&start, &end, textPtr->selTagPtr, 0);
#endif
    textPtr->flags &= ~GOT_SELECTION;
}

/*







|
|







1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477

    /*
     * On Windows and Mac systems, we want to remember the selection
     * for the next time the focus enters the window.  On Unix, 
     * just remove the "sel" tag from everything in the widget.
     */

    TkTextMakeByteIndex(textPtr->tree, 0, 0, &start);
    TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &end);
    TkTextRedrawTag(textPtr, &start, &end, textPtr->selTagPtr, 1);
    TkBTreeTag(&start, &end, textPtr->selTagPtr, 0);
#endif
    textPtr->flags &= ~GOT_SELECTION;
}

/*
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
    TkText *textPtr;		/* Information about text widget. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    int backwards, exact, c, i, argsLeft, noCase, leftToScan;
    size_t length;
    int numLines, startingLine, startingChar, lineNum, firstChar, lastChar;
    int code, matchLength, matchChar, passes, stopLine, searchWholeText;
    int patLength;
    char *arg, *pattern, *varName, *p, *startOfLine;
    char buffer[20];
    TkTextIndex index, stopIndex;
    Tcl_DString line, patDString;
    TkTextSegment *segPtr;
    TkTextLine *linePtr;







|
|







1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
    TkText *textPtr;		/* Information about text widget. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    int backwards, exact, c, i, argsLeft, noCase, leftToScan;
    size_t length;
    int numLines, startingLine, startingByte, lineNum, firstByte, lastByte;
    int code, matchLength, matchByte, passes, stopLine, searchWholeText;
    int patLength;
    char *arg, *pattern, *varName, *p, *startOfLine;
    char buffer[20];
    TkTextIndex index, stopIndex;
    Tcl_DString line, patDString;
    TkTextSegment *segPtr;
    TkTextLine *linePtr;
1590
1591
1592
1593
1594
1595
1596
1597

1598
1599
1600
1601
1602
1603
1604
	    return TCL_ERROR;
	}
	c = arg[1];
	if ((c == 'b') && (strncmp(argv[i], "-backwards", length) == 0)) {
	    backwards = 1;
	} else if ((c == 'c') && (strncmp(argv[i], "-count", length) == 0)) {
	    if (i >= (argc-1)) {
		interp->result = "no value given for \"-count\" option";

		return TCL_ERROR;
	    }
	    i++;
	    varName = argv[i];
	} else if ((c == 'e') && (strncmp(argv[i], "-exact", length) == 0)) {
	    exact = 1;
	} else if ((c == 'f') && (strncmp(argv[i], "-forwards", length) == 0)) {







|
>







1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
	    return TCL_ERROR;
	}
	c = arg[1];
	if ((c == 'b') && (strncmp(argv[i], "-backwards", length) == 0)) {
	    backwards = 1;
	} else if ((c == 'c') && (strncmp(argv[i], "-count", length) == 0)) {
	    if (i >= (argc-1)) {
		Tcl_SetResult(interp, "no value given for \"-count\" option",
			TCL_STATIC);
		return TCL_ERROR;
	    }
	    i++;
	    varName = argv[i];
	} else if ((c == 'e') && (strncmp(argv[i], "-exact", length) == 0)) {
	    exact = 1;
	} else if ((c == 'f') && (strncmp(argv[i], "-forwards", length) == 0)) {
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
     * Convert the pattern to lower-case if we're supposed to ignore case.
     */

    if (noCase) {
	Tcl_DStringInit(&patDString);
	Tcl_DStringAppend(&patDString, pattern, -1);
	pattern = Tcl_DStringValue(&patDString);
	for (p = pattern; *p != 0; p++) {
	    if (isupper(UCHAR(*p))) {
		*p = tolower(UCHAR(*p));
	    }
	}
    }

    if (TkTextGetIndex(interp, textPtr, argv[i+1], &index) != TCL_OK) {
	return TCL_ERROR;
    }
    numLines = TkBTreeNumLines(textPtr->tree);
    startingLine = TkBTreeLineIndex(index.linePtr);
    startingChar = index.charIndex;
    if (startingLine >= numLines) {
	if (backwards) {
	    startingLine = TkBTreeNumLines(textPtr->tree) - 1;
	    startingChar = TkBTreeCharsInLine(TkBTreeFindLine(textPtr->tree,
		    startingLine));
	} else {
	    startingLine = 0;
	    startingChar = 0;
	}
    }
    if (argsLeft == 1) {
	if (TkTextGetIndex(interp, textPtr, argv[i+2], &stopIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	stopLine = TkBTreeLineIndex(stopIndex.linePtr);







|
<
<
<
<







|



|



|







1617
1618
1619
1620
1621
1622
1623
1624




1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
     * Convert the pattern to lower-case if we're supposed to ignore case.
     */

    if (noCase) {
	Tcl_DStringInit(&patDString);
	Tcl_DStringAppend(&patDString, pattern, -1);
	pattern = Tcl_DStringValue(&patDString);
	Tcl_UtfToLower(pattern);




    }

    if (TkTextGetIndex(interp, textPtr, argv[i+1], &index) != TCL_OK) {
	return TCL_ERROR;
    }
    numLines = TkBTreeNumLines(textPtr->tree);
    startingLine = TkBTreeLineIndex(index.linePtr);
    startingByte = index.byteIndex;
    if (startingLine >= numLines) {
	if (backwards) {
	    startingLine = TkBTreeNumLines(textPtr->tree) - 1;
	    startingByte = TkBTreeBytesInLine(TkBTreeFindLine(textPtr->tree,
		    startingLine));
	} else {
	    startingLine = 0;
	    startingByte = 0;
	}
    }
    if (argsLeft == 1) {
	if (TkTextGetIndex(interp, textPtr, argv[i+2], &stopIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	stopLine = TkBTreeLineIndex(stopIndex.linePtr);
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779


1780
1781

1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818









1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860

1861
1862
1863
1864
1865
1866
1867
	startOfLine = Tcl_DStringValue(&line);

	/*
	 * If we're ignoring case, convert the line to lower case.
	 */

	if (noCase) {
	    for (p = Tcl_DStringValue(&line); *p != 0; p++) {
		if (isupper(UCHAR(*p))) {
		    *p = tolower(UCHAR(*p));
		}
	    }
	}

	/*
	 * Check for matches within the current line.  If so, and if we're
	 * searching backwards, repeat the search to find the last match
	 * in the line.
	 */

	matchChar = -1;
	firstChar = 0;
	lastChar = INT_MAX;
	if (lineNum == startingLine) {
	    int indexInDString;

	    /*
	     * The starting line is tricky: the first time we see it
	     * we check one part of the line, and the second pass through
	     * we check the other part of the line.  We have to be very
	     * careful here because there could be embedded windows or
	     * other things that are not in the extracted line.  Rescan
	     * the original line to compute the index in it of the first
	     * character.
	     */

	    indexInDString = startingChar;
	    for (segPtr = linePtr->segPtr, leftToScan = startingChar;
		    leftToScan > 0; segPtr = segPtr->nextPtr) {
		if (segPtr->typePtr != &tkTextCharType) {
		    indexInDString -= segPtr->size;
		}
		leftToScan -= segPtr->size;
	    }

	    passes++;
	    if ((passes == 1) ^ backwards) {
		/*
		 * Only use the last part of the line.
		 */

		firstChar = indexInDString;
		if (firstChar >= Tcl_DStringLength(&line)) {
		    goto nextLine;
		}
	    } else {
		/*
		 * Use only the first part of the line.
		 */

		lastChar = indexInDString;
	    }
	}
	do {
	    int thisLength;


	    if (exact) {
		p = strstr(startOfLine + firstChar, pattern);

		if (p == NULL) {
		    break;
		}
		i = p - startOfLine;
		thisLength = patLength;
	    } else {
		char *start, *end;
		int match;

		match = Tcl_RegExpExec(interp, regexp,
			startOfLine + firstChar, startOfLine);
		if (match < 0) {
		    code = TCL_ERROR;
		    goto done;
		}
		if (!match) {
		    break;
		}
		Tcl_RegExpRange(regexp, 0, &start, &end);
		i = start - startOfLine;
		thisLength = end - start;
	    }
	    if (i >= lastChar) {
		break;
	    }
	    matchChar = i;
	    matchLength = thisLength;
	    firstChar = matchChar+1;
	} while (backwards);

	/*
	 * If we found a match then we're done.  Make sure that
	 * the match occurred before the stopping index, if one was
	 * specified.
	 */

	if (matchChar >= 0) {









	    /*
	     * The index information returned by the regular expression
	     * parser only considers textual information:  it doesn't
	     * account for embedded windows or any other non-textual info.
	     * Scan through the line's segments again to adjust both
	     * matchChar and matchCount.
	     */

	    for (segPtr = linePtr->segPtr, leftToScan = matchChar;
		    leftToScan >= 0; segPtr = segPtr->nextPtr) {
		if (segPtr->typePtr != &tkTextCharType) {
		    matchChar += segPtr->size;
		    continue;
		}
		leftToScan -= segPtr->size;
	    }
	    for (leftToScan += matchLength; leftToScan > 0;
		    segPtr = segPtr->nextPtr) {
		if (segPtr->typePtr != &tkTextCharType) {
		    matchLength += segPtr->size;
		    continue;
		}
		leftToScan -= segPtr->size;
	    }
	    TkTextMakeIndex(textPtr->tree, lineNum, matchChar, &index);
	    if (!searchWholeText) {
		if (!backwards && (TkTextIndexCmp(&index, &stopIndex) >= 0)) {
		    goto done;
		}
		if (backwards && (TkTextIndexCmp(&index, &stopIndex) < 0)) {
		    goto done;
		}
	    }
	    if (varName != NULL) {
		sprintf(buffer, "%d", matchLength);
		if (Tcl_SetVar(interp, varName, buffer, TCL_LEAVE_ERR_MSG)
			== NULL) {
		    code = TCL_ERROR;
		    goto done;
		}
	    }
	    TkTextPrintIndex(&index, interp->result);

	    goto done;
	}

	/*
	 * Go to the next (or previous) line;
	 */








|
<
|
<
<








|
|
|













|
|













|
|







|




>
>

|
>










|











|


|

|








|
>
>
>
>
>
>
>
>
>








|


|







|




|









|






|
>







1701
1702
1703
1704
1705
1706
1707
1708

1709


1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
	startOfLine = Tcl_DStringValue(&line);

	/*
	 * If we're ignoring case, convert the line to lower case.
	 */

	if (noCase) {
	    Tcl_DStringSetLength(&line,

		    Tcl_UtfToLower(Tcl_DStringValue(&line)));


	}

	/*
	 * Check for matches within the current line.  If so, and if we're
	 * searching backwards, repeat the search to find the last match
	 * in the line.
	 */

	matchByte = -1;
	firstByte = 0;
	lastByte = INT_MAX;
	if (lineNum == startingLine) {
	    int indexInDString;

	    /*
	     * The starting line is tricky: the first time we see it
	     * we check one part of the line, and the second pass through
	     * we check the other part of the line.  We have to be very
	     * careful here because there could be embedded windows or
	     * other things that are not in the extracted line.  Rescan
	     * the original line to compute the index in it of the first
	     * character.
	     */

	    indexInDString = startingByte;
	    for (segPtr = linePtr->segPtr, leftToScan = startingByte;
		    leftToScan > 0; segPtr = segPtr->nextPtr) {
		if (segPtr->typePtr != &tkTextCharType) {
		    indexInDString -= segPtr->size;
		}
		leftToScan -= segPtr->size;
	    }

	    passes++;
	    if ((passes == 1) ^ backwards) {
		/*
		 * Only use the last part of the line.
		 */

		firstByte = indexInDString;
		if (firstByte >= Tcl_DStringLength(&line)) {
		    goto nextLine;
		}
	    } else {
		/*
		 * Use only the first part of the line.
		 */

		lastByte = indexInDString;
	    }
	}
	do {
	    int thisLength;
	    Tcl_UniChar ch;

	    if (exact) {
		p = strstr(startOfLine + firstByte,	/* INTL: Native. */
			pattern); 
		if (p == NULL) {
		    break;
		}
		i = p - startOfLine;
		thisLength = patLength;
	    } else {
		char *start, *end;
		int match;

		match = Tcl_RegExpExec(interp, regexp,
			startOfLine + firstByte, startOfLine);
		if (match < 0) {
		    code = TCL_ERROR;
		    goto done;
		}
		if (!match) {
		    break;
		}
		Tcl_RegExpRange(regexp, 0, &start, &end);
		i = start - startOfLine;
		thisLength = end - start;
	    }
	    if (i >= lastByte) {
		break;
	    }
	    matchByte = i;
	    matchLength = thisLength;
	    firstByte += Tcl_UtfToUniChar(startOfLine + matchByte, &ch);
	} while (backwards);

	/*
	 * If we found a match then we're done.  Make sure that
	 * the match occurred before the stopping index, if one was
	 * specified.
	 */

	if (matchByte >= 0) {
	    int numChars;

	    /*
	     * Convert the byte length to a character count.
	     */

	    numChars = Tcl_NumUtfChars(startOfLine + matchByte,
		    matchLength);

	    /*
	     * The index information returned by the regular expression
	     * parser only considers textual information:  it doesn't
	     * account for embedded windows or any other non-textual info.
	     * Scan through the line's segments again to adjust both
	     * matchChar and matchCount.
	     */

	    for (segPtr = linePtr->segPtr, leftToScan = matchByte;
		    leftToScan >= 0; segPtr = segPtr->nextPtr) {
		if (segPtr->typePtr != &tkTextCharType) {
		    matchByte += segPtr->size;
		    continue;
		}
		leftToScan -= segPtr->size;
	    }
	    for (leftToScan += matchLength; leftToScan > 0;
		    segPtr = segPtr->nextPtr) {
		if (segPtr->typePtr != &tkTextCharType) {
		    numChars += segPtr->size;
		    continue;
		}
		leftToScan -= segPtr->size;
	    }
	    TkTextMakeByteIndex(textPtr->tree, lineNum, matchByte, &index);
	    if (!searchWholeText) {
		if (!backwards && (TkTextIndexCmp(&index, &stopIndex) >= 0)) {
		    goto done;
		}
		if (backwards && (TkTextIndexCmp(&index, &stopIndex) < 0)) {
		    goto done;
		}
	    }
	    if (varName != NULL) {
		sprintf(buffer, "%d", numChars);
		if (Tcl_SetVar(interp, varName, buffer, TCL_LEAVE_ERR_MSG)
			== NULL) {
		    code = TCL_ERROR;
		    goto done;
		}
	    }
	    TkTextPrintIndex(&index, buffer);
	    Tcl_SetResult(interp, buffer, TCL_VOLATILE);
	    goto done;
	}

	/*
	 * Go to the next (or previous) line;
	 */

1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
 *
 *	Parses a string description of a set of tab stops.
 *
 * Results:
 *	The return value is a pointer to a malloc'ed structure holding
 *	parsed information about the tab stops.  If an error occurred
 *	then the return value is NULL and an error message is left in
 *	interp->result.
 *
 * Side effects:
 *	Memory is allocated for the structure that is returned.  It is
 *	up to the caller to free this structure when it is no longer
 *	needed.
 *
 *----------------------------------------------------------------------







|







1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
 *
 *	Parses a string description of a set of tab stops.
 *
 * Results:
 *	The return value is a pointer to a malloc'ed structure holding
 *	parsed information about the tab stops.  If an error occurred
 *	then the return value is NULL and an error message is left in
 *	the interp's result.
 *
 * Side effects:
 *	Memory is allocated for the structure that is returned.  It is
 *	up to the caller to free this structure when it is no longer
 *	needed.
 *
 *----------------------------------------------------------------------
1924
1925
1926
1927
1928
1929
1930

1931
1932
1933
1934
1935
1936
1937
    char *string;			/* Description of the tab stops.  See
					 * the text manual entry for details. */
{
    int argc, i, count, c;
    char **argv;
    TkTextTabArray *tabArrayPtr;
    TkTextTab *tabPtr;


    if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
	return NULL;
    }

    /*
     * First find out how many entries we need to allocate in the







>







1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
    char *string;			/* Description of the tab stops.  See
					 * the text manual entry for details. */
{
    int argc, i, count, c;
    char **argv;
    TkTextTabArray *tabArrayPtr;
    TkTextTab *tabPtr;
    Tcl_UniChar ch;

    if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
	return NULL;
    }

    /*
     * First find out how many entries we need to allocate in the
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977

1978
1979
1980
1981
1982
1983
1984
	 * element.  Otherwise just use "left".
	 */

	tabPtr->alignment = LEFT;
	if ((i+1) == argc) {
	    continue;
	}
	c = UCHAR(argv[i+1][0]);
	if (!isalpha(c)) {
	    continue;
	}
	i += 1;

	if ((c == 'l') && (strncmp(argv[i], "left",
		strlen(argv[i])) == 0)) {
	    tabPtr->alignment = LEFT;
	} else if ((c == 'r') && (strncmp(argv[i], "right",
		strlen(argv[i])) == 0)) {
	    tabPtr->alignment = RIGHT;
	} else if ((c == 'c') && (strncmp(argv[i], "center",







|
|



>







1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
	 * element.  Otherwise just use "left".
	 */

	tabPtr->alignment = LEFT;
	if ((i+1) == argc) {
	    continue;
	}
	Tcl_UtfToUniChar(argv[i+1], &ch);
	if (!Tcl_UniCharIsAlpha(ch)) {
	    continue;
	}
	i += 1;
	c = argv[i][0];
	if ((c == 'l') && (strncmp(argv[i], "left",
		strlen(argv[i])) == 0)) {
	    tabPtr->alignment = LEFT;
	} else if ((c == 'r') && (strncmp(argv[i], "right",
		strlen(argv[i])) == 0)) {
	    tabPtr->alignment = RIGHT;
	} else if ((c == 'c') && (strncmp(argv[i], "center",
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
	}
    }
    if (TkTextIndexCmp(&index1, &index2) >= 0) {
	return TCL_OK;
    }
    if (index1.linePtr == index2.linePtr) {
	DumpLine(interp, textPtr, what, index1.linePtr,
	    index1.charIndex, index2.charIndex, lineno, command);
    } else {
	DumpLine(interp, textPtr, what, index1.linePtr,
		index1.charIndex, 32000000, lineno, command);
	linePtr = index1.linePtr;
	while ((linePtr = TkBTreeNextLine(linePtr)) != (TkTextLine *)NULL) {
	    lineno++;
	    if (linePtr == index2.linePtr) {
		break;
	    }
	    DumpLine(interp, textPtr, what, linePtr, 0, 32000000,
		    lineno, command);
	}
	DumpLine(interp, textPtr, what, index2.linePtr, 0,
		index2.charIndex, lineno, command);
    }
    /*
     * Special case to get the leftovers hiding at the end mark.
     */
    if (atEnd) {
	DumpLine(interp, textPtr, what & ~TK_DUMP_TEXT, index2.linePtr,
		0, 1, lineno, command);

    }
    return TCL_OK;
}

/*
 * DumpLine
 * 	Return information about a given text line from character
 *	position "start" up to, but not including, "end".
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None, but see DumpSegment.
 */
static void
DumpLine(interp, textPtr, what, linePtr, start, end, lineno, command)
    Tcl_Interp *interp;
    TkText *textPtr;
    int what;			/* bit flags to select segment types */
    TkTextLine *linePtr;	/* The current line */
    int start, end;		/* Character range to dump */
    int lineno;			/* Line number for indices dump */
    char *command;		/* Script to apply to the segment */
{
    int offset;
    TkTextSegment *segPtr;
    /*
     * Must loop through line looking at its segments.
     * character
     * toggleOn, toggleOff
     * mark
     * image
     * window
     */
    for (offset = 0, segPtr = linePtr->segPtr ;
	    (offset < end) && (segPtr != (TkTextSegment *)NULL) ;
	    offset += segPtr->size, segPtr = segPtr->nextPtr) {
	if ((what & TK_DUMP_TEXT) && (segPtr->typePtr == &tkTextCharType) &&
		(offset + segPtr->size > start)) {
	    char savedChar;			/* Last char used in the seg */
	    int last = segPtr->size;		/* Index of savedChar */
	    int first = 0;			/* Index of first char in seg */
	    if (offset + segPtr->size > end) {
		last = end - offset;
	    }
	    if (start > offset) {
		first = start - offset;
	    }
	    savedChar = segPtr->body.chars[last];
	    segPtr->body.chars[last] = '\0';
	    DumpSegment(interp, "text", segPtr->body.chars + first,
		    command, lineno, offset + first, what);
	    segPtr->body.chars[last] = savedChar;
	} else if ((offset >= start)) {
	    if ((what & TK_DUMP_MARK) && (segPtr->typePtr->name[0] == 'm')) {
		TkTextMark *markPtr = (TkTextMark *)&segPtr->body;
		char *name = Tcl_GetHashKey(&textPtr->markTable, markPtr->hPtr);
		DumpSegment(interp, "mark", name,
			command, lineno, offset, what);
	    } else if ((what & TK_DUMP_TAG) &&
			(segPtr->typePtr == &tkTextToggleOnType)) {







|


|










|






|

















|




|














|


|



|
|

|
|






|







2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
	}
    }
    if (TkTextIndexCmp(&index1, &index2) >= 0) {
	return TCL_OK;
    }
    if (index1.linePtr == index2.linePtr) {
	DumpLine(interp, textPtr, what, index1.linePtr,
	    index1.byteIndex, index2.byteIndex, lineno, command);
    } else {
	DumpLine(interp, textPtr, what, index1.linePtr,
		index1.byteIndex, 32000000, lineno, command);
	linePtr = index1.linePtr;
	while ((linePtr = TkBTreeNextLine(linePtr)) != (TkTextLine *)NULL) {
	    lineno++;
	    if (linePtr == index2.linePtr) {
		break;
	    }
	    DumpLine(interp, textPtr, what, linePtr, 0, 32000000,
		    lineno, command);
	}
	DumpLine(interp, textPtr, what, index2.linePtr, 0,
		index2.byteIndex, lineno, command);
    }
    /*
     * Special case to get the leftovers hiding at the end mark.
     */
    if (atEnd) {
	DumpLine(interp, textPtr, what & ~TK_DUMP_TEXT, index2.linePtr,
		0, 1, lineno, command);			    

    }
    return TCL_OK;
}

/*
 * DumpLine
 * 	Return information about a given text line from character
 *	position "start" up to, but not including, "end".
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None, but see DumpSegment.
 */
static void
DumpLine(interp, textPtr, what, linePtr, startByte, endByte, lineno, command)
    Tcl_Interp *interp;
    TkText *textPtr;
    int what;			/* bit flags to select segment types */
    TkTextLine *linePtr;	/* The current line */
    int startByte, endByte;	/* Byte range to dump */
    int lineno;			/* Line number for indices dump */
    char *command;		/* Script to apply to the segment */
{
    int offset;
    TkTextSegment *segPtr;
    /*
     * Must loop through line looking at its segments.
     * character
     * toggleOn, toggleOff
     * mark
     * image
     * window
     */
    for (offset = 0, segPtr = linePtr->segPtr ;
	    (offset < endByte) && (segPtr != (TkTextSegment *)NULL) ;
	    offset += segPtr->size, segPtr = segPtr->nextPtr) {
	if ((what & TK_DUMP_TEXT) && (segPtr->typePtr == &tkTextCharType) &&
		(offset + segPtr->size > startByte)) {
	    char savedChar;			/* Last char used in the seg */
	    int last = segPtr->size;		/* Index of savedChar */
	    int first = 0;			/* Index of first char in seg */
	    if (offset + segPtr->size > endByte) {
		last = endByte - offset;
	    }
	    if (startByte > offset) {
		first = startByte - offset;
	    }
	    savedChar = segPtr->body.chars[last];
	    segPtr->body.chars[last] = '\0';
	    DumpSegment(interp, "text", segPtr->body.chars + first,
		    command, lineno, offset + first, what);
	    segPtr->body.chars[last] = savedChar;
	} else if ((offset >= startByte)) {
	    if ((what & TK_DUMP_MARK) && (segPtr->typePtr->name[0] == 'm')) {
		TkTextMark *markPtr = (TkTextMark *)&segPtr->body;
		char *name = Tcl_GetHashKey(&textPtr->markTable, markPtr->hPtr);
		DumpSegment(interp, "mark", name,
			command, lineno, offset, what);
	    } else if ((what & TK_DUMP_TAG) &&
			(segPtr->typePtr == &tkTextToggleOnType)) {
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
static int
DumpSegment(interp, key, value, command, lineno, offset, what)
    Tcl_Interp *interp;
    char *key;			/* Segment type key */
    char *value;		/* Segment value */
    char *command;		/* Script callback */
    int lineno;			/* Line number for indices dump */
    int offset;			/* Character position */
    int what;			/* Look for TK_DUMP_INDEX bit */
{
    char buffer[30];
    sprintf(buffer, "%d.%d", lineno, offset);
    if (command == (char *) NULL) {
	Tcl_AppendElement(interp, key);
	Tcl_AppendElement(interp, value);
	Tcl_AppendElement(interp, buffer);
	return TCL_OK;
    } else {
	char *argv[4];







|



|







2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
static int
DumpSegment(interp, key, value, command, lineno, offset, what)
    Tcl_Interp *interp;
    char *key;			/* Segment type key */
    char *value;		/* Segment value */
    char *command;		/* Script callback */
    int lineno;			/* Line number for indices dump */
    int offset;			/* Byte position */
    int what;			/* Look for TK_DUMP_INDEX bit */
{
    char buffer[30];
    sprintf(buffer, "%d.%d", lineno, offset);		
    if (command == (char *) NULL) {
	Tcl_AppendElement(interp, key);
	Tcl_AppendElement(interp, value);
	Tcl_AppendElement(interp, buffer);
	return TCL_OK;
    } else {
	char *argv[4];

Changes to generic/tkText.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkText.h --
 *
 *	Declarations shared among the files that implement text
 *	widgets.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkText.h 1.46 96/11/25 11:26:12
 */

#ifndef _TKTEXT
#define _TKTEXT

#ifndef _TK
#include "tk.h"












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkText.h --
 *
 *	Declarations shared among the files that implement text
 *	widgets.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkText.h,v 1.1.4.4 1999/02/16 11:39:32 lfb Exp $
 */

#ifndef _TKTEXT
#define _TKTEXT

#ifndef _TK
#include "tk.h"
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
 * or tags don't invalidate indices.
 */

typedef struct TkTextIndex {
    TkTextBTree tree;			/* Tree containing desired position. */
    TkTextLine *linePtr;		/* Pointer to line containing position
					 * of interest. */
    int charIndex;			/* Index within line of desired
					 * character (0 means first one). */
} TkTextIndex;

/*
 * Types for procedure pointers stored in TkTextDispChunk strutures:
 */








|







172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
 * or tags don't invalidate indices.
 */

typedef struct TkTextIndex {
    TkTextBTree tree;			/* Tree containing desired position. */
    TkTextLine *linePtr;		/* Pointer to line containing position
					 * of interest. */
    int byteIndex;			/* Index within line of desired
					 * character (0 means first one). */
} TkTextIndex;

/*
 * Types for procedure pointers stored in TkTextDispChunk strutures:
 */

237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
					/* Procedure to invoke when segment
					 * ceases to be displayed on screen
					 * anymore. */
    Tk_ChunkMeasureProc *measureProc;	/* Procedure to find character under
					 * a given x-location. */
    Tk_ChunkBboxProc *bboxProc;		/* Procedure to find bounding box
					 * of character in chunk. */
    int numChars;			/* Number of characters that will be
					 * displayed in the chunk. */
    int minAscent;			/* Minimum space above the baseline
					 * needed by this chunk. */
    int minDescent;			/* Minimum space below the baseline
					 * needed by this chunk. */
    int minHeight;			/* Minimum total line height needed
					 * by this chunk. */
    int width;				/* Width of this chunk, in pixels.
					 * Initially set by chunk-specific
					 * code, but may be increased to
					 * include tab or extra space at end
					 * of line. */
    int breakIndex;			/* Index within chunk of last
					 * acceptable position for a line
					 * (break just before this character).
					 * <= 0 means don't break during or
					 * immediately after this chunk. */
    ClientData clientData;		/* Additional information for use
					 * of displayProc and undisplayProc. */
};

/*







|














|







237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
					/* Procedure to invoke when segment
					 * ceases to be displayed on screen
					 * anymore. */
    Tk_ChunkMeasureProc *measureProc;	/* Procedure to find character under
					 * a given x-location. */
    Tk_ChunkBboxProc *bboxProc;		/* Procedure to find bounding box
					 * of character in chunk. */
    int numBytes;			/* Number of bytes that will be
					 * displayed in the chunk. */
    int minAscent;			/* Minimum space above the baseline
					 * needed by this chunk. */
    int minDescent;			/* Minimum space below the baseline
					 * needed by this chunk. */
    int minHeight;			/* Minimum total line height needed
					 * by this chunk. */
    int width;				/* Width of this chunk, in pixels.
					 * Initially set by chunk-specific
					 * code, but may be increased to
					 * include tab or extra space at end
					 * of line. */
    int breakIndex;			/* Index within chunk of last
					 * acceptable position for a line
					 * (break just before this byte index).
					 * <= 0 means don't break during or
					 * immediately after this chunk. */
    ClientData clientData;		/* Additional information for use
					 * of displayProc and undisplayProc. */
};

/*
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
				 * associated window, there is no entry for
				 * it here. */
    Tcl_HashTable imageTable;	/* Hash table that maps from image names
				 * to pointers to image segments.  If an
				 * image segment doesn't yet have an
				 * associated image, there is no entry for
				 * it here. */
    Tk_Uid state;		/* Normal or disabled.  Text is read-only
				 * when disabled. */

    /*
     * Default information for displaying (may be overridden by tags
     * applied to ranges of characters).
     */

    Tk_3DBorder border;		/* Structure used to draw 3-D border and







|
|







466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
				 * associated window, there is no entry for
				 * it here. */
    Tcl_HashTable imageTable;	/* Hash table that maps from image names
				 * to pointers to image segments.  If an
				 * image segment doesn't yet have an
				 * associated image, there is no entry for
				 * it here. */
    Tk_Uid state;		/* Either normal or disabled. A text 
				 * widget is read-only when disabled. */

    /*
     * Default information for displaying (may be overridden by tags
     * applied to ranges of characters).
     */

    Tk_3DBorder border;		/* Structure used to draw 3-D border and
726
727
728
729
730
731
732

733
734
735
736
737
738
739
 * but shouldn't be used anywhere else in Tk (or by Tk clients):
 */

extern int		TkBTreeCharTagged _ANSI_ARGS_((TkTextIndex *indexPtr,
			    TkTextTag *tagPtr));
extern void		TkBTreeCheck _ANSI_ARGS_((TkTextBTree tree));
extern int		TkBTreeCharsInLine _ANSI_ARGS_((TkTextLine *linePtr));

extern TkTextBTree	TkBTreeCreate _ANSI_ARGS_((TkText *textPtr));
extern void		TkBTreeDestroy _ANSI_ARGS_((TkTextBTree tree));
extern void		TkBTreeDeleteChars _ANSI_ARGS_((TkTextIndex *index1Ptr,
			    TkTextIndex *index2Ptr));
extern TkTextLine *	TkBTreeFindLine _ANSI_ARGS_((TkTextBTree tree,
			    int line));
extern TkTextTag **	TkBTreeGetTags _ANSI_ARGS_((TkTextIndex *indexPtr,







>







726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
 * but shouldn't be used anywhere else in Tk (or by Tk clients):
 */

extern int		TkBTreeCharTagged _ANSI_ARGS_((TkTextIndex *indexPtr,
			    TkTextTag *tagPtr));
extern void		TkBTreeCheck _ANSI_ARGS_((TkTextBTree tree));
extern int		TkBTreeCharsInLine _ANSI_ARGS_((TkTextLine *linePtr));
extern int		TkBTreeBytesInLine _ANSI_ARGS_((TkTextLine *linePtr));
extern TkTextBTree	TkBTreeCreate _ANSI_ARGS_((TkText *textPtr));
extern void		TkBTreeDestroy _ANSI_ARGS_((TkTextBTree tree));
extern void		TkBTreeDeleteChars _ANSI_ARGS_((TkTextIndex *index1Ptr,
			    TkTextIndex *index2Ptr));
extern TkTextLine *	TkBTreeFindLine _ANSI_ARGS_((TkTextBTree tree,
			    int line));
extern TkTextTag **	TkBTreeGetTags _ANSI_ARGS_((TkTextIndex *indexPtr,
780
781
782
783
784
785
786



787

788
789

790



791

792
793
794
795
796
797
798
799
800
801
802



803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827

828
829
830
831
832
833
834
835
extern void		TkTextFreeTag _ANSI_ARGS_((TkText *textPtr,
			    TkTextTag *tagPtr));
extern int		TkTextGetIndex _ANSI_ARGS_((Tcl_Interp *interp,
			    TkText *textPtr, char *string,
			    TkTextIndex *indexPtr));
extern TkTextTabArray *	TkTextGetTabs _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *string));



extern void		TkTextIndexBackChars _ANSI_ARGS_((TkTextIndex *srcPtr,

			    int count, TkTextIndex *dstPtr));
extern int		TkTextIndexCmp _ANSI_ARGS_((TkTextIndex *index1Ptr,

			    TkTextIndex *index2Ptr));



extern void		TkTextIndexForwChars _ANSI_ARGS_((TkTextIndex *srcPtr,

			    int count, TkTextIndex *dstPtr));
extern TkTextSegment *	TkTextIndexToSeg _ANSI_ARGS_((TkTextIndex *indexPtr,
			    int *offsetPtr));
extern void		TkTextInsertDisplayProc _ANSI_ARGS_((
			    TkTextDispChunk *chunkPtr, int x, int y, int height,
			    int baseline, Display *display, Drawable dst,
			    int screenY));
extern void		TkTextLostSelection _ANSI_ARGS_((
			    ClientData clientData));
extern TkTextIndex *	TkTextMakeIndex _ANSI_ARGS_((TkTextBTree tree,
			    int lineIndex, int charIndex,



			    TkTextIndex *indexPtr));
extern int		TkTextMarkCmd _ANSI_ARGS_((TkText *textPtr,
			    Tcl_Interp *interp, int argc, char **argv));
extern int		TkTextMarkNameToIndex _ANSI_ARGS_((TkText *textPtr,
			    char *name, TkTextIndex *indexPtr));
extern void		TkTextMarkSegToIndex _ANSI_ARGS_((TkText *textPtr,
			    TkTextSegment *markPtr, TkTextIndex *indexPtr));
extern void		TkTextEventuallyRepick _ANSI_ARGS_((TkText *textPtr));
extern void		TkTextPickCurrent _ANSI_ARGS_((TkText *textPtr,
			    XEvent *eventPtr));
extern void		TkTextPixelIndex _ANSI_ARGS_((TkText *textPtr,
			    int x, int y, TkTextIndex *indexPtr));
extern void		TkTextPrintIndex _ANSI_ARGS_((TkTextIndex *indexPtr,
			    char *string));
extern void		TkTextRedrawRegion _ANSI_ARGS_((TkText *textPtr,
			    int x, int y, int width, int height));
extern void		TkTextRedrawTag _ANSI_ARGS_((TkText *textPtr,
			    TkTextIndex *index1Ptr, TkTextIndex *index2Ptr,
			    TkTextTag *tagPtr, int withTag));
extern void		TkTextRelayoutWindow _ANSI_ARGS_((TkText *textPtr));
extern int		TkTextScanCmd _ANSI_ARGS_((TkText *textPtr,
			    Tcl_Interp *interp, int argc, char **argv));
extern int		TkTextSeeCmd _ANSI_ARGS_((TkText *textPtr,
			    Tcl_Interp *interp, int argc, char **argv));
extern int		TkTextSegToOffset _ANSI_ARGS_((TkTextSegment *segPtr,

			    TkTextLine *linePtr));
extern TkTextSegment *	TkTextSetMark _ANSI_ARGS_((TkText *textPtr, char *name,
			    TkTextIndex *indexPtr));
extern void		TkTextSetYView _ANSI_ARGS_((TkText *textPtr,
			    TkTextIndex *indexPtr, int pickPlace));
extern int		TkTextTagCmd _ANSI_ARGS_((TkText *textPtr,
			    Tcl_Interp *interp, int argc, char **argv));
extern int		TkTextImageCmd _ANSI_ARGS_((TkText *textPtr,







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






|

>
>
>












|
|










|
>
|







781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
extern void		TkTextFreeTag _ANSI_ARGS_((TkText *textPtr,
			    TkTextTag *tagPtr));
extern int		TkTextGetIndex _ANSI_ARGS_((Tcl_Interp *interp,
			    TkText *textPtr, char *string,
			    TkTextIndex *indexPtr));
extern TkTextTabArray *	TkTextGetTabs _ANSI_ARGS_((Tcl_Interp *interp,
			    Tk_Window tkwin, char *string));
extern void		TkTextIndexBackBytes _ANSI_ARGS_((
			    CONST TkTextIndex *srcPtr, int count,
			    TkTextIndex *dstPtr));
extern void		TkTextIndexBackChars _ANSI_ARGS_((
			    CONST TkTextIndex *srcPtr, int count,
			    TkTextIndex *dstPtr));
extern int		TkTextIndexCmp _ANSI_ARGS_((
			    CONST TkTextIndex *index1Ptr,
			    CONST TkTextIndex *index2Ptr));
extern void		TkTextIndexForwBytes _ANSI_ARGS_((
			    CONST TkTextIndex *srcPtr, int count,
			    TkTextIndex *dstPtr));
extern void		TkTextIndexForwChars _ANSI_ARGS_((
			    CONST TkTextIndex *srcPtr, int count,
			    TkTextIndex *dstPtr));
extern TkTextSegment *	TkTextIndexToSeg _ANSI_ARGS_((
			    CONST TkTextIndex *indexPtr, int *offsetPtr));
extern void		TkTextInsertDisplayProc _ANSI_ARGS_((
			    TkTextDispChunk *chunkPtr, int x, int y, int height,
			    int baseline, Display *display, Drawable dst,
			    int screenY));
extern void		TkTextLostSelection _ANSI_ARGS_((
			    ClientData clientData));
extern TkTextIndex *	TkTextMakeCharIndex _ANSI_ARGS_((TkTextBTree tree,
			    int lineIndex, int charIndex,
			    TkTextIndex *indexPtr));
extern TkTextIndex *	TkTextMakeByteIndex _ANSI_ARGS_((TkTextBTree tree,
			    int lineIndex, int byteIndex,
			    TkTextIndex *indexPtr));
extern int		TkTextMarkCmd _ANSI_ARGS_((TkText *textPtr,
			    Tcl_Interp *interp, int argc, char **argv));
extern int		TkTextMarkNameToIndex _ANSI_ARGS_((TkText *textPtr,
			    char *name, TkTextIndex *indexPtr));
extern void		TkTextMarkSegToIndex _ANSI_ARGS_((TkText *textPtr,
			    TkTextSegment *markPtr, TkTextIndex *indexPtr));
extern void		TkTextEventuallyRepick _ANSI_ARGS_((TkText *textPtr));
extern void		TkTextPickCurrent _ANSI_ARGS_((TkText *textPtr,
			    XEvent *eventPtr));
extern void		TkTextPixelIndex _ANSI_ARGS_((TkText *textPtr,
			    int x, int y, TkTextIndex *indexPtr));
extern void		TkTextPrintIndex _ANSI_ARGS_((
			    CONST TkTextIndex *indexPtr, char *string));
extern void		TkTextRedrawRegion _ANSI_ARGS_((TkText *textPtr,
			    int x, int y, int width, int height));
extern void		TkTextRedrawTag _ANSI_ARGS_((TkText *textPtr,
			    TkTextIndex *index1Ptr, TkTextIndex *index2Ptr,
			    TkTextTag *tagPtr, int withTag));
extern void		TkTextRelayoutWindow _ANSI_ARGS_((TkText *textPtr));
extern int		TkTextScanCmd _ANSI_ARGS_((TkText *textPtr,
			    Tcl_Interp *interp, int argc, char **argv));
extern int		TkTextSeeCmd _ANSI_ARGS_((TkText *textPtr,
			    Tcl_Interp *interp, int argc, char **argv));
extern int		TkTextSegToOffset _ANSI_ARGS_((
			    CONST TkTextSegment *segPtr,
			    CONST TkTextLine *linePtr));
extern TkTextSegment *	TkTextSetMark _ANSI_ARGS_((TkText *textPtr, char *name,
			    TkTextIndex *indexPtr));
extern void		TkTextSetYView _ANSI_ARGS_((TkText *textPtr,
			    TkTextIndex *indexPtr, int pickPlace));
extern int		TkTextTagCmd _ANSI_ARGS_((TkText *textPtr,
			    Tcl_Interp *interp, int argc, char **argv));
extern int		TkTextImageCmd _ANSI_ARGS_((TkText *textPtr,

Changes to generic/tkTextBTree.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkTextBTree.c --
 *
 *	This file contains code that manages the B-tree representation
 *	of text for Tk's text widget and implements character and
 *	toggle segment types.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkTextBTree.c 1.37 97/04/25 16:52:00
 */

#include "tkInt.h"
#include "tkPort.h"
#include "tkText.h"

/*













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkTextBTree.c --
 *
 *	This file contains code that manages the B-tree representation
 *	of text for Tk's text widget and implements character and
 *	toggle segment types.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkTextBTree.c,v 1.1.4.2 1998/09/30 02:17:22 stanton Exp $
 */

#include "tkInt.h"
#include "tkPort.h"
#include "tkText.h"

/*
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
SplitSeg(indexPtr)
    TkTextIndex *indexPtr;		/* Index identifying position
					 * at which to split a segment. */
{
    TkTextSegment *prevPtr, *segPtr;
    int count;

    for (count = indexPtr->charIndex, prevPtr = NULL,
	    segPtr = indexPtr->linePtr->segPtr; segPtr != NULL;
	    count -= segPtr->size, prevPtr = segPtr, segPtr = segPtr->nextPtr) {
	if (segPtr->size > count) {
	    if (count == 0) {
		return prevPtr;
	    }
	    segPtr = (*segPtr->typePtr->splitProc)(segPtr, count);







|







531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
SplitSeg(indexPtr)
    TkTextIndex *indexPtr;		/* Index identifying position
					 * at which to split a segment. */
{
    TkTextSegment *prevPtr, *segPtr;
    int count;

    for (count = indexPtr->byteIndex, prevPtr = NULL,
	    segPtr = indexPtr->linePtr->segPtr; segPtr != NULL;
	    count -= segPtr->size, prevPtr = segPtr, segPtr = segPtr->nextPtr) {
	if (segPtr->size > count) {
	    if (count == 0) {
		return prevPtr;
	    }
	    segPtr = (*segPtr->typePtr->splitProc)(segPtr, count);
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
		    && (segPtr->body.toggle.tagPtr == tagPtr)) {
		/*
		 * It is possible that this is a tagoff tag, but that
		 * gets cleaned up later.
		 */
		indexPtr->tree = tree;
		indexPtr->linePtr = linePtr;
		indexPtr->charIndex = offset;
		return segPtr;
	    }
	}
    }
    return NULL;
}








|







1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
		    && (segPtr->body.toggle.tagPtr == tagPtr)) {
		/*
		 * It is possible that this is a tagoff tag, but that
		 * gets cleaned up later.
		 */
		indexPtr->tree = tree;
		indexPtr->linePtr = linePtr;
		indexPtr->byteIndex = offset;
		return segPtr;
	    }
	}
    }
    return NULL;
}

1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
	    lastLinePtr = linePtr;
	    last2SegPtr = lastSegPtr;
	    lastoffset2 = lastoffset;
	}
    }
    indexPtr->tree = tree;
    indexPtr->linePtr = lastLinePtr;
    indexPtr->charIndex = lastoffset2;
    return last2SegPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TkBTreeStartSearch --







|







1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
	    lastLinePtr = linePtr;
	    last2SegPtr = lastSegPtr;
	    lastoffset2 = lastoffset;
	}
    }
    indexPtr->tree = tree;
    indexPtr->linePtr = lastLinePtr;
    indexPtr->byteIndex = lastoffset2;
    return last2SegPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TkBTreeStartSearch --
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
	searchPtr->segPtr = NULL;
	searchPtr->nextPtr = seg0Ptr;	/* Will be returned by NextTag */
	index1Ptr = &index0;
    } else {
	searchPtr->curIndex = *index1Ptr;
	searchPtr->segPtr = NULL;
	searchPtr->nextPtr = TkTextIndexToSeg(index1Ptr, &offset);
	searchPtr->curIndex.charIndex -= offset;
    }
    searchPtr->lastPtr = TkTextIndexToSeg(index2Ptr, (int *) NULL);
    searchPtr->tagPtr = tagPtr;
    searchPtr->linesLeft = TkBTreeLineIndex(index2Ptr->linePtr) + 1
	    - TkBTreeLineIndex(index1Ptr->linePtr);
    searchPtr->allTags = (tagPtr == NULL);
    if (searchPtr->linesLeft == 1) {
	/*
	 * Starting and stopping segments are in the same line; mark the
	 * search as over immediately if the second segment is before the
	 * first.  A search does not return a toggle at the very start of
	 * the range, unless the range is artificially moved up to index0.
	 */
	if (((index1Ptr == &index0) && 
		(index1Ptr->charIndex > index2Ptr->charIndex)) ||
	    ((index1Ptr != &index0) && 
		(index1Ptr->charIndex >= index2Ptr->charIndex))) {
		searchPtr->linesLeft = 0;
	}
    }
}

/*
 *----------------------------------------------------------------------







|














|

|







1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
	searchPtr->segPtr = NULL;
	searchPtr->nextPtr = seg0Ptr;	/* Will be returned by NextTag */
	index1Ptr = &index0;
    } else {
	searchPtr->curIndex = *index1Ptr;
	searchPtr->segPtr = NULL;
	searchPtr->nextPtr = TkTextIndexToSeg(index1Ptr, &offset);
	searchPtr->curIndex.byteIndex -= offset;
    }
    searchPtr->lastPtr = TkTextIndexToSeg(index2Ptr, (int *) NULL);
    searchPtr->tagPtr = tagPtr;
    searchPtr->linesLeft = TkBTreeLineIndex(index2Ptr->linePtr) + 1
	    - TkBTreeLineIndex(index1Ptr->linePtr);
    searchPtr->allTags = (tagPtr == NULL);
    if (searchPtr->linesLeft == 1) {
	/*
	 * Starting and stopping segments are in the same line; mark the
	 * search as over immediately if the second segment is before the
	 * first.  A search does not return a toggle at the very start of
	 * the range, unless the range is artificially moved up to index0.
	 */
	if (((index1Ptr == &index0) && 
		(index1Ptr->byteIndex > index2Ptr->byteIndex)) ||
	    ((index1Ptr != &index0) && 
		(index1Ptr->byteIndex >= index2Ptr->byteIndex))) {
		searchPtr->linesLeft = 0;
	}
    }
}

/*
 *----------------------------------------------------------------------
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
	searchPtr->curIndex = index0;
	index1Ptr = &index0;
    } else {
	TkTextIndexBackChars(index1Ptr, 1, &searchPtr->curIndex);
    }
    searchPtr->segPtr = NULL;
    searchPtr->nextPtr = TkTextIndexToSeg(&searchPtr->curIndex, &offset);
    searchPtr->curIndex.charIndex -= offset;

    /*
     * Adjust the end of the search so it does find toggles that are right
     * at the second index specified by the user.
     */

    if ((TkBTreeLineIndex(index2Ptr->linePtr) == 0) &&
	    (index2Ptr->charIndex == 0)) {
	backOne = *index2Ptr;
	searchPtr->lastPtr = NULL;	/* Signals special case for 1.0 */
    } else {
	TkTextIndexBackChars(index2Ptr, 1, &backOne);
	searchPtr->lastPtr = TkTextIndexToSeg(&backOne, (int *) NULL);
    }
    searchPtr->tagPtr = tagPtr;
    searchPtr->linesLeft = TkBTreeLineIndex(index1Ptr->linePtr) + 1
	    - TkBTreeLineIndex(backOne.linePtr);
    searchPtr->allTags = (tagPtr == NULL);
    if (searchPtr->linesLeft == 1) {
	/*
	 * Starting and stopping segments are in the same line; mark the
	 * search as over immediately if the second segment is after the
	 * first.
	 */

	if (index1Ptr->charIndex <= backOne.charIndex) {
	    searchPtr->linesLeft = 0;
	}
    }
}

/*
 *----------------------------------------------------------------------







|







|

















|







1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
	searchPtr->curIndex = index0;
	index1Ptr = &index0;
    } else {
	TkTextIndexBackChars(index1Ptr, 1, &searchPtr->curIndex);
    }
    searchPtr->segPtr = NULL;
    searchPtr->nextPtr = TkTextIndexToSeg(&searchPtr->curIndex, &offset);
    searchPtr->curIndex.byteIndex -= offset;

    /*
     * Adjust the end of the search so it does find toggles that are right
     * at the second index specified by the user.
     */

    if ((TkBTreeLineIndex(index2Ptr->linePtr) == 0) &&
	    (index2Ptr->byteIndex == 0)) {
	backOne = *index2Ptr;
	searchPtr->lastPtr = NULL;	/* Signals special case for 1.0 */
    } else {
	TkTextIndexBackChars(index2Ptr, 1, &backOne);
	searchPtr->lastPtr = TkTextIndexToSeg(&backOne, (int *) NULL);
    }
    searchPtr->tagPtr = tagPtr;
    searchPtr->linesLeft = TkBTreeLineIndex(index1Ptr->linePtr) + 1
	    - TkBTreeLineIndex(backOne.linePtr);
    searchPtr->allTags = (tagPtr == NULL);
    if (searchPtr->linesLeft == 1) {
	/*
	 * Starting and stopping segments are in the same line; mark the
	 * search as over immediately if the second segment is after the
	 * first.
	 */

	if (index1Ptr->byteIndex <= backOne.byteIndex) {
	    searchPtr->linesLeft = 0;
	}
    }
}

/*
 *----------------------------------------------------------------------
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
		    && (searchPtr->allTags
		    || (segPtr->body.toggle.tagPtr == searchPtr->tagPtr))) {
		searchPtr->segPtr = segPtr;
		searchPtr->nextPtr = segPtr->nextPtr;
		searchPtr->tagPtr = segPtr->body.toggle.tagPtr;
		return 1;
	    }
	    searchPtr->curIndex.charIndex += segPtr->size;
	}
    
	/*
	 * See if there are more lines associated with the current parent
	 * node.  If so, go back to the top of the loop to search the next
	 * one.
	 */

	nodePtr = searchPtr->curIndex.linePtr->parentPtr;
	searchPtr->curIndex.linePtr = searchPtr->curIndex.linePtr->nextPtr;
	searchPtr->linesLeft--;
	if (searchPtr->linesLeft <= 0) {
	    goto searchOver;
	}
	if (searchPtr->curIndex.linePtr != NULL) {
	    segPtr = searchPtr->curIndex.linePtr->segPtr;
	    searchPtr->curIndex.charIndex = 0;
	    continue;
	}
	if (nodePtr == searchPtr->tagPtr->tagRootPtr) {
	    goto searchOver;
	}
    
	/*







|
















|







1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
		    && (searchPtr->allTags
		    || (segPtr->body.toggle.tagPtr == searchPtr->tagPtr))) {
		searchPtr->segPtr = segPtr;
		searchPtr->nextPtr = segPtr->nextPtr;
		searchPtr->tagPtr = segPtr->body.toggle.tagPtr;
		return 1;
	    }
	    searchPtr->curIndex.byteIndex += segPtr->size;
	}
    
	/*
	 * See if there are more lines associated with the current parent
	 * node.  If so, go back to the top of the loop to search the next
	 * one.
	 */

	nodePtr = searchPtr->curIndex.linePtr->parentPtr;
	searchPtr->curIndex.linePtr = searchPtr->curIndex.linePtr->nextPtr;
	searchPtr->linesLeft--;
	if (searchPtr->linesLeft <= 0) {
	    goto searchOver;
	}
	if (searchPtr->curIndex.linePtr != NULL) {
	    segPtr = searchPtr->curIndex.linePtr->segPtr;
	    searchPtr->curIndex.byteIndex = 0;
	    continue;
	}
	if (nodePtr == searchPtr->tagPtr->tagRootPtr) {
	    goto searchOver;
	}
    
	/*
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
	/*
	 * Now we're down to a level-0 node that contains a line that contains
	 * a relevant tag transition.  Set up line information and go back to
	 * the beginning of the loop to search through lines.
	 */

	searchPtr->curIndex.linePtr = nodePtr->children.linePtr;
	searchPtr->curIndex.charIndex = 0;
	segPtr = searchPtr->curIndex.linePtr->segPtr;
	if (searchPtr->linesLeft <= 0) {
	    goto searchOver;
	}
	continue;
    }








|







1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
	/*
	 * Now we're down to a level-0 node that contains a line that contains
	 * a relevant tag transition.  Set up line information and go back to
	 * the beginning of the loop to search through lines.
	 */

	searchPtr->curIndex.linePtr = nodePtr->children.linePtr;
	searchPtr->curIndex.byteIndex = 0;
	segPtr = searchPtr->curIndex.linePtr->segPtr;
	if (searchPtr->linesLeft <= 0) {
	    goto searchOver;
	}
	continue;
    }

2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
					 * progress;  must have been set up by
					 * call to TkBTreeStartSearch. */
{
    register TkTextSegment *segPtr, *prevPtr;
    register TkTextLine *linePtr, *prevLinePtr;
    register Node *nodePtr, *node2Ptr, *prevNodePtr;
    register Summary *summaryPtr;
    int charIndex;
    int pastLast;			/* Saw last marker during scan */
    int linesSkipped;

    if (searchPtr->linesLeft <= 0) {
	goto searchOver;
    }

    /*
     * The outermost loop iterates over lines that may potentially contain
     * a relevant tag transition, starting from the current segment in
     * the current line.  "nextPtr" is maintained as the last segment in
     * a line that we can look at. 
     */

    while (1) {
	/*
	 * Check for the last toggle before the current segment on this line.
	 */
	charIndex = 0;
	if (searchPtr->lastPtr == NULL) {
	    /* 
	     * Search back to the very beginning, so pastLast is irrelevent.
	     */
	    pastLast = 1; 
	} else {
	    pastLast = 0;
	}
	for (prevPtr = NULL, segPtr = searchPtr->curIndex.linePtr->segPtr ;
		segPtr != NULL && segPtr != searchPtr->nextPtr;
		segPtr = segPtr->nextPtr) {
	    if (((segPtr->typePtr == &tkTextToggleOnType)
		    || (segPtr->typePtr == &tkTextToggleOffType))
		    && (searchPtr->allTags
		    || (segPtr->body.toggle.tagPtr == searchPtr->tagPtr))) {
		prevPtr = segPtr;
		searchPtr->curIndex.charIndex = charIndex;
	    }
	    if (segPtr == searchPtr->lastPtr) {
	        prevPtr = NULL;   /* Segments earlier than last don't count */
		pastLast = 1;
	    }
	    charIndex += segPtr->size;
	}
	if (prevPtr != NULL) {
	    if (searchPtr->linesLeft == 1 && !pastLast) {
		/*
		 * We found a segment that is before the stopping index.
		 * Note that it is OK if prevPtr == lastPtr.
		 */







|


















|
















|





|







2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
					 * progress;  must have been set up by
					 * call to TkBTreeStartSearch. */
{
    register TkTextSegment *segPtr, *prevPtr;
    register TkTextLine *linePtr, *prevLinePtr;
    register Node *nodePtr, *node2Ptr, *prevNodePtr;
    register Summary *summaryPtr;
    int byteIndex;
    int pastLast;			/* Saw last marker during scan */
    int linesSkipped;

    if (searchPtr->linesLeft <= 0) {
	goto searchOver;
    }

    /*
     * The outermost loop iterates over lines that may potentially contain
     * a relevant tag transition, starting from the current segment in
     * the current line.  "nextPtr" is maintained as the last segment in
     * a line that we can look at. 
     */

    while (1) {
	/*
	 * Check for the last toggle before the current segment on this line.
	 */
	byteIndex = 0;
	if (searchPtr->lastPtr == NULL) {
	    /* 
	     * Search back to the very beginning, so pastLast is irrelevent.
	     */
	    pastLast = 1; 
	} else {
	    pastLast = 0;
	}
	for (prevPtr = NULL, segPtr = searchPtr->curIndex.linePtr->segPtr ;
		segPtr != NULL && segPtr != searchPtr->nextPtr;
		segPtr = segPtr->nextPtr) {
	    if (((segPtr->typePtr == &tkTextToggleOnType)
		    || (segPtr->typePtr == &tkTextToggleOffType))
		    && (searchPtr->allTags
		    || (segPtr->body.toggle.tagPtr == searchPtr->tagPtr))) {
		prevPtr = segPtr;
		searchPtr->curIndex.byteIndex = byteIndex;
	    }
	    if (segPtr == searchPtr->lastPtr) {
	        prevPtr = NULL;   /* Segments earlier than last don't count */
		pastLast = 1;
	    }
	    byteIndex += segPtr->size;
	}
	if (prevPtr != NULL) {
	    if (searchPtr->linesLeft == 1 && !pastLast) {
		/*
		 * We found a segment that is before the stopping index.
		 * Note that it is OK if prevPtr == lastPtr.
		 */
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201

	for (prevLinePtr = NULL, linePtr = nodePtr->children.linePtr;
		linePtr != NULL ;
		prevLinePtr = linePtr, linePtr = linePtr->nextPtr) {
	    /* empty loop body */ ;
	}
	searchPtr->curIndex.linePtr = prevLinePtr;
	searchPtr->curIndex.charIndex = 0;
	if (searchPtr->linesLeft <= 0) {
	    goto searchOver;
	}
	continue;
    }

    searchOver:







|







2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201

	for (prevLinePtr = NULL, linePtr = nodePtr->children.linePtr;
		linePtr != NULL ;
		prevLinePtr = linePtr, linePtr = linePtr->nextPtr) {
	    /* empty loop body */ ;
	}
	searchPtr->curIndex.linePtr = prevLinePtr;
	searchPtr->curIndex.byteIndex = 0;
	if (searchPtr->linesLeft <= 0) {
	    goto searchOver;
	}
	continue;
    }

    searchOver:
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
     * Check for toggles for the tag in indexPtr's line but before
     * indexPtr.  If there is one, its type indicates whether or
     * not the character is tagged.
     */

    toggleSegPtr = NULL;
    for (index = 0, segPtr = indexPtr->linePtr->segPtr;
	    (index + segPtr->size) <= indexPtr->charIndex;
	    index += segPtr->size, segPtr = segPtr->nextPtr) {
	if (((segPtr->typePtr == &tkTextToggleOnType)
		|| (segPtr->typePtr == &tkTextToggleOffType))
		&& (segPtr->body.toggle.tagPtr == tagPtr)) {
	    toggleSegPtr = segPtr;
	}
    }







|







2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
     * Check for toggles for the tag in indexPtr's line but before
     * indexPtr.  If there is one, its type indicates whether or
     * not the character is tagged.
     */

    toggleSegPtr = NULL;
    for (index = 0, segPtr = indexPtr->linePtr->segPtr;
	    (index + segPtr->size) <= indexPtr->byteIndex;
	    index += segPtr->size, segPtr = segPtr->nextPtr) {
	if (((segPtr->typePtr == &tkTextToggleOnType)
		|| (segPtr->typePtr == &tkTextToggleOffType))
		&& (segPtr->body.toggle.tagPtr == tagPtr)) {
	    toggleSegPtr = segPtr;
	}
    }
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370

    /*
     * Record tag toggles within the line of indexPtr but preceding
     * indexPtr.
     */

    for (index = 0, segPtr = indexPtr->linePtr->segPtr;
	    (index + segPtr->size) <= indexPtr->charIndex;
	    index += segPtr->size, segPtr = segPtr->nextPtr) {
	if ((segPtr->typePtr == &tkTextToggleOnType)
		|| (segPtr->typePtr == &tkTextToggleOffType)) {
	    IncCount(segPtr->body.toggle.tagPtr, 1, &tagInfo);
	}
    }








|







2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370

    /*
     * Record tag toggles within the line of indexPtr but preceding
     * indexPtr.
     */

    for (index = 0, segPtr = indexPtr->linePtr->segPtr;
	    (index + segPtr->size) <= indexPtr->byteIndex;
	    index += segPtr->size, segPtr = segPtr->nextPtr) {
	if ((segPtr->typePtr == &tkTextToggleOnType)
		|| (segPtr->typePtr == &tkTextToggleOffType)) {
	    IncCount(segPtr->body.toggle.tagPtr, 1, &tagInfo);
	}
    }

3578
3579
3580
3581
3582
3583
3584



















3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
 *----------------------------------------------------------------------
 */

int
TkBTreeCharsInLine(linePtr)
    TkTextLine *linePtr;		/* Line whose characters should be
					 * counted. */



















{
    TkTextSegment *segPtr;
    int count;

    count = 0;
    for (segPtr = linePtr->segPtr; segPtr != NULL; segPtr = segPtr->nextPtr) {
	count += segPtr->size;
    }
    return count;
}







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










3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
 *----------------------------------------------------------------------
 */

int
TkBTreeCharsInLine(linePtr)
    TkTextLine *linePtr;		/* Line whose characters should be
					 * counted. */
{
    TkTextSegment *segPtr;
    int count;

    count = 0;
    for (segPtr = linePtr->segPtr; segPtr != NULL; segPtr = segPtr->nextPtr) {
	if (segPtr->typePtr == &tkTextCharType) {
	    count += Tcl_NumUtfChars(segPtr->body.chars, segPtr->size);
	} else {
	    count += segPtr->size;
	}
    }
    return count;
}

int
TkBTreeBytesInLine(linePtr)
    TkTextLine *linePtr;		/* Line whose characters should be
					 * counted. */
{
    TkTextSegment *segPtr;
    int count;

    count = 0;
    for (segPtr = linePtr->segPtr; segPtr != NULL; segPtr = segPtr->nextPtr) {
	count += segPtr->size;
    }
    return count;
}

Changes to generic/tkTextDisp.c.

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
/* 
 * tkTextDisp.c --
 *
 *	This module provides facilities to display text widgets.  It is
 *	the only place where information is kept about the screen layout
 *	of text widgets.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkTextDisp.c 1.124 97/07/11 18:01:03
 */

#include "tkPort.h"
#include "tkInt.h"
#include "tkText.h"





/*
 * The following structure describes how to display a range of characters.
 * The information is generated by scanning all of the tags associated
 * with the characters and combining that with default information for
 * the overall widget.  These structures form the hash keys for
 * dInfoPtr->styleTable.













|





>
>
>
>







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
/* 
 * tkTextDisp.c --
 *
 *	This module provides facilities to display text widgets.  It is
 *	the only place where information is kept about the screen layout
 *	of text widgets.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkTextDisp.c,v 1.1.4.5 1999/03/10 07:13:46 stanton Exp $
 */

#include "tkPort.h"
#include "tkInt.h"
#include "tkText.h"

#ifdef __WIN32__
#include "tkWinInt.h"
#endif

/*
 * The following structure describes how to display a range of characters.
 * The information is generated by scanning all of the tags associated
 * with the characters and combining that with default information for
 * the overall widget.  These structures form the hash keys for
 * dInfoPtr->styleTable.
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
    int spacing2;		/* Spacing between lines of dline. */
    int spacing3;		/* Spacing below last dline in text line. */
    TkTextTabArray *tabArrayPtr;/* Locations and types of tab stops (may
				 * be NULL). */
    int underline;		/* Non-zero means draw underline underneath
				 * text. */
    Tk_Uid wrapMode;		/* How to handle wrap-around for this tag.
				 * One of tkTextCharUid, tkTextNoneUid,
				 * or tkTextWordUid. */
} StyleValues;

/*
 * The following structure extends the StyleValues structure above with
 * graphics contexts used to actually draw the characters.  The entries
 * in dInfoPtr->styleTable point to structures of this type.
 */







|
<







56
57
58
59
60
61
62
63

64
65
66
67
68
69
70
    int spacing2;		/* Spacing between lines of dline. */
    int spacing3;		/* Spacing below last dline in text line. */
    TkTextTabArray *tabArrayPtr;/* Locations and types of tab stops (may
				 * be NULL). */
    int underline;		/* Non-zero means draw underline underneath
				 * text. */
    Tk_Uid wrapMode;		/* How to handle wrap-around for this tag.
				 * One of char, none, or text. */

} StyleValues;

/*
 * The following structure extends the StyleValues structure above with
 * graphics contexts used to actually draw the characters.  The entries
 * in dInfoPtr->styleTable point to structures of this type.
 */
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
 * The following structure describes one line of the display, which may
 * be either part or all of one line of the text.
 */

typedef struct DLine {
    TkTextIndex index;		/* Identifies first character in text
				 * that is displayed on this line. */
    int count;			/* Number of characters accounted for by this
				 * display line, including a trailing space
				 * or newline that isn't actually displayed. */
    int y;			/* Y-position at which line is supposed to
				 * be drawn (topmost pixel of rectangular
				 * area occupied by line). */
    int oldY;			/* Y-position at which line currently
				 * appears on display.  -1 means line isn't







|







97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
 * The following structure describes one line of the display, which may
 * be either part or all of one line of the text.
 */

typedef struct DLine {
    TkTextIndex index;		/* Identifies first character in text
				 * that is displayed on this line. */
    int byteCount;		/* Number of bytes accounted for by this
				 * display line, including a trailing space
				 * or newline that isn't actually displayed. */
    int y;			/* Y-position at which line is supposed to
				 * be drawn (topmost pixel of rectangular
				 * area occupied by line). */
    int oldY;			/* Y-position at which line currently
				 * appears on display.  -1 means line isn't
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
				 * figure out when to redraw part or all of
				 * the eof field. */

    /*
     * Information used for scrolling:
     */

    int newCharOffset;		/* Desired x scroll position, measured as the
				 * number of average-size characters off-screen
				 * to the left for a line with no left
				 * margin. */
    int curPixelOffset;		/* Actual x scroll position, measured as the
				 * number of pixels off-screen to the left. */
    int maxLength;		/* Length in pixels of longest line that's
				 * visible in window (length may exceed window







|







198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
				 * figure out when to redraw part or all of
				 * the eof field. */

    /*
     * Information used for scrolling:
     */

    int newByteOffset;		/* Desired x scroll position, measured as the
				 * number of average-size characters off-screen
				 * to the left for a line with no left
				 * margin. */
    int curPixelOffset;		/* Actual x scroll position, measured as the
				 * number of pixels off-screen to the left. */
    int maxLength;		/* Length in pixels of longest line that's
				 * visible in window (length may exceed window
218
219
220
221
222
223
224
225
226

227
228
229
230
231
232
233
				 * scrollbar;  used to eliminate unnecessary
				 * reports. */

    /*
     * The following information is used to implement scanning:
     */

    int scanMarkChar;		/* Character that was at the left edge of
				 * the window when the scan started. */

    int scanMarkX;		/* X-position of mouse at time scan started. */
    int scanTotalScroll;	/* Total scrolling (in screen lines) that has
				 * occurred since scanMarkY was set. */
    int scanMarkY;		/* Y-position of mouse at time scan started. */

    /*
     * Miscellaneous information:







|
|
>







221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
				 * scrollbar;  used to eliminate unnecessary
				 * reports. */

    /*
     * The following information is used to implement scanning:
     */

    int scanMarkIndex;		/* Byte index of character that was at the
				 * left edge of the window when the scan
				 * started. */
    int scanMarkX;		/* X-position of mouse at time scan started. */
    int scanTotalScroll;	/* Total scrolling (in screen lines) that has
				 * occurred since scanMarkY was set. */
    int scanMarkY;		/* Y-position of mouse at time scan started. */

    /*
     * Miscellaneous information:
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266

/*
 * In TkTextDispChunk structures for character segments, the clientData
 * field points to one of the following structures:
 */

typedef struct CharInfo {
    int numChars;		/* Number of characters to display. */
    char chars[4];		/* Characters to display.  Actual size
				 * will be numChars, not 4.  THIS MUST BE
				 * THE LAST FIELD IN THE STRUCTURE. */
} CharInfo;

/*
 * Flag values for TextDInfo structures:
 *
 * DINFO_OUT_OF_DATE:		Non-zero means that the DLine structures







|
|
|







254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270

/*
 * In TkTextDispChunk structures for character segments, the clientData
 * field points to one of the following structures:
 */

typedef struct CharInfo {
    int numBytes;		/* Number of bytes to display. */
    char chars[4];		/* UTF characters to display.  Actual size
				 * will be numBytes, not 4.  THIS MUST BE
				 * THE LAST FIELD IN THE STRUCTURE. */
} CharInfo;

/*
 * Flag values for TextDInfo structures:
 *
 * DINFO_OUT_OF_DATE:		Non-zero means that the DLine structures
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
static void		GetXView _ANSI_ARGS_((Tcl_Interp *interp,
			    TkText *textPtr, int report));
static void		GetYView _ANSI_ARGS_((Tcl_Interp *interp,
			    TkText *textPtr, int report));
static DLine *		LayoutDLine _ANSI_ARGS_((TkText *textPtr,
			    TkTextIndex *indexPtr));
static int		MeasureChars _ANSI_ARGS_((Tk_Font tkfont,
			    CONST char *source, int maxChars, int startX,
			    int maxX, int tabOrigin, int *nextXPtr));
static void		MeasureUp _ANSI_ARGS_((TkText *textPtr,
			    TkTextIndex *srcPtr, int distance,
			    TkTextIndex *dstPtr));
static int		NextTabStop _ANSI_ARGS_((Tk_Font tkfont, int x,
			    int tabOrigin));
static void		UpdateDisplayInfo _ANSI_ARGS_((TkText *textPtr));







|







331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
static void		GetXView _ANSI_ARGS_((Tcl_Interp *interp,
			    TkText *textPtr, int report));
static void		GetYView _ANSI_ARGS_((Tcl_Interp *interp,
			    TkText *textPtr, int report));
static DLine *		LayoutDLine _ANSI_ARGS_((TkText *textPtr,
			    TkTextIndex *indexPtr));
static int		MeasureChars _ANSI_ARGS_((Tk_Font tkfont,
			    CONST char *source, int maxBytes, int startX,
			    int maxX, int tabOrigin, int *nextXPtr));
static void		MeasureUp _ANSI_ARGS_((TkText *textPtr,
			    TkTextIndex *srcPtr, int distance,
			    TkTextIndex *dstPtr));
static int		NextTabStop _ANSI_ARGS_((Tk_Font tkfont, int x,
			    int tabOrigin));
static void		UpdateDisplayInfo _ANSI_ARGS_((TkText *textPtr));
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
    Tcl_InitHashTable(&dInfoPtr->styleTable, sizeof(StyleValues)/sizeof(int));
    dInfoPtr->dLinePtr = NULL;
    dInfoPtr->copyGC = None;
    gcValues.graphics_exposures = True;
    dInfoPtr->scrollGC = Tk_GetGC(textPtr->tkwin, GCGraphicsExposures,
	    &gcValues);
    dInfoPtr->topOfEof = 0;
    dInfoPtr->newCharOffset = 0;
    dInfoPtr->curPixelOffset = 0;
    dInfoPtr->maxLength = 0;
    dInfoPtr->xScrollFirst = -1;
    dInfoPtr->xScrollLast = -1;
    dInfoPtr->yScrollFirst = -1;
    dInfoPtr->yScrollLast = -1;
    dInfoPtr->scanMarkChar = 0;
    dInfoPtr->scanMarkX = 0;
    dInfoPtr->scanTotalScroll = 0;
    dInfoPtr->scanMarkY = 0;
    dInfoPtr->dLinesInvalidated = 0;
    dInfoPtr->flags = DINFO_OUT_OF_DATE;
    textPtr->dInfoPtr = dInfoPtr;
}







|






|







381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
    Tcl_InitHashTable(&dInfoPtr->styleTable, sizeof(StyleValues)/sizeof(int));
    dInfoPtr->dLinePtr = NULL;
    dInfoPtr->copyGC = None;
    gcValues.graphics_exposures = True;
    dInfoPtr->scrollGC = Tk_GetGC(textPtr->tkwin, GCGraphicsExposures,
	    &gcValues);
    dInfoPtr->topOfEof = 0;
    dInfoPtr->newByteOffset = 0;
    dInfoPtr->curPixelOffset = 0;
    dInfoPtr->maxLength = 0;
    dInfoPtr->xScrollFirst = -1;
    dInfoPtr->xScrollLast = -1;
    dInfoPtr->yScrollFirst = -1;
    dInfoPtr->yScrollLast = -1;
    dInfoPtr->scanMarkIndex = 0;
    dInfoPtr->scanMarkX = 0;
    dInfoPtr->scanTotalScroll = 0;
    dInfoPtr->scanMarkY = 0;
    dInfoPtr->dLinesInvalidated = 0;
    dInfoPtr->flags = DINFO_OUT_OF_DATE;
    textPtr->dInfoPtr = dInfoPtr;
}
735
736
737
738
739
740
741

742
743
744
745
746
747

748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764

765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
					 * for line. */
    TkTextDispChunk *chunkPtr;		/* Current chunk. */
    TkTextIndex curIndex;
    TkTextDispChunk *breakChunkPtr;	/* Chunk containing best word break
					 * point, if any. */
    TkTextIndex breakIndex;		/* Index of first character in
					 * breakChunkPtr. */

    int breakCharOffset;		/* Character within breakChunkPtr just
					 * to right of best break point. */
    int noCharsYet;			/* Non-zero means that no characters
					 * have been placed on the line yet. */
    int justify;			/* How to justify line: taken from
					 * style for first character in line. */

    int jIndent;			/* Additional indentation (beyond
					 * margins) due to justification. */
    int rMargin;			/* Right margin width for line. */
    Tk_Uid wrapMode;			/* Wrap mode to use for this line. */
    int x = 0, maxX = 0;		/* Initializations needed only to
					 * stop compiler warnings. */
    int wholeLine;			/* Non-zero means this display line
					 * runs to the end of the text line. */
    int tabIndex;			/* Index of the current tab stop. */
    int gotTab;				/* Non-zero means the current chunk
					 * contains a tab. */
    TkTextDispChunk *tabChunkPtr;	/* Pointer to the chunk containing
					 * the previous tab stop. */
    int maxChars;			/* Maximum number of characters to
					 * include in this chunk. */
    TkTextTabArray *tabArrayPtr;	/* Tab stops for line;  taken from
					 * style for first character on line. */

    int tabSize;			/* Number of pixels consumed by current
					 * tab stop. */
    TkTextDispChunk *lastCharChunkPtr;	/* Pointer to last chunk in display
					 * lines with numChars > 0.  Used to
					 * drop 0-sized chunks from the end
					 * of the line. */
    int offset, ascent, descent, code;
    StyleValues *sValuePtr;

    /*
     * Create and initialize a new DLine structure.
     */

    dlPtr = (DLine *) ckalloc(sizeof(DLine));
    dlPtr->index = *indexPtr;
    dlPtr->count = 0;
    dlPtr->y = 0;
    dlPtr->oldY = -1;
    dlPtr->height = 0;
    dlPtr->baseline = 0;
    dlPtr->chunkPtr = NULL;
    dlPtr->nextPtr = NULL;
    dlPtr->flags = NEW_LAYOUT;

    /*
     * Each iteration of the loop below creates one TkTextDispChunk for
     * the new display line.  The line will always have at least one
     * chunk (for the newline character at the end, if there's nothing
     * else available).
     */

    curIndex = *indexPtr;
    lastChunkPtr = NULL;
    chunkPtr = NULL;
    noCharsYet = 1;
    breakChunkPtr = NULL;
    breakCharOffset = 0;
    justify = TK_JUSTIFY_LEFT;
    tabIndex = -1;
    tabChunkPtr = NULL;
    tabArrayPtr = NULL;
    rMargin = 0;
    wrapMode = tkTextCharUid;
    tabSize = 0;
    lastCharChunkPtr = NULL;

    /*
     * Find the first segment to consider for the line.  Can't call
     * TkTextIndexToSeg for this because it won't return a segment
     * with zero size (such as the insertion cursor's mark).
     */

    for (offset = curIndex.charIndex, segPtr = curIndex.linePtr->segPtr;
	    (offset > 0) && (offset >= segPtr->size);
	    offset -= segPtr->size, segPtr = segPtr->nextPtr) {
	/* Empty loop body. */
    }

    while (segPtr != NULL) {
	if (segPtr->typePtr->layoutProc == NULL) {
	    segPtr = segPtr->nextPtr;
	    offset = 0;
	    continue;
	}
	if (chunkPtr == NULL) {
	    chunkPtr = (TkTextDispChunk *) ckalloc(sizeof(TkTextDispChunk));
	    chunkPtr->nextPtr = NULL;
	}
	chunkPtr->stylePtr = GetStyle(textPtr, &curIndex);

	/*
	 * Save style information such as justification and indentation,
	 * up until the first character is encountered, then retain that
	 * information for the rest of the line.
	 */

	if (noCharsYet) {
	    tabArrayPtr = chunkPtr->stylePtr->sValuePtr->tabArrayPtr;
	    justify = chunkPtr->stylePtr->sValuePtr->justify;
	    rMargin = chunkPtr->stylePtr->sValuePtr->rMargin;
	    wrapMode = chunkPtr->stylePtr->sValuePtr->wrapMode;
	    x = ((curIndex.charIndex == 0)
		    ? chunkPtr->stylePtr->sValuePtr->lMargin1
		    : chunkPtr->stylePtr->sValuePtr->lMargin2);
	    if (wrapMode == tkTextNoneUid) {
		maxX = INT_MAX;
	    } else {
		maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x
			- rMargin;
		if (maxX < x) {
		    maxX = x;
		}
	    }
	}

	/*
	 * See if there is a tab in the current chunk; if so, only
	 * layout characters up to (and including) the tab.
	 */

	gotTab = 0;
	maxChars = segPtr->size - offset;
	if (justify == TK_JUSTIFY_LEFT) {
	    if (segPtr->typePtr == &tkTextCharType) {
		char *p;

		for (p = segPtr->body.chars  + offset; *p != 0; p++) {
		    if (*p == '\t') {
			maxChars = (p + 1 - segPtr->body.chars) - offset;
			gotTab = 1;
			break;
		    }
		}
	    }
	}

	chunkPtr->x = x;
	code = (*segPtr->typePtr->layoutProc)(textPtr, &curIndex, segPtr,
		offset, maxX-tabSize, maxChars, noCharsYet, wrapMode,
		chunkPtr);
	if (code <= 0) {
	    FreeStyle(textPtr, chunkPtr->stylePtr);
	    if (code < 0) {
		/*
		 * This segment doesn't wish to display itself (e.g. most
		 * marks).
		 */

		segPtr = segPtr->nextPtr;
		offset = 0;
		continue;
	    }

	    /*
	     * No characters from this segment fit in the window: this
	     * means we're at the end of the display line.
	     */

	    if (chunkPtr != NULL) {
		ckfree((char *) chunkPtr);
	    }
	    break;
	}
	if (chunkPtr->numChars > 0) {
	    noCharsYet = 0;
	    lastCharChunkPtr = chunkPtr;
	}
	if (lastChunkPtr == NULL) {
	    dlPtr->chunkPtr = chunkPtr;
	} else {
	    lastChunkPtr->nextPtr = chunkPtr;
	}
	lastChunkPtr = chunkPtr;
	x += chunkPtr->width;
	if (chunkPtr->breakIndex > 0) {
	    breakCharOffset = chunkPtr->breakIndex;
	    breakIndex = curIndex;
	    breakChunkPtr = chunkPtr;
	}
	if (chunkPtr->numChars != maxChars) {
	    break;
	}

	/*
	 * If we're at a new tab, adjust the layout for all the chunks
	 * pertaining to the previous tab.  Also adjust the amount of
	 * space left in the line to account for space that will be eaten
	 * up by the tab.
	 */

	if (gotTab) {
	    if (tabIndex >= 0) {
		AdjustForTab(textPtr, tabArrayPtr, tabIndex, tabChunkPtr);
		x = chunkPtr->x + chunkPtr->width;
	    }
	    tabIndex++;
	    tabChunkPtr = chunkPtr;
	    tabSize = SizeOfTab(textPtr, tabArrayPtr, tabIndex, x, maxX);
	    if (tabSize >= (maxX - x)) {
		break;
	    }
	}
	curIndex.charIndex += chunkPtr->numChars;
	offset += chunkPtr->numChars;
	if (offset >= segPtr->size) {
	    offset = 0;
	    segPtr = segPtr->nextPtr;
	}
	chunkPtr = NULL;
    }
    if (noCharsYet) {
	panic("LayoutDLine couldn't place any characters on a line");
    }







>
|
|



|
>













|

|
|
>



|


|








|




















|





|









|
|
|






|



















|


|
|















|




|

|









|










|













|











|



|


















|



|
|
|
|







739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
					 * for line. */
    TkTextDispChunk *chunkPtr;		/* Current chunk. */
    TkTextIndex curIndex;
    TkTextDispChunk *breakChunkPtr;	/* Chunk containing best word break
					 * point, if any. */
    TkTextIndex breakIndex;		/* Index of first character in
					 * breakChunkPtr. */
    int breakByteOffset;		/* Byte offset of character within
					 * breakChunkPtr just to right of best
					 * break point. */
    int noCharsYet;			/* Non-zero means that no characters
					 * have been placed on the line yet. */
    int justify;			/* How to justify line: taken from
					 * style for the first character in
					 * line. */
    int jIndent;			/* Additional indentation (beyond
					 * margins) due to justification. */
    int rMargin;			/* Right margin width for line. */
    Tk_Uid wrapMode;			/* Wrap mode to use for this line. */
    int x = 0, maxX = 0;		/* Initializations needed only to
					 * stop compiler warnings. */
    int wholeLine;			/* Non-zero means this display line
					 * runs to the end of the text line. */
    int tabIndex;			/* Index of the current tab stop. */
    int gotTab;				/* Non-zero means the current chunk
					 * contains a tab. */
    TkTextDispChunk *tabChunkPtr;	/* Pointer to the chunk containing
					 * the previous tab stop. */
    int maxBytes;			/* Maximum number of bytes to
					 * include in this chunk. */
    TkTextTabArray *tabArrayPtr;	/* Tab stops for line; taken from
					 * style for the first character on
					 * line. */
    int tabSize;			/* Number of pixels consumed by current
					 * tab stop. */
    TkTextDispChunk *lastCharChunkPtr;	/* Pointer to last chunk in display
					 * lines with numBytes > 0.  Used to
					 * drop 0-sized chunks from the end
					 * of the line. */
    int byteOffset, ascent, descent, code;
    StyleValues *sValuePtr;

    /*
     * Create and initialize a new DLine structure.
     */

    dlPtr = (DLine *) ckalloc(sizeof(DLine));
    dlPtr->index = *indexPtr;
    dlPtr->byteCount = 0;
    dlPtr->y = 0;
    dlPtr->oldY = -1;
    dlPtr->height = 0;
    dlPtr->baseline = 0;
    dlPtr->chunkPtr = NULL;
    dlPtr->nextPtr = NULL;
    dlPtr->flags = NEW_LAYOUT;

    /*
     * Each iteration of the loop below creates one TkTextDispChunk for
     * the new display line.  The line will always have at least one
     * chunk (for the newline character at the end, if there's nothing
     * else available).
     */

    curIndex = *indexPtr;
    lastChunkPtr = NULL;
    chunkPtr = NULL;
    noCharsYet = 1;
    breakChunkPtr = NULL;
    breakByteOffset = 0;
    justify = TK_JUSTIFY_LEFT;
    tabIndex = -1;
    tabChunkPtr = NULL;
    tabArrayPtr = NULL;
    rMargin = 0;
    wrapMode = Tk_GetUid("char");
    tabSize = 0;
    lastCharChunkPtr = NULL;

    /*
     * Find the first segment to consider for the line.  Can't call
     * TkTextIndexToSeg for this because it won't return a segment
     * with zero size (such as the insertion cursor's mark).
     */

    for (byteOffset = curIndex.byteIndex, segPtr = curIndex.linePtr->segPtr;
	    (byteOffset > 0) && (byteOffset >= segPtr->size);
	    byteOffset -= segPtr->size, segPtr = segPtr->nextPtr) {
	/* Empty loop body. */
    }

    while (segPtr != NULL) {
	if (segPtr->typePtr->layoutProc == NULL) {
	    segPtr = segPtr->nextPtr;
	    byteOffset = 0;
	    continue;
	}
	if (chunkPtr == NULL) {
	    chunkPtr = (TkTextDispChunk *) ckalloc(sizeof(TkTextDispChunk));
	    chunkPtr->nextPtr = NULL;
	}
	chunkPtr->stylePtr = GetStyle(textPtr, &curIndex);

	/*
	 * Save style information such as justification and indentation,
	 * up until the first character is encountered, then retain that
	 * information for the rest of the line.
	 */

	if (noCharsYet) {
	    tabArrayPtr = chunkPtr->stylePtr->sValuePtr->tabArrayPtr;
	    justify = chunkPtr->stylePtr->sValuePtr->justify;
	    rMargin = chunkPtr->stylePtr->sValuePtr->rMargin;
	    wrapMode = chunkPtr->stylePtr->sValuePtr->wrapMode;
	    x = ((curIndex.byteIndex == 0)
		    ? chunkPtr->stylePtr->sValuePtr->lMargin1
		    : chunkPtr->stylePtr->sValuePtr->lMargin2);
	    if (wrapMode == Tk_GetUid("none")) {
		maxX = -1;
	    } else {
		maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x
			- rMargin;
		if (maxX < x) {
		    maxX = x;
		}
	    }
	}

	/*
	 * See if there is a tab in the current chunk; if so, only
	 * layout characters up to (and including) the tab.
	 */

	gotTab = 0;
	maxBytes = segPtr->size - byteOffset;
	if (justify == TK_JUSTIFY_LEFT) {
	    if (segPtr->typePtr == &tkTextCharType) {
		char *p;

		for (p = segPtr->body.chars  + byteOffset; *p != 0; p++) {
		    if (*p == '\t') {
			maxBytes = (p + 1 - segPtr->body.chars) - byteOffset;
			gotTab = 1;
			break;
		    }
		}
	    }
	}

	chunkPtr->x = x;
	code = (*segPtr->typePtr->layoutProc)(textPtr, &curIndex, segPtr,
		byteOffset, maxX-tabSize, maxBytes, noCharsYet, wrapMode,
		chunkPtr);
	if (code <= 0) {
	    FreeStyle(textPtr, chunkPtr->stylePtr);
	    if (code < 0) {
		/*
		 * This segment doesn't wish to display itself (e.g. most
		 * marks).
		 */

		segPtr = segPtr->nextPtr;
		byteOffset = 0;
		continue;
	    }

	    /*
	     * No characters from this segment fit in the window: this
	     * means we're at the end of the display line.
	     */

	    if (chunkPtr != NULL) {
		ckfree((char *) chunkPtr);
	    }
	    break;
	}
	if (chunkPtr->numBytes > 0) {
	    noCharsYet = 0;
	    lastCharChunkPtr = chunkPtr;
	}
	if (lastChunkPtr == NULL) {
	    dlPtr->chunkPtr = chunkPtr;
	} else {
	    lastChunkPtr->nextPtr = chunkPtr;
	}
	lastChunkPtr = chunkPtr;
	x += chunkPtr->width;
	if (chunkPtr->breakIndex > 0) {
	    breakByteOffset = chunkPtr->breakIndex;
	    breakIndex = curIndex;
	    breakChunkPtr = chunkPtr;
	}
	if (chunkPtr->numBytes != maxBytes) {
	    break;
	}

	/*
	 * If we're at a new tab, adjust the layout for all the chunks
	 * pertaining to the previous tab.  Also adjust the amount of
	 * space left in the line to account for space that will be eaten
	 * up by the tab.
	 */

	if (gotTab) {
	    if (tabIndex >= 0) {
		AdjustForTab(textPtr, tabArrayPtr, tabIndex, tabChunkPtr);
		x = chunkPtr->x + chunkPtr->width;
	    }
	    tabIndex++;
	    tabChunkPtr = chunkPtr;
	    tabSize = SizeOfTab(textPtr, tabArrayPtr, tabIndex, x, maxX);
	    if ((maxX >= 0) && (tabSize >= maxX - x)) {
		break;
	    }
	}
	curIndex.byteIndex += chunkPtr->numBytes;
	byteOffset += chunkPtr->numBytes;
	if (byteOffset >= segPtr->size) {
	    byteOffset = 0;
	    segPtr = segPtr->nextPtr;
	}
	chunkPtr = NULL;
    }
    if (noCharsYet) {
	panic("LayoutDLine couldn't place any characters on a line");
    }
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
	 * chunks with no characters at the end of the line (such as
	 * the insertion cursor).  These chunks belong on the next
	 * line.  So, throw away everything after the last chunk that
	 * has characters in it.
	 */

	breakChunkPtr = lastCharChunkPtr;
	breakCharOffset = breakChunkPtr->numChars;
    }
    if ((breakChunkPtr != NULL) && ((lastChunkPtr != breakChunkPtr)
	    || (breakCharOffset != lastChunkPtr->numChars))) {
	while (1) {
	    chunkPtr = breakChunkPtr->nextPtr;
	    if (chunkPtr == NULL) {
		break;
	    }
	    FreeStyle(textPtr, chunkPtr->stylePtr);
	    breakChunkPtr->nextPtr = chunkPtr->nextPtr;
	    (*chunkPtr->undisplayProc)(textPtr, chunkPtr);
	    ckfree((char *) chunkPtr);
	}
	if (breakCharOffset != breakChunkPtr->numChars) {
	    (*breakChunkPtr->undisplayProc)(textPtr, breakChunkPtr);
	    segPtr = TkTextIndexToSeg(&breakIndex, &offset);
	    (*segPtr->typePtr->layoutProc)(textPtr, &breakIndex,
		    segPtr, offset, maxX, breakCharOffset, 0, 
		    wrapMode, breakChunkPtr);
	}
	lastChunkPtr = breakChunkPtr;
	wholeLine = 0;
    }

    /*
     * Make tab adjustments for the last tab stop, if there is one.
     */

    if ((tabIndex >= 0) && (tabChunkPtr != NULL)) {
	AdjustForTab(textPtr, tabArrayPtr, tabIndex, tabChunkPtr);
    }

    /*
     * Make one more pass over the line to recompute various things
     * like its height, length, and total number of characters.  Also
     * modify the x-locations of chunks to reflect justification.
     * If we're not wrapping, I'm not sure what is the best way to
     * handle left and center justification:  should the total length,
     * for purposes of justification, be (a) the window width, (b)
     * the length of the longest line in the window, or (c) the length
     * of the longest line in the text?  (c) isn't available, (b) seems
     * weird, since it can change with vertical scrolling, so (a) is
     * what is implemented below.
     */

    if (wrapMode == tkTextNoneUid) {
	maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x - rMargin;
    }
    dlPtr->length = lastChunkPtr->x + lastChunkPtr->width;
    if (justify == TK_JUSTIFY_LEFT) {
	jIndent = 0;
    } else if (justify == TK_JUSTIFY_RIGHT) {
	jIndent = maxX - dlPtr->length;
    } else {
	jIndent = (maxX - dlPtr->length)/2;
    }
    ascent = descent = 0;
    for (chunkPtr = dlPtr->chunkPtr; chunkPtr != NULL;
	    chunkPtr = chunkPtr->nextPtr) {
	chunkPtr->x += jIndent;
	dlPtr->count += chunkPtr->numChars;
	if (chunkPtr->minAscent > ascent) {
	    ascent = chunkPtr->minAscent;
	}
	if (chunkPtr->minDescent > descent) {
	    descent = chunkPtr->minDescent;
	}
	if (chunkPtr->minHeight > dlPtr->height) {







|


|










|

|

|
















|










|














|







976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
	 * chunks with no characters at the end of the line (such as
	 * the insertion cursor).  These chunks belong on the next
	 * line.  So, throw away everything after the last chunk that
	 * has characters in it.
	 */

	breakChunkPtr = lastCharChunkPtr;
	breakByteOffset = breakChunkPtr->numBytes;
    }
    if ((breakChunkPtr != NULL) && ((lastChunkPtr != breakChunkPtr)
	    || (breakByteOffset != lastChunkPtr->numBytes))) {
	while (1) {
	    chunkPtr = breakChunkPtr->nextPtr;
	    if (chunkPtr == NULL) {
		break;
	    }
	    FreeStyle(textPtr, chunkPtr->stylePtr);
	    breakChunkPtr->nextPtr = chunkPtr->nextPtr;
	    (*chunkPtr->undisplayProc)(textPtr, chunkPtr);
	    ckfree((char *) chunkPtr);
	}
	if (breakByteOffset != breakChunkPtr->numBytes) {
	    (*breakChunkPtr->undisplayProc)(textPtr, breakChunkPtr);
	    segPtr = TkTextIndexToSeg(&breakIndex, &byteOffset);
	    (*segPtr->typePtr->layoutProc)(textPtr, &breakIndex,
		    segPtr, byteOffset, maxX, breakByteOffset, 0, 
		    wrapMode, breakChunkPtr);
	}
	lastChunkPtr = breakChunkPtr;
	wholeLine = 0;
    }

    /*
     * Make tab adjustments for the last tab stop, if there is one.
     */

    if ((tabIndex >= 0) && (tabChunkPtr != NULL)) {
	AdjustForTab(textPtr, tabArrayPtr, tabIndex, tabChunkPtr);
    }

    /*
     * Make one more pass over the line to recompute various things
     * like its height, length, and total number of bytes.  Also
     * modify the x-locations of chunks to reflect justification.
     * If we're not wrapping, I'm not sure what is the best way to
     * handle left and center justification:  should the total length,
     * for purposes of justification, be (a) the window width, (b)
     * the length of the longest line in the window, or (c) the length
     * of the longest line in the text?  (c) isn't available, (b) seems
     * weird, since it can change with vertical scrolling, so (a) is
     * what is implemented below.
     */

    if (wrapMode == Tk_GetUid("none")) {
	maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x - rMargin;
    }
    dlPtr->length = lastChunkPtr->x + lastChunkPtr->width;
    if (justify == TK_JUSTIFY_LEFT) {
	jIndent = 0;
    } else if (justify == TK_JUSTIFY_RIGHT) {
	jIndent = maxX - dlPtr->length;
    } else {
	jIndent = (maxX - dlPtr->length)/2;
    }
    ascent = descent = 0;
    for (chunkPtr = dlPtr->chunkPtr; chunkPtr != NULL;
	    chunkPtr = chunkPtr->nextPtr) {
	chunkPtr->x += jIndent;
	dlPtr->byteCount += chunkPtr->numBytes;
	if (chunkPtr->minAscent > ascent) {
	    ascent = chunkPtr->minAscent;
	}
	if (chunkPtr->minDescent > descent) {
	    descent = chunkPtr->minDescent;
	}
	if (chunkPtr->minHeight > dlPtr->height) {
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
    if (dlPtr->height < (ascent + descent)) {
	dlPtr->height = ascent + descent;
	dlPtr->baseline = ascent;
    } else {
	dlPtr->baseline = ascent + (dlPtr->height - ascent - descent)/2;
    }
    sValuePtr = dlPtr->chunkPtr->stylePtr->sValuePtr;
    if (dlPtr->index.charIndex == 0) {
	dlPtr->spaceAbove = sValuePtr->spacing1;
    } else {
	dlPtr->spaceAbove = sValuePtr->spacing2 - sValuePtr->spacing2/2;
    }
    if (wholeLine) {
	dlPtr->spaceBelow = sValuePtr->spacing3;
    } else {







|







1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
    if (dlPtr->height < (ascent + descent)) {
	dlPtr->height = ascent + descent;
	dlPtr->baseline = ascent;
    } else {
	dlPtr->baseline = ascent + (dlPtr->height - ascent - descent)/2;
    }
    sValuePtr = dlPtr->chunkPtr->stylePtr->sValuePtr;
    if (dlPtr->index.byteIndex == 0) {
	dlPtr->spaceAbove = sValuePtr->spacing1;
    } else {
	dlPtr->spaceAbove = sValuePtr->spacing2 - sValuePtr->spacing2/2;
    }
    if (wholeLine) {
	dlPtr->spaceBelow = sValuePtr->spacing3;
    } else {
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
	    dlPtr = newPtr;
	} else {
	    /*
	     * DlPtr refers to the line we want.  Next check the
	     * index within the line.
	     */

	    if (index.charIndex == dlPtr->index.charIndex) {
		/*
		 * Case (a) -- can use existing display line as-is.
		 */

		if ((dlPtr->flags & HAS_3D_BORDER) && (prevPtr != NULL)
			&& (prevPtr->flags & (NEW_LAYOUT))) {
		    dlPtr->oldY = -1;
		}
		goto lineOK;
	    }
	    if (index.charIndex < dlPtr->index.charIndex) {
		goto makeNewDLine;
	    }

	    /*
	     * Case (c) -- dlPtr is useless.  Discard it and start
	     * again with the next display line.
	     */







|










|







1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
	    dlPtr = newPtr;
	} else {
	    /*
	     * DlPtr refers to the line we want.  Next check the
	     * index within the line.
	     */

	    if (index.byteIndex == dlPtr->index.byteIndex) {
		/*
		 * Case (a) -- can use existing display line as-is.
		 */

		if ((dlPtr->flags & HAS_3D_BORDER) && (prevPtr != NULL)
			&& (prevPtr->flags & (NEW_LAYOUT))) {
		    dlPtr->oldY = -1;
		}
		goto lineOK;
	    }
	    if (index.byteIndex < dlPtr->index.byteIndex) {
		goto makeNewDLine;
	    }

	    /*
	     * Case (c) -- dlPtr is useless.  Discard it and start
	     * again with the next display line.
	     */
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
	/*
	 * Advance to the start of the next line.
	 */

	lineOK:
	dlPtr->y = y;
	y += dlPtr->height;
	TkTextIndexForwChars(&index, dlPtr->count, &index);
	prevPtr = dlPtr;
	dlPtr = dlPtr->nextPtr;

	/*
	 * If we switched text lines, delete any DLines left for the
	 * old text line.
	 */







|







1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
	/*
	 * Advance to the start of the next line.
	 */

	lineOK:
	dlPtr->y = y;
	y += dlPtr->height;
	TkTextIndexForwBytes(&index, dlPtr->byteCount, &index);
	prevPtr = dlPtr;
	dlPtr = dlPtr->nextPtr;

	/*
	 * If we switched text lines, delete any DLines left for the
	 * old text line.
	 */
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
     * If there is extra space at the bottom of the window (because
     * we've hit the end of the text), then bring in more lines at
     * the top of the window, if there are any, to fill in the view.
     *--------------------------------------------------------------
     */

    if (y < maxY) {
	int lineNum, spaceLeft, charsToCount;
	DLine *lowestPtr;

	/*
	 * Layout an entire text line (potentially > 1 display line),
	 * then link in as many display lines as fit without moving
	 * the bottom line out of the window.  Repeat this until
	 * all the extra space has been used up or we've reached the
	 * beginning of the text.
	 */

	spaceLeft = maxY - y;
	lineNum = TkBTreeLineIndex(dInfoPtr->dLinePtr->index.linePtr);
	charsToCount = dInfoPtr->dLinePtr->index.charIndex;
	if (charsToCount == 0) {
	    charsToCount = INT_MAX;
	    lineNum--;
	}
	for ( ; (lineNum >= 0) && (spaceLeft > 0); lineNum--) {
	    index.linePtr = TkBTreeFindLine(textPtr->tree, lineNum);
	    index.charIndex = 0;
	    lowestPtr = NULL;
	    do {
		dlPtr = LayoutDLine(textPtr, &index);
		dlPtr->nextPtr = lowestPtr;
		lowestPtr = dlPtr;
		TkTextIndexForwChars(&index, dlPtr->count, &index);
		charsToCount -= dlPtr->count;
	    } while ((charsToCount > 0)
		    && (index.linePtr == lowestPtr->index.linePtr));

	    /*
	     * Scan through the display lines from the bottom one up to
	     * the top one.
	     */








|












|
|
|




|





|
|
|







1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
     * If there is extra space at the bottom of the window (because
     * we've hit the end of the text), then bring in more lines at
     * the top of the window, if there are any, to fill in the view.
     *--------------------------------------------------------------
     */

    if (y < maxY) {
	int lineNum, spaceLeft, bytesToCount;
	DLine *lowestPtr;

	/*
	 * Layout an entire text line (potentially > 1 display line),
	 * then link in as many display lines as fit without moving
	 * the bottom line out of the window.  Repeat this until
	 * all the extra space has been used up or we've reached the
	 * beginning of the text.
	 */

	spaceLeft = maxY - y;
	lineNum = TkBTreeLineIndex(dInfoPtr->dLinePtr->index.linePtr);
	bytesToCount = dInfoPtr->dLinePtr->index.byteIndex;
	if (bytesToCount == 0) {
	    bytesToCount = INT_MAX;
	    lineNum--;
	}
	for ( ; (lineNum >= 0) && (spaceLeft > 0); lineNum--) {
	    index.linePtr = TkBTreeFindLine(textPtr->tree, lineNum);
	    index.byteIndex = 0;
	    lowestPtr = NULL;
	    do {
		dlPtr = LayoutDLine(textPtr, &index);
		dlPtr->nextPtr = lowestPtr;
		lowestPtr = dlPtr;
		TkTextIndexForwBytes(&index, dlPtr->byteCount, &index);
		bytesToCount -= dlPtr->byteCount;
	    } while ((bytesToCount > 0)
		    && (index.linePtr == lowestPtr->index.linePtr));

	    /*
	     * Scan through the display lines from the bottom one up to
	     * the top one.
	     */

1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
		    TkTextPrintIndex(&dlPtr->index, string);
		    Tcl_SetVar2(textPtr->interp, "tk_textRelayout",
			    (char *) NULL, string,
			    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
		}
	    }
	    FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0);
	    charsToCount = INT_MAX;
	}

	/*
	 * Now we're all done except that the y-coordinates in all the
	 * DLines are wrong and the top index for the text is wrong.
	 * Update them.
	 */







|







1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
		    TkTextPrintIndex(&dlPtr->index, string);
		    Tcl_SetVar2(textPtr->interp, "tk_textRelayout",
			    (char *) NULL, string,
			    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
		}
	    }
	    FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0);
	    bytesToCount = INT_MAX;
	}

	/*
	 * Now we're all done except that the y-coordinates in all the
	 * DLines are wrong and the top index for the text is wrong.
	 * Update them.
	 */
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
	    dlPtr = dlPtr->nextPtr) {
	if (dlPtr->length > dInfoPtr->maxLength) {
	    dInfoPtr->maxLength = dlPtr->length;
	}
    }
    maxOffset = (dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x)
	    + textPtr->charWidth - 1)/textPtr->charWidth;
    if (dInfoPtr->newCharOffset > maxOffset) {
	dInfoPtr->newCharOffset = maxOffset;
    }
    if (dInfoPtr->newCharOffset < 0) {
	dInfoPtr->newCharOffset = 0;
    }
    pixelOffset = dInfoPtr->newCharOffset * textPtr->charWidth;
    if (pixelOffset != dInfoPtr->curPixelOffset) {
	dInfoPtr->curPixelOffset = pixelOffset;
	for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
		dlPtr = dlPtr->nextPtr) {
	    dlPtr->oldY = -1;
	}
    }







|
|

|
|

|







1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
	    dlPtr = dlPtr->nextPtr) {
	if (dlPtr->length > dInfoPtr->maxLength) {
	    dInfoPtr->maxLength = dlPtr->length;
	}
    }
    maxOffset = (dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x)
	    + textPtr->charWidth - 1)/textPtr->charWidth;
    if (dInfoPtr->newByteOffset > maxOffset) {
	dInfoPtr->newByteOffset = maxOffset;
    }
    if (dInfoPtr->newByteOffset < 0) {
	dInfoPtr->newByteOffset = 0;
    }
    pixelOffset = dInfoPtr->newByteOffset * textPtr->charWidth;
    if (pixelOffset != dInfoPtr->curPixelOffset) {
	dInfoPtr->curPixelOffset = pixelOffset;
	for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
		dlPtr = dlPtr->nextPtr) {
	    dlPtr->oldY = -1;
	}
    }
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
     * Make another pass through all of the chunks to redraw the
     * insertion cursor, if it is visible on this line.  Must do
     * it here rather than in the foreground pass below because
     * otherwise a wide insertion cursor will obscure the character
     * to its left.
     */

    if (textPtr->state == tkNormalUid) {
	for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL);
		chunkPtr = chunkPtr->nextPtr) {
	    x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curPixelOffset;
	    if (chunkPtr->displayProc == TkTextInsertDisplayProc) {
		(*chunkPtr->displayProc)(chunkPtr, x, dlPtr->spaceAbove,
			dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
			dlPtr->baseline - dlPtr->spaceAbove, display, pixmap,







|







1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
     * Make another pass through all of the chunks to redraw the
     * insertion cursor, if it is visible on this line.  Must do
     * it here rather than in the foreground pass below because
     * otherwise a wide insertion cursor will obscure the character
     * to its left.
     */

    if (textPtr->state == Tk_GetUid("normal")) {
	for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL);
		chunkPtr = chunkPtr->nextPtr) {
	    x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curPixelOffset;
	    if (chunkPtr->displayProc == TkTextInsertDisplayProc) {
		(*chunkPtr->displayProc)(chunkPtr, x, dlPtr->spaceAbove,
			dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
			dlPtr->baseline - dlPtr->spaceAbove, display, pixmap,
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
     * of its text line, and include all the display lines after index2,
     * up to the end of its text line.  This is necessary because the
     * indices stored in the display lines will no longer be valid.  It's
     * also needed because any edit could change the way lines wrap.
     */

    rounded = *index1Ptr;
    rounded.charIndex = 0;
    firstPtr = FindDLine(dInfoPtr->dLinePtr, &rounded);
    if (firstPtr == NULL) {
	return;
    }
    lastPtr = FindDLine(dInfoPtr->dLinePtr, index2Ptr);
    while ((lastPtr != NULL)
	    && (lastPtr->index.linePtr == index2Ptr->linePtr)) {







|







2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
     * of its text line, and include all the display lines after index2,
     * up to the end of its text line.  This is necessary because the
     * indices stored in the display lines will no longer be valid.  It's
     * also needed because any edit could change the way lines wrap.
     */

    rounded = *index1Ptr;
    rounded.byteIndex = 0;
    firstPtr = FindDLine(dInfoPtr->dLinePtr, &rounded);
    if (firstPtr == NULL) {
	return;
    }
    lastPtr = FindDLine(dInfoPtr->dLinePtr, index2Ptr);
    while ((lastPtr != NULL)
	    && (lastPtr->index.linePtr == index2Ptr->linePtr)) {
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
    }

    /*
     * Set the stopping position if it wasn't specified.
     */

    if (index2Ptr == NULL) {
	index2Ptr = TkTextMakeIndex(textPtr->tree,
		TkBTreeNumLines(textPtr->tree), 0, &endOfText);
    }

    /* 
     * Initialize a search through all transitions on the tag, starting
     * with the first transition where the tag's current state is different
     * from what it will eventually be.







|







2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
    }

    /*
     * Set the stopping position if it wasn't specified.
     */

    if (index2Ptr == NULL) {
	index2Ptr = TkTextMakeByteIndex(textPtr->tree,
		TkBTreeNumLines(textPtr->tree), 0, &endOfText);
    }

    /* 
     * Initialize a search through all transitions on the tag, starting
     * with the first transition where the tag's current state is different
     * from what it will eventually be.
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
	 * for the character just before it instead.  This is needed to
	 * handle the case where the first character of a wrapped
	 * display line just got smaller, so that it now fits on the
	 * line before:  need to relayout the line containing the
	 * previous character.
	 */

	if (curIndexPtr->charIndex == 0) {
	    dlPtr = FindDLine(dlPtr, curIndexPtr);
	} else {
	    TkTextIndex tmp;

	    tmp = *curIndexPtr;
	    tmp.charIndex -= 1;
	    dlPtr = FindDLine(dlPtr, &tmp);
	}
	if (dlPtr == NULL) {
	    break;
	}

	/*
	 * Find the first DLine structure that's past the end of the range.
	 */

	if (!TkBTreeNextTag(&search)) {
	    endIndexPtr = index2Ptr;
	} else {
	    curIndexPtr = &search.curIndex;
	    endIndexPtr = curIndexPtr;
	}
	endPtr = FindDLine(dlPtr, endIndexPtr);
	if ((endPtr != NULL) && (endPtr->index.linePtr == endIndexPtr->linePtr)
		&& (endPtr->index.charIndex < endIndexPtr->charIndex)) {
	    endPtr = endPtr->nextPtr;
	}

	/*
	 * Delete all of the display lines in the range, so that they'll
	 * be re-layed out and redrawn.
	 */







|





|


















|







2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
	 * for the character just before it instead.  This is needed to
	 * handle the case where the first character of a wrapped
	 * display line just got smaller, so that it now fits on the
	 * line before:  need to relayout the line containing the
	 * previous character.
	 */

	if (curIndexPtr->byteIndex == 0) {
	    dlPtr = FindDLine(dlPtr, curIndexPtr);
	} else {
	    TkTextIndex tmp;

	    tmp = *curIndexPtr;
	    tmp.byteIndex -= 1;
	    dlPtr = FindDLine(dlPtr, &tmp);
	}
	if (dlPtr == NULL) {
	    break;
	}

	/*
	 * Find the first DLine structure that's past the end of the range.
	 */

	if (!TkBTreeNextTag(&search)) {
	    endIndexPtr = index2Ptr;
	} else {
	    curIndexPtr = &search.curIndex;
	    endIndexPtr = curIndexPtr;
	}
	endPtr = FindDLine(dlPtr, endIndexPtr);
	if ((endPtr != NULL) && (endPtr->index.linePtr == endIndexPtr->linePtr)
		&& (endPtr->index.byteIndex < endIndexPtr->byteIndex)) {
	    endPtr = endPtr->nextPtr;
	}

	/*
	 * Delete all of the display lines in the range, so that they'll
	 * be re-layed out and redrawn.
	 */
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868

    /*
     * If the upper-left character isn't the first in a line, recompute
     * it.  This is necessary because a change in the window's size
     * or options could change the way lines wrap.
     */

    if (textPtr->topIndex.charIndex != 0) {
	MeasureUp(textPtr, &textPtr->topIndex, 0, &textPtr->topIndex);
    }

    /*
     * Invalidate cached scrollbar positions, so that scrollbars
     * sliders will be udpated.
     */







|







2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875

    /*
     * If the upper-left character isn't the first in a line, recompute
     * it.  This is necessary because a change in the window's size
     * or options could change the way lines wrap.
     */

    if (textPtr->topIndex.byteIndex != 0) {
	MeasureUp(textPtr, &textPtr->topIndex, 0, &textPtr->topIndex);
    }

    /*
     * Invalidate cached scrollbar positions, so that scrollbars
     * sliders will be udpated.
     */
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
	/*
	 * The specified position must go at the top of the screen.
	 * Just leave all the DLine's alone: we may be able to reuse
	 * some of the information that's currently on the screen
	 * without redisplaying it all.
	 */

	if (indexPtr->charIndex == 0) {
	    textPtr->topIndex = *indexPtr;
	} else {
	    MeasureUp(textPtr, indexPtr, 0, &textPtr->topIndex);
	}
	goto scheduleUpdate;
    }








|







2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
	/*
	 * The specified position must go at the top of the screen.
	 * Just leave all the DLine's alone: we may be able to reuse
	 * some of the information that's currently on the screen
	 * without redisplaying it all.
	 */

	if (indexPtr->byteIndex == 0) {
	    textPtr->topIndex = *indexPtr;
	} else {
	    MeasureUp(textPtr, indexPtr, 0, &textPtr->topIndex);
	}
	goto scheduleUpdate;
    }

2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
	    /*
	     * Part of the line hangs off the bottom of the screen;
	     * pretend the whole line is off-screen.
	     */

	    dlPtr = NULL;
	} else if ((dlPtr->index.linePtr == indexPtr->linePtr)
		&& (dlPtr->index.charIndex <= indexPtr->charIndex)) {
	    return;
	}
    }

    /*
     * The desired line isn't already on-screen.  Figure out what
     * it means to be "close" to the top or bottom of the screen.







|







2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
	    /*
	     * Part of the line hangs off the bottom of the screen;
	     * pretend the whole line is off-screen.
	     */

	    dlPtr = NULL;
	} else if ((dlPtr->index.linePtr == indexPtr->linePtr)
		&& (dlPtr->index.byteIndex <= indexPtr->byteIndex)) {
	    return;
	}
    }

    /*
     * The desired line isn't already on-screen.  Figure out what
     * it means to be "close" to the top or bottom of the screen.
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
				 * measuring. */
    int distance;		/* Vertical distance in pixels measured
				 * from the pixel just below the lowest
				 * one in srcPtr's line. */
    TkTextIndex *dstPtr;	/* Index to fill in with result. */
{
    int lineNum;		/* Number of current line. */
    int charsToCount;		/* Maximum number of characters to measure
				 * in current line. */
    TkTextIndex bestIndex;	/* Best candidate seen so far for result. */
    TkTextIndex index;
    DLine *dlPtr, *lowestPtr;
    int noBestYet;		/* 1 means bestIndex hasn't been set. */

    noBestYet = 1;
    charsToCount = srcPtr->charIndex + 1;
    index.tree = srcPtr->tree;
    for (lineNum = TkBTreeLineIndex(srcPtr->linePtr); lineNum >= 0;
	    lineNum--) {
	/*
	 * Layout an entire text line (potentially > 1 display line).
	 * For the first line, which contains srcPtr, only layout the
	 * part up through srcPtr (charsToCount is non-infinite to
	 * accomplish this).  Make a list of all the display lines
	 * in backwards order (the lowest DLine on the screen is first
	 * in the list).
	 */

	index.linePtr = TkBTreeFindLine(srcPtr->tree, lineNum);
	index.charIndex = 0;
	lowestPtr = NULL;
	do {
	    dlPtr = LayoutDLine(textPtr, &index);
	    dlPtr->nextPtr = lowestPtr;
	    lowestPtr = dlPtr;
	    TkTextIndexForwChars(&index, dlPtr->count, &index);
	    charsToCount -= dlPtr->count;
	} while ((charsToCount > 0) && (index.linePtr == dlPtr->index.linePtr));

	/*
	 * Scan through the display lines to see if we've covered enough
	 * vertical distance.  If so, save the starting index for the
	 * line at the desired location.
	 */








|
|






|






|






|





|
|
|







3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
				 * measuring. */
    int distance;		/* Vertical distance in pixels measured
				 * from the pixel just below the lowest
				 * one in srcPtr's line. */
    TkTextIndex *dstPtr;	/* Index to fill in with result. */
{
    int lineNum;		/* Number of current line. */
    int bytesToCount;		/* Maximum number of bytes to measure in
				 * current line. */
    TkTextIndex bestIndex;	/* Best candidate seen so far for result. */
    TkTextIndex index;
    DLine *dlPtr, *lowestPtr;
    int noBestYet;		/* 1 means bestIndex hasn't been set. */

    noBestYet = 1;
    bytesToCount = srcPtr->byteIndex + 1;
    index.tree = srcPtr->tree;
    for (lineNum = TkBTreeLineIndex(srcPtr->linePtr); lineNum >= 0;
	    lineNum--) {
	/*
	 * Layout an entire text line (potentially > 1 display line).
	 * For the first line, which contains srcPtr, only layout the
	 * part up through srcPtr (bytesToCount is non-infinite to
	 * accomplish this).  Make a list of all the display lines
	 * in backwards order (the lowest DLine on the screen is first
	 * in the list).
	 */

	index.linePtr = TkBTreeFindLine(srcPtr->tree, lineNum);
	index.byteIndex = 0;
	lowestPtr = NULL;
	do {
	    dlPtr = LayoutDLine(textPtr, &index);
	    dlPtr->nextPtr = lowestPtr;
	    lowestPtr = dlPtr;
	    TkTextIndexForwBytes(&index, dlPtr->byteCount, &index);
	    bytesToCount -= dlPtr->byteCount;
	} while ((bytesToCount > 0) && (index.linePtr == dlPtr->index.linePtr));

	/*
	 * Scan through the display lines to see if we've covered enough
	 * vertical distance.  If so, save the starting index for the
	 * line at the desired location.
	 */

3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
	 * for the next display line to lay out.
	 */

	FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0);
	if (distance < 0) {
	    return;
	}
	charsToCount = INT_MAX;		/* Consider all chars. in next line. */
    }

    /*
     * Ran off the beginning of the text.  Return the first character
     * in the text.
     */

    TkTextMakeIndex(textPtr->tree, 0, 0, dstPtr);
}

/*
 *--------------------------------------------------------------
 *
 * TkTextSeeCmd --
 *







|







|







3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
	 * for the next display line to lay out.
	 */

	FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0);
	if (distance < 0) {
	    return;
	}
	bytesToCount = INT_MAX;		/* Consider all chars. in next line. */
    }

    /*
     * Ran off the beginning of the text.  Return the first character
     * in the text.
     */

    TkTextMakeByteIndex(textPtr->tree, 0, 0, dstPtr);
}

/*
 *--------------------------------------------------------------
 *
 * TkTextSeeCmd --
 *
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings.  Someone else has already
				 * parsed this command enough to know that
				 * argv[1] is "see". */
{
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
    TkTextIndex index;
    int x, y, width, height, lineWidth, charCount, oneThird, delta;
    DLine *dlPtr;
    TkTextDispChunk *chunkPtr;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " see index\"", (char *) NULL);
	return TCL_ERROR;







|







3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings.  Someone else has already
				 * parsed this command enough to know that
				 * argv[1] is "see". */
{
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
    TkTextIndex index;
    int x, y, width, height, lineWidth, byteCount, oneThird, delta;
    DLine *dlPtr;
    TkTextDispChunk *chunkPtr;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " see index\"", (char *) NULL);
	return TCL_ERROR;
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
    }

    /*
     * Find the chunk that contains the desired index.
     */

    dlPtr = FindDLine(dInfoPtr->dLinePtr, &index);
    charCount = index.charIndex - dlPtr->index.charIndex;
    for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) {
	if (charCount < chunkPtr->numChars) {
	    break;
	}
	charCount -= chunkPtr->numChars;
    }

    /*
     * Call a chunk-specific procedure to find the horizontal range of
     * the character within the chunk.
     */

    (*chunkPtr->bboxProc)(chunkPtr, charCount, dlPtr->y + dlPtr->spaceAbove,
	    dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
	    dlPtr->baseline - dlPtr->spaceAbove, &x, &y, &width,
	    &height);
    delta = x - dInfoPtr->curPixelOffset;
    oneThird = lineWidth/3;
    if (delta < 0) {
	if (delta < -oneThird) {
	    dInfoPtr->newCharOffset = (x - lineWidth/2)/textPtr->charWidth;
	} else {
	    dInfoPtr->newCharOffset -= ((-delta) + textPtr->charWidth - 1)
		/ textPtr->charWidth;
	}
    } else {
	delta -= (lineWidth - width);
	if (delta > 0) {
	    if (delta > oneThird) {
		dInfoPtr->newCharOffset = (x - lineWidth/2)/textPtr->charWidth;
	    } else {
		dInfoPtr->newCharOffset += (delta + textPtr->charWidth - 1)
		    / textPtr->charWidth;
	    }
	} else {
	    return TCL_OK;
	}
    }
    dInfoPtr->flags |= DINFO_OUT_OF_DATE;







|

|


|







|







|

|






|

|







3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
    }

    /*
     * Find the chunk that contains the desired index.
     */

    dlPtr = FindDLine(dInfoPtr->dLinePtr, &index);
    byteCount = index.byteIndex - dlPtr->index.byteIndex;
    for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) {
	if (byteCount < chunkPtr->numBytes) {
	    break;
	}
	byteCount -= chunkPtr->numBytes;
    }

    /*
     * Call a chunk-specific procedure to find the horizontal range of
     * the character within the chunk.
     */

    (*chunkPtr->bboxProc)(chunkPtr, byteCount, dlPtr->y + dlPtr->spaceAbove,
	    dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
	    dlPtr->baseline - dlPtr->spaceAbove, &x, &y, &width,
	    &height);
    delta = x - dInfoPtr->curPixelOffset;
    oneThird = lineWidth/3;
    if (delta < 0) {
	if (delta < -oneThird) {
	    dInfoPtr->newByteOffset = (x - lineWidth/2)/textPtr->charWidth;
	} else {
	    dInfoPtr->newByteOffset -= ((-delta) + textPtr->charWidth - 1)
		/ textPtr->charWidth;
	}
    } else {
	delta -= (lineWidth - width);
	if (delta > 0) {
	    if (delta > oneThird) {
		dInfoPtr->newByteOffset = (x - lineWidth/2)/textPtr->charWidth;
	    } else {
		dInfoPtr->newByteOffset += (delta + textPtr->charWidth - 1)
		    / textPtr->charWidth;
	    }
	} else {
	    return TCL_OK;
	}
    }
    dInfoPtr->flags |= DINFO_OUT_OF_DATE;
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
    }

    if (argc == 2) {
	GetXView(interp, textPtr, 0);
	return TCL_OK;
    }

    newOffset = dInfoPtr->newCharOffset;
    type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
    switch (type) {
	case TK_SCROLL_ERROR:
	    return TCL_ERROR;
	case TK_SCROLL_MOVETO:
	    if (fraction > 1.0) {
		fraction = 1.0;
	    }
	    if (fraction < 0) {
		fraction = 0;
	    }
	    newOffset = (int) (((fraction * dInfoPtr->maxLength) / textPtr->charWidth)
		    + 0.5);
	    break;
	case TK_SCROLL_PAGES:
	    charsPerPage = ((dInfoPtr->maxX - dInfoPtr->x) / textPtr->charWidth)
		    - 2;
	    if (charsPerPage < 1) {
		charsPerPage = 1;
	    }
	    newOffset += charsPerPage*count;
	    break;
	case TK_SCROLL_UNITS:
	    newOffset += count;
	    break;
    }

    dInfoPtr->newCharOffset = newOffset;
    dInfoPtr->flags |= DINFO_OUT_OF_DATE;
    if (!(dInfoPtr->flags & REDRAW_PENDING)) {
	dInfoPtr->flags |= REDRAW_PENDING;
	Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
    }
    return TCL_OK;
}







|




















|






|







3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
    }

    if (argc == 2) {
	GetXView(interp, textPtr, 0);
	return TCL_OK;
    }

    newOffset = dInfoPtr->newByteOffset;
    type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
    switch (type) {
	case TK_SCROLL_ERROR:
	    return TCL_ERROR;
	case TK_SCROLL_MOVETO:
	    if (fraction > 1.0) {
		fraction = 1.0;
	    }
	    if (fraction < 0) {
		fraction = 0;
	    }
	    newOffset = (int) (((fraction * dInfoPtr->maxLength) / textPtr->charWidth)
		    + 0.5);
	    break;
	case TK_SCROLL_PAGES:
	    charsPerPage = ((dInfoPtr->maxX - dInfoPtr->x) / textPtr->charWidth)
		    - 2;
	    if (charsPerPage < 1) {
		charsPerPage = 1;
	    }
	    newOffset += charsPerPage * count;
	    break;
	case TK_SCROLL_UNITS:
	    newOffset += count;
	    break;
    }

    dInfoPtr->newByteOffset = newOffset;
    dInfoPtr->flags |= DINFO_OUT_OF_DATE;
    if (!(dInfoPtr->flags & REDRAW_PENDING)) {
	dInfoPtr->flags |= REDRAW_PENDING;
	Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
    }
    return TCL_OK;
}
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
    TkText *textPtr;		/* Widget to scroll. */
    int offset;			/* Amount by which to scroll, in *screen*
				 * lines.  Positive means that information
				 * later in text becomes visible, negative
				 * means that information earlier in the
				 * text becomes visible. */
{
    int i, charsToCount, lineNum;
    TkTextIndex new, index;
    TkTextLine *lastLinePtr;
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
    DLine *dlPtr, *lowestPtr;

    if (offset < 0) {
	/*
	 * Must scroll up (to show earlier information in the text).
	 * The code below is similar to that in MeasureUp, except that
	 * it counts lines instead of pixels.
	 */

	charsToCount = textPtr->topIndex.charIndex + 1;
	index.tree = textPtr->tree;
	offset--;			/* Skip line containing topIndex. */
	for (lineNum = TkBTreeLineIndex(textPtr->topIndex.linePtr);
		lineNum >= 0; lineNum--) {
	    index.linePtr = TkBTreeFindLine(textPtr->tree, lineNum);
	    index.charIndex = 0;
	    lowestPtr = NULL;
	    do {
		dlPtr = LayoutDLine(textPtr, &index);
		dlPtr->nextPtr = lowestPtr;
		lowestPtr = dlPtr;
		TkTextIndexForwChars(&index, dlPtr->count, &index);
		charsToCount -= dlPtr->count;
	    } while ((charsToCount > 0)
		    && (index.linePtr == dlPtr->index.linePtr));

	    for (dlPtr = lowestPtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) {
		offset++;
		if (offset == 0) {
		    textPtr->topIndex = dlPtr->index;
		    break;
		}
	    }
    
	    /*
	     * Discard the display lines, then either return or prepare
	     * for the next display line to lay out.
	     */
    
	    FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0);
	    if (offset >= 0) {
		goto scheduleUpdate;
	    }
	    charsToCount = INT_MAX;
	}
    
	/*
	 * Ran off the beginning of the text.  Return the first character
	 * in the text.
	 */

	TkTextMakeIndex(textPtr->tree, 0, 0, &textPtr->topIndex);
    } else {
	/*
	 * Scrolling down, to show later information in the text.
	 * Just count lines from the current top of the window.
	 */

	lastLinePtr = TkBTreeFindLine(textPtr->tree,
		TkBTreeNumLines(textPtr->tree));
	for (i = 0; i < offset; i++) {
	    dlPtr = LayoutDLine(textPtr, &textPtr->topIndex);
	    dlPtr->nextPtr = NULL;
	    TkTextIndexForwChars(&textPtr->topIndex, dlPtr->count, &new);
	    FreeDLines(textPtr, dlPtr, (DLine *) NULL, 0);
	    if (new.linePtr == lastLinePtr) {
		break;
	    }
	    textPtr->topIndex = new;
	}
    }







|












|





|





|
|
|



















|







|











|







3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
    TkText *textPtr;		/* Widget to scroll. */
    int offset;			/* Amount by which to scroll, in *screen*
				 * lines.  Positive means that information
				 * later in text becomes visible, negative
				 * means that information earlier in the
				 * text becomes visible. */
{
    int i, bytesToCount, lineNum;
    TkTextIndex new, index;
    TkTextLine *lastLinePtr;
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
    DLine *dlPtr, *lowestPtr;

    if (offset < 0) {
	/*
	 * Must scroll up (to show earlier information in the text).
	 * The code below is similar to that in MeasureUp, except that
	 * it counts lines instead of pixels.
	 */

	bytesToCount = textPtr->topIndex.byteIndex + 1;
	index.tree = textPtr->tree;
	offset--;			/* Skip line containing topIndex. */
	for (lineNum = TkBTreeLineIndex(textPtr->topIndex.linePtr);
		lineNum >= 0; lineNum--) {
	    index.linePtr = TkBTreeFindLine(textPtr->tree, lineNum);
	    index.byteIndex = 0;
	    lowestPtr = NULL;
	    do {
		dlPtr = LayoutDLine(textPtr, &index);
		dlPtr->nextPtr = lowestPtr;
		lowestPtr = dlPtr;
		TkTextIndexForwBytes(&index, dlPtr->byteCount, &index);
		bytesToCount -= dlPtr->byteCount;
	    } while ((bytesToCount > 0)
		    && (index.linePtr == dlPtr->index.linePtr));

	    for (dlPtr = lowestPtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) {
		offset++;
		if (offset == 0) {
		    textPtr->topIndex = dlPtr->index;
		    break;
		}
	    }
    
	    /*
	     * Discard the display lines, then either return or prepare
	     * for the next display line to lay out.
	     */
    
	    FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0);
	    if (offset >= 0) {
		goto scheduleUpdate;
	    }
	    bytesToCount = INT_MAX;
	}
    
	/*
	 * Ran off the beginning of the text.  Return the first character
	 * in the text.
	 */

	TkTextMakeByteIndex(textPtr->tree, 0, 0, &textPtr->topIndex);
    } else {
	/*
	 * Scrolling down, to show later information in the text.
	 * Just count lines from the current top of the window.
	 */

	lastLinePtr = TkBTreeFindLine(textPtr->tree,
		TkBTreeNumLines(textPtr->tree));
	for (i = 0; i < offset; i++) {
	    dlPtr = LayoutDLine(textPtr, &textPtr->topIndex);
	    dlPtr->nextPtr = NULL;
	    TkTextIndexForwBytes(&textPtr->topIndex, dlPtr->byteCount, &new);
	    FreeDLines(textPtr, dlPtr, (DLine *) NULL, 0);
	    if (new.linePtr == lastLinePtr) {
		break;
	    }
	    textPtr->topIndex = new;
	}
    }
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings.  Someone else has already
				 * parsed this command enough to know that
				 * argv[1] is "yview". */
{
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
    int pickPlace, lineNum, type, charsInLine;
    Tk_FontMetrics fm;
    int pixels, count;
    size_t switchLength;
    double fraction;
    TkTextIndex index, new;
    TkTextLine *lastLinePtr;
    DLine *dlPtr;







|







3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings.  Someone else has already
				 * parsed this command enough to know that
				 * argv[1] is "yview". */
{
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
    int pickPlace, lineNum, type, bytesInLine;
    Tk_FontMetrics fm;
    int pixels, count;
    size_t switchLength;
    double fraction;
    TkTextIndex index, new;
    TkTextLine *lastLinePtr;
    DLine *dlPtr;
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
			(char *) NULL);
		return TCL_ERROR;
	    }
	}
    }
    if ((argc == 3) || pickPlace) {
	if (Tcl_GetInt(interp, argv[2+pickPlace], &lineNum) == TCL_OK) {
	    TkTextMakeIndex(textPtr->tree, lineNum, 0, &index);
	    TkTextSetYView(textPtr, &index, 0);
	    return TCL_OK;
	}
    
	/*
	 * The argument must be a regular text index.
	 */







|







3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
			(char *) NULL);
		return TCL_ERROR;
	    }
	}
    }
    if ((argc == 3) || pickPlace) {
	if (Tcl_GetInt(interp, argv[2+pickPlace], &lineNum) == TCL_OK) {
	    TkTextMakeByteIndex(textPtr->tree, lineNum, 0, &index);
	    TkTextSetYView(textPtr, &index, 0);
	    return TCL_OK;
	}
    
	/*
	 * The argument must be a regular text index.
	 */
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
		fraction = 1.0;
	    }
	    if (fraction < 0) {
		fraction = 0;
	    }
	    fraction *= TkBTreeNumLines(textPtr->tree);
	    lineNum = (int) fraction;
	    TkTextMakeIndex(textPtr->tree, lineNum, 0, &index);
	    charsInLine = TkBTreeCharsInLine(index.linePtr);
	    index.charIndex = (int)((charsInLine * (fraction-lineNum)) + 0.5);
	    if (index.charIndex >= charsInLine) {
		TkTextMakeIndex(textPtr->tree, lineNum+1, 0, &index);
	    }
	    TkTextSetYView(textPtr, &index, 0);
	    break;
	case TK_SCROLL_PAGES:
	    /*
	     * Scroll up or down by screenfuls.  Actually, use the
	     * window height minus two lines, so that there's some







|
|
|
|
|







3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
		fraction = 1.0;
	    }
	    if (fraction < 0) {
		fraction = 0;
	    }
	    fraction *= TkBTreeNumLines(textPtr->tree);
	    lineNum = (int) fraction;
	    TkTextMakeByteIndex(textPtr->tree, lineNum, 0, &index);
	    bytesInLine = TkBTreeBytesInLine(index.linePtr);
	    index.byteIndex = (int)((bytesInLine * (fraction-lineNum)) + 0.5);
	    if (index.byteIndex >= bytesInLine) {
		TkTextMakeByteIndex(textPtr->tree, lineNum + 1, 0, &index);
	    }
	    TkTextSetYView(textPtr, &index, 0);
	    break;
	case TK_SCROLL_PAGES:
	    /*
	     * Scroll up or down by screenfuls.  Actually, use the
	     * window height minus two lines, so that there's some
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580

		pixels = (dInfoPtr->maxY - 2*fm.linespace - dInfoPtr->y)*count;
		lastLinePtr = TkBTreeFindLine(textPtr->tree,
			TkBTreeNumLines(textPtr->tree));
		do {
		    dlPtr = LayoutDLine(textPtr, &textPtr->topIndex);
		    dlPtr->nextPtr = NULL;
		    TkTextIndexForwChars(&textPtr->topIndex, dlPtr->count,
			    &new);
		    pixels -= dlPtr->height;
		    FreeDLines(textPtr, dlPtr, (DLine *) NULL, 0);
		    if (new.linePtr == lastLinePtr) {
			break;
		    }
		    textPtr->topIndex = new;







|







3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587

		pixels = (dInfoPtr->maxY - 2*fm.linespace - dInfoPtr->y)*count;
		lastLinePtr = TkBTreeFindLine(textPtr->tree,
			TkBTreeNumLines(textPtr->tree));
		do {
		    dlPtr = LayoutDLine(textPtr, &textPtr->topIndex);
		    dlPtr->nextPtr = NULL;
		    TkTextIndexForwBytes(&textPtr->topIndex, dlPtr->byteCount,
			    &new);
		    pixels -= dlPtr->height;
		    FreeDLines(textPtr, dlPtr, (DLine *) NULL, 0);
		    if (new.linePtr == lastLinePtr) {
			break;
		    }
		    textPtr->topIndex = new;
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings.  Someone else has already
				 * parsed this command enough to know that
				 * argv[1] is "scan". */
{
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
    TkTextIndex index;
    int c, x, y, totalScroll, newChar, maxChar;
    Tk_FontMetrics fm;
    size_t length;

    if (argc != 5) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " scan mark|dragto x y\"", (char *) NULL);
	return TCL_ERROR;







|







3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings.  Someone else has already
				 * parsed this command enough to know that
				 * argv[1] is "scan". */
{
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
    TkTextIndex index;
    int c, x, y, totalScroll, newByte, maxByte;
    Tk_FontMetrics fm;
    size_t length;

    if (argc != 5) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " scan mark|dragto x y\"", (char *) NULL);
	return TCL_ERROR;
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659

3660
3661
3662

3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
	 * current position continues to correspond to the edge of the
	 * window.  This means that the picture will start dragging as
	 * soon as the mouse reverses direction (without this reset, might
	 * have to slide mouse a long ways back before the picture starts
	 * moving again).
	 */

	newChar = dInfoPtr->scanMarkChar + (10*(dInfoPtr->scanMarkX - x))
		/ (textPtr->charWidth);
	maxChar = 1 + (dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x)
		+ textPtr->charWidth - 1)/textPtr->charWidth;
	if (newChar < 0) {

	    dInfoPtr->scanMarkChar = newChar = 0;
	    dInfoPtr->scanMarkX = x;
	} else if (newChar > maxChar) {

	    dInfoPtr->scanMarkChar = newChar = maxChar;
	    dInfoPtr->scanMarkX = x;
	}
	dInfoPtr->newCharOffset = newChar;

	Tk_GetFontMetrics(textPtr->tkfont, &fm);
	totalScroll = (10*(dInfoPtr->scanMarkY - y)) / fm.linespace;
	if (totalScroll != dInfoPtr->scanTotalScroll) {
	    index = textPtr->topIndex;
	    ScrollByLines(textPtr, totalScroll-dInfoPtr->scanTotalScroll);
	    dInfoPtr->scanTotalScroll = totalScroll;
	    if ((index.linePtr == textPtr->topIndex.linePtr) &&
		    (index.charIndex == textPtr->topIndex.charIndex)) {
		dInfoPtr->scanTotalScroll = 0;
		dInfoPtr->scanMarkY = y;
	    }
	}
    } else if ((c == 'm') && (strncmp(argv[2], "mark", length) == 0)) {
	dInfoPtr->scanMarkChar = dInfoPtr->newCharOffset;
	dInfoPtr->scanMarkX = x;
	dInfoPtr->scanTotalScroll = 0;
	dInfoPtr->scanMarkY = y;
    } else {
	Tcl_AppendResult(interp, "bad scan option \"", argv[2],
		"\": must be mark or dragto", (char *) NULL);
	return TCL_ERROR;







|

|

|
>
|

|
>
|


|








|





|







3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
	 * current position continues to correspond to the edge of the
	 * window.  This means that the picture will start dragging as
	 * soon as the mouse reverses direction (without this reset, might
	 * have to slide mouse a long ways back before the picture starts
	 * moving again).
	 */

	newByte = dInfoPtr->scanMarkIndex + (10*(dInfoPtr->scanMarkX - x))
		/ (textPtr->charWidth);
	maxByte = 1 + (dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x)
		+ textPtr->charWidth - 1)/textPtr->charWidth;
	if (newByte < 0) {
	    newByte = 0;
	    dInfoPtr->scanMarkIndex = 0;
	    dInfoPtr->scanMarkX = x;
	} else if (newByte > maxByte) {
	    newByte = maxByte;
	    dInfoPtr->scanMarkIndex = maxByte;
	    dInfoPtr->scanMarkX = x;
	}
	dInfoPtr->newByteOffset = newByte;

	Tk_GetFontMetrics(textPtr->tkfont, &fm);
	totalScroll = (10*(dInfoPtr->scanMarkY - y)) / fm.linespace;
	if (totalScroll != dInfoPtr->scanTotalScroll) {
	    index = textPtr->topIndex;
	    ScrollByLines(textPtr, totalScroll-dInfoPtr->scanTotalScroll);
	    dInfoPtr->scanTotalScroll = totalScroll;
	    if ((index.linePtr == textPtr->topIndex.linePtr) &&
		    (index.byteIndex == textPtr->topIndex.byteIndex)) {
		dInfoPtr->scanTotalScroll = 0;
		dInfoPtr->scanMarkY = y;
	    }
	}
    } else if ((c == 'm') && (strncmp(argv[2], "mark", length) == 0)) {
	dInfoPtr->scanMarkIndex = dInfoPtr->newByteOffset;
	dInfoPtr->scanMarkX = x;
	dInfoPtr->scanTotalScroll = 0;
	dInfoPtr->scanMarkY = y;
    } else {
	Tcl_AppendResult(interp, "bad scan option \"", argv[2],
		"\": must be mark or dragto", (char *) NULL);
	return TCL_ERROR;
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750

3751
3752
3753
3754
3755
3756
3757
 * GetXView --
 *
 *	This procedure computes the fractions that indicate what's
 *	visible in a text window and, optionally, evaluates a
 *	Tcl script to report them to the text's associated scrollbar.
 *
 * Results:
 *	If report is zero, then interp->result is filled in with
 *	two real numbers separated by a space, giving the position of
 *	the left and right edges of the window as fractions from 0 to
 *	1, where 0 means the left edge of the text and 1 means the right
 *	edge.  If report is non-zero, then interp->result isn't modified
 *	directly, but instead a script is evaluated in interp to report
 *	the new horizontal scroll position to the scrollbar (if the scroll
 *	position hasn't changed then no script is invoked).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
GetXView(interp, textPtr, report)
    Tcl_Interp *interp;			/* If "report" is FALSE, string
					 * describing visible range gets
					 * stored in interp->result. */
    TkText *textPtr;			/* Information about text widget. */
    int report;				/* Non-zero means report info to
					 * scrollbar if it has changed. */
{
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
    char buffer[200];
    double first, last;
    int code;

    if (dInfoPtr->maxLength > 0) {
	first = ((double) dInfoPtr->curPixelOffset)
		/ dInfoPtr->maxLength;
	last = first + ((double) (dInfoPtr->maxX - dInfoPtr->x))
		/ dInfoPtr->maxLength;
	if (last > 1.0) {
	    last = 1.0;
	}
    } else {
	first = 0;
	last = 1.0;
    }
    if (!report) {
	sprintf(interp->result, "%g %g", first, last);

	return;
    }
    if ((first == dInfoPtr->xScrollFirst) && (last == dInfoPtr->xScrollLast)) {
	return;
    }
    dInfoPtr->xScrollFirst = first;
    dInfoPtr->xScrollLast = last;







|



|














|





|
















|
>







3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
 * GetXView --
 *
 *	This procedure computes the fractions that indicate what's
 *	visible in a text window and, optionally, evaluates a
 *	Tcl script to report them to the text's associated scrollbar.
 *
 * Results:
 *	If report is zero, then the interp's result is filled in with
 *	two real numbers separated by a space, giving the position of
 *	the left and right edges of the window as fractions from 0 to
 *	1, where 0 means the left edge of the text and 1 means the right
 *	edge.  If report is non-zero, then the interp's result isn't modified
 *	directly, but instead a script is evaluated in interp to report
 *	the new horizontal scroll position to the scrollbar (if the scroll
 *	position hasn't changed then no script is invoked).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
GetXView(interp, textPtr, report)
    Tcl_Interp *interp;			/* If "report" is FALSE, string
					 * describing visible range gets
					 * stored in the interp's result. */
    TkText *textPtr;			/* Information about text widget. */
    int report;				/* Non-zero means report info to
					 * scrollbar if it has changed. */
{
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
    char buffer[TCL_DOUBLE_SPACE * 2];
    double first, last;
    int code;

    if (dInfoPtr->maxLength > 0) {
	first = ((double) dInfoPtr->curPixelOffset)
		/ dInfoPtr->maxLength;
	last = first + ((double) (dInfoPtr->maxX - dInfoPtr->x))
		/ dInfoPtr->maxLength;
	if (last > 1.0) {
	    last = 1.0;
	}
    } else {
	first = 0;
	last = 1.0;
    }
    if (!report) {
	sprintf(buffer, "%g %g", first, last);
	Tcl_SetResult(interp, buffer, TCL_VOLATILE);
	return;
    }
    if ((first == dInfoPtr->xScrollFirst) && (last == dInfoPtr->xScrollLast)) {
	return;
    }
    dInfoPtr->xScrollFirst = first;
    dInfoPtr->xScrollLast = last;
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834

3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
 * GetYView --
 *
 *	This procedure computes the fractions that indicate what's
 *	visible in a text window and, optionally, evaluates a
 *	Tcl script to report them to the text's associated scrollbar.
 *
 * Results:
 *	If report is zero, then interp->result is filled in with
 *	two real numbers separated by a space, giving the position of
 *	the top and bottom of the window as fractions from 0 to 1, where
 *	0 means the beginning of the text and 1 means the end.  If
 *	report is non-zero, then interp->result isn't modified directly,
 *	but a script is evaluated in interp to report the new scroll
 *	position to the scrollbar (if the scroll position hasn't changed
 *	then no script is invoked).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
GetYView(interp, textPtr, report)
    Tcl_Interp *interp;			/* If "report" is FALSE, string
					 * describing visible range gets
					 * stored in interp->result. */
    TkText *textPtr;			/* Information about text widget. */
    int report;				/* Non-zero means report info to
					 * scrollbar if it has changed. */
{
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
    char buffer[200];
    double first, last;
    DLine *dlPtr;
    int totalLines, code, count;

    dlPtr = dInfoPtr->dLinePtr;
    totalLines = TkBTreeNumLines(textPtr->tree);
    first = ((double) TkBTreeLineIndex(dlPtr->index.linePtr))
	    + ((double) dlPtr->index.charIndex)
	    / (TkBTreeCharsInLine(dlPtr->index.linePtr));
    first /= totalLines;
    while (1) {
	if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) {
	    /*
	     * The last line is only partially visible, so don't
	     * count its characters in what's visible.
	     */
	    count = 0;
	    break;
	}
	if (dlPtr->nextPtr == NULL) {
	    count = dlPtr->count;
	    break;
	}
	dlPtr = dlPtr->nextPtr;
    }
    last = ((double) TkBTreeLineIndex(dlPtr->index.linePtr))
	    + ((double) (dlPtr->index.charIndex + count))
	    / (TkBTreeCharsInLine(dlPtr->index.linePtr));
    last /= totalLines;
    if (!report) {
	sprintf(interp->result, "%g %g", first, last);

	return;
    }
    if ((first == dInfoPtr->yScrollFirst) && (last == dInfoPtr->yScrollLast)) {
	return;
    }
    dInfoPtr->yScrollFirst = first;
    dInfoPtr->yScrollLast = last;
    sprintf(buffer, " %g %g", first, last);
    code = Tcl_VarEval(interp, textPtr->yScrollCmd,
	    buffer, (char *) NULL);
    if (code != TCL_OK) {
	Tcl_AddErrorInfo(interp,
		"\n    (vertical scrolling command executed by text)");
	Tcl_BackgroundError(interp);
    }
}








|



|














|





|






|
|
|











|





|
|


|
>








|
<







3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854

3855
3856
3857
3858
3859
3860
3861
 * GetYView --
 *
 *	This procedure computes the fractions that indicate what's
 *	visible in a text window and, optionally, evaluates a
 *	Tcl script to report them to the text's associated scrollbar.
 *
 * Results:
 *	If report is zero, then the interp's result is filled in with
 *	two real numbers separated by a space, giving the position of
 *	the top and bottom of the window as fractions from 0 to 1, where
 *	0 means the beginning of the text and 1 means the end.  If
 *	report is non-zero, then the interp's result isn't modified directly,
 *	but a script is evaluated in interp to report the new scroll
 *	position to the scrollbar (if the scroll position hasn't changed
 *	then no script is invoked).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
GetYView(interp, textPtr, report)
    Tcl_Interp *interp;			/* If "report" is FALSE, string
					 * describing visible range gets
					 * stored in the interp's result. */
    TkText *textPtr;			/* Information about text widget. */
    int report;				/* Non-zero means report info to
					 * scrollbar if it has changed. */
{
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
    char buffer[TCL_DOUBLE_SPACE * 2];
    double first, last;
    DLine *dlPtr;
    int totalLines, code, count;

    dlPtr = dInfoPtr->dLinePtr;
    totalLines = TkBTreeNumLines(textPtr->tree);
    first = (double) TkBTreeLineIndex(dlPtr->index.linePtr)
	    + (double) dlPtr->index.byteIndex
		    / TkBTreeBytesInLine(dlPtr->index.linePtr);
    first /= totalLines;
    while (1) {
	if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) {
	    /*
	     * The last line is only partially visible, so don't
	     * count its characters in what's visible.
	     */
	    count = 0;
	    break;
	}
	if (dlPtr->nextPtr == NULL) {
	    count = dlPtr->byteCount;
	    break;
	}
	dlPtr = dlPtr->nextPtr;
    }
    last = ((double) TkBTreeLineIndex(dlPtr->index.linePtr))
	    + ((double) (dlPtr->index.byteIndex + count))
		    / (TkBTreeBytesInLine(dlPtr->index.linePtr));
    last /= totalLines;
    if (!report) {
	sprintf(buffer, "%g %g", first, last);
	Tcl_SetResult(interp, buffer, TCL_VOLATILE);
	return;
    }
    if ((first == dInfoPtr->yScrollFirst) && (last == dInfoPtr->yScrollLast)) {
	return;
    }
    dInfoPtr->yScrollFirst = first;
    dInfoPtr->yScrollLast = last;
    sprintf(buffer, " %g %g", first, last);
    code = Tcl_VarEval(interp, textPtr->yScrollCmd, buffer, (char *) NULL);

    if (code != TCL_OK) {
	Tcl_AddErrorInfo(interp,
		"\n    (vertical scrolling command executed by text)");
	Tcl_BackgroundError(interp);
    }
}

3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
	return dlPtr;
    }

    /*
     * Now get to the right position within the text line.
     */

    while (indexPtr->charIndex >= (dlPtr->index.charIndex + dlPtr->count)) {
	dlPtr = dlPtr->nextPtr;
	if ((dlPtr == NULL) || (dlPtr->index.linePtr != indexPtr->linePtr)) {
	    break;
	}
    }
    return dlPtr;
}







|







3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
	return dlPtr;
    }

    /*
     * Now get to the right position within the text line.
     */

    while (indexPtr->byteIndex >= (dlPtr->index.byteIndex + dlPtr->byteCount)) {
	dlPtr = dlPtr->nextPtr;
	if ((dlPtr == NULL) || (dlPtr->index.linePtr != indexPtr->linePtr)) {
	    break;
	}
    }
    return dlPtr;
}
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011

4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
     * x-coordinate from the coordinate system of the window to the
     * coordinate system of the line (to take account of x-scrolling).
     */

    *indexPtr = dlPtr->index;
    x = x - dInfoPtr->x + dInfoPtr->curPixelOffset;
    for (chunkPtr = dlPtr->chunkPtr; x >= (chunkPtr->x + chunkPtr->width);
	    indexPtr->charIndex += chunkPtr->numChars,
	    chunkPtr = chunkPtr->nextPtr) {
	if (chunkPtr->nextPtr == NULL) {
	    indexPtr->charIndex += chunkPtr->numChars - 1;

	    return;
	}
    }

    /*
     * If the chunk has more than one character in it, ask it which
     * character is at the desired location.
     */

    if (chunkPtr->numChars > 1) {
	indexPtr->charIndex += (*chunkPtr->measureProc)(chunkPtr, x);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkTextCharBbox --







|


|
>





|



|
|







4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
     * x-coordinate from the coordinate system of the window to the
     * coordinate system of the line (to take account of x-scrolling).
     */

    *indexPtr = dlPtr->index;
    x = x - dInfoPtr->x + dInfoPtr->curPixelOffset;
    for (chunkPtr = dlPtr->chunkPtr; x >= (chunkPtr->x + chunkPtr->width);
	    indexPtr->byteIndex += chunkPtr->numBytes,
	    chunkPtr = chunkPtr->nextPtr) {
	if (chunkPtr->nextPtr == NULL) {
	    indexPtr->byteIndex += chunkPtr->numBytes;
	    TkTextIndexBackChars(indexPtr, 1, indexPtr);
	    return;
	}
    }

    /*
     * If the chunk has more than one byte in it, ask it which
     * character is at the desired location.
     */

    if (chunkPtr->numBytes > 1) {
	indexPtr->byteIndex += (*chunkPtr->measureProc)(chunkPtr, x);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkTextCharBbox --
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
    int *xPtr, *yPtr;		/* Filled with character's upper-left
				 * coordinate. */
    int *widthPtr, *heightPtr;	/* Filled in with character's dimensions. */
{
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
    DLine *dlPtr;
    register TkTextDispChunk *chunkPtr;
    int index;

    /*
     * Make sure that all of the screen layout information is up to date.
     */

    if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
	UpdateDisplayInfo(textPtr);







|







4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
    int *xPtr, *yPtr;		/* Filled with character's upper-left
				 * coordinate. */
    int *widthPtr, *heightPtr;	/* Filled in with character's dimensions. */
{
    TextDInfo *dInfoPtr = textPtr->dInfoPtr;
    DLine *dlPtr;
    register TkTextDispChunk *chunkPtr;
    int byteIndex;

    /*
     * Make sure that all of the screen layout information is up to date.
     */

    if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
	UpdateDisplayInfo(textPtr);
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
    }

    /*
     * Find the chunk within the line that contains the desired
     * index.
     */

    index = indexPtr->charIndex - dlPtr->index.charIndex;
    for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) {
	if (chunkPtr == NULL) {
	    return -1;
	}
	if (index < chunkPtr->numChars) {
	    break;
	}
	index -= chunkPtr->numChars;
    }

    /*
     * Call a chunk-specific procedure to find the horizontal range of
     * the character within the chunk, then fill in the vertical range.
     * The x-coordinate returned by bboxProc is a coordinate within a
     * line, not a coordinate on the screen.  Translate it to reflect
     * horizontal scrolling.
     */

    (*chunkPtr->bboxProc)(chunkPtr, index, dlPtr->y + dlPtr->spaceAbove,
	    dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
	    dlPtr->baseline - dlPtr->spaceAbove, xPtr, yPtr, widthPtr,
	    heightPtr);
    *xPtr = *xPtr + dInfoPtr->x - dInfoPtr->curPixelOffset;
    if ((index == (chunkPtr->numChars-1)) && (chunkPtr->nextPtr == NULL)) {
	/*
	 * Last character in display line.  Give it all the space up to
	 * the line.
	 */

	if (*xPtr > dInfoPtr->maxX) {
	    *xPtr = dInfoPtr->maxX;







|




|


|










|




|







4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
    }

    /*
     * Find the chunk within the line that contains the desired
     * index.
     */

    byteIndex = indexPtr->byteIndex - dlPtr->index.byteIndex;
    for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) {
	if (chunkPtr == NULL) {
	    return -1;
	}
	if (byteIndex < chunkPtr->numBytes) {
	    break;
	}
	byteIndex -= chunkPtr->numBytes;
    }

    /*
     * Call a chunk-specific procedure to find the horizontal range of
     * the character within the chunk, then fill in the vertical range.
     * The x-coordinate returned by bboxProc is a coordinate within a
     * line, not a coordinate on the screen.  Translate it to reflect
     * horizontal scrolling.
     */

    (*chunkPtr->bboxProc)(chunkPtr, byteIndex, dlPtr->y + dlPtr->spaceAbove,
	    dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
	    dlPtr->baseline - dlPtr->spaceAbove, xPtr, yPtr, widthPtr,
	    heightPtr);
    *xPtr = *xPtr + dInfoPtr->x - dInfoPtr->curPixelOffset;
    if ((byteIndex == (chunkPtr->numBytes - 1)) && (chunkPtr->nextPtr == NULL)) {
	/*
	 * Last character in display line.  Give it all the space up to
	 * the line.
	 */

	if (*xPtr > dInfoPtr->maxX) {
	    *xPtr = dInfoPtr->maxX;
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268

4269
4270

4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
/*
 *--------------------------------------------------------------
 *
 * TkTextCharLayoutProc --
 *
 *	This procedure is the "layoutProc" for character segments.
 *
 * Results:
 *	If there is something to display for the chunk then a
 *	non-zero value is returned and the fields of chunkPtr
 *	will be filled in (see the declaration of TkTextDispChunk
 *	in tkText.h for details).  If zero is returned it means
 *	that no characters from this chunk fit in the window.
 *	If -1 is returned it means that this segment just doesn't
 *	need to be displayed (never happens for text).
 *
 * Side effects:
 *	Memory is allocated to hold additional information about
 *	the chunk.
 *
 *--------------------------------------------------------------
 */

int
TkTextCharLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars,
	noCharsYet, wrapMode, chunkPtr)
    TkText *textPtr;		/* Text widget being layed out. */
    TkTextIndex *indexPtr;	/* Index of first character to lay out
				 * (corresponds to segPtr and offset). */
    TkTextSegment *segPtr;	/* Segment being layed out. */
    int offset;			/* Offset within segment of first character
				 * to consider. */
    int maxX;			/* Chunk must not occupy pixels at this
				 * position or higher. */
    int maxChars;		/* Chunk must not include more than this
				 * many characters. */
    int noCharsYet;		/* Non-zero means no characters have been
				 * assigned to this display line yet. */
    Tk_Uid wrapMode;		/* How to handle line wrapping: tkTextCharUid,
				 * tkTextNoneUid, or tkTextWordUid. */
    register TkTextDispChunk *chunkPtr;
				/* Structure to fill in with information
				 * about this chunk.  The x field has already
				 * been set by the caller. */
{
    Tk_Font tkfont;
    int nextX, charsThatFit, count;
    CharInfo *ciPtr;
    char *p;
    TkTextSegment *nextPtr;
    Tk_FontMetrics fm;

    /*
     * Figure out how many characters will fit in the space we've got.
     * Include the next character, even though it won't fit completely,
     * if any of the following is true:
     *   (a) the chunk contains no characters and the display line contains
     *	     no characters yet (i.e. the line isn't wide enough to hold
     *	     even a single character).
     *   (b) at least one pixel of the character is visible, we haven't
     *	     already exceeded the character limit, and the next character
     *	     is a white space character.
     */

    p = segPtr->body.chars + offset;
    tkfont = chunkPtr->stylePtr->sValuePtr->tkfont;
    charsThatFit = MeasureChars(tkfont, p, maxChars, chunkPtr->x, maxX, 0,
	    &nextX);
    if (charsThatFit < maxChars) {
	if ((charsThatFit == 0) && noCharsYet) {

	    charsThatFit = 1;
	    MeasureChars(tkfont, p, 1, chunkPtr->x, INT_MAX, 0, &nextX);

	}
	if ((nextX < maxX) && ((p[charsThatFit] == ' ')
		|| (p[charsThatFit] == '\t'))) {
	    /*
	     * Space characters are funny, in that they are considered
	     * to fit if there is at least one pixel of space left on the
	     * line.  Just give the space character whatever space is left.
	     */

	    nextX = maxX;
	    charsThatFit++;
	}
	if (p[charsThatFit] == '\n') {
	    /*
	     * A newline character takes up no space, so if the previous
	     * character fits then so does the newline.
	     */

	    charsThatFit++;
	}
	if (charsThatFit == 0) {
	    return 0;
	}
    }
	
    Tk_GetFontMetrics(tkfont, &fm);

    /*
     * Fill in the chunk structure and allocate and initialize a
     * CharInfo structure.  If the last character is a newline
     * then don't bother to display it.
     */

    chunkPtr->displayProc = CharDisplayProc;
    chunkPtr->undisplayProc = CharUndisplayProc;
    chunkPtr->measureProc = CharMeasureProc;
    chunkPtr->bboxProc = CharBboxProc;
    chunkPtr->numChars = charsThatFit;
    chunkPtr->minAscent = fm.ascent + chunkPtr->stylePtr->sValuePtr->offset;
    chunkPtr->minDescent = fm.descent - chunkPtr->stylePtr->sValuePtr->offset;
    chunkPtr->minHeight = 0;
    chunkPtr->width = nextX - chunkPtr->x;
    chunkPtr->breakIndex = -1;
    ciPtr = (CharInfo *) ckalloc((unsigned)
	    (sizeof(CharInfo) - 3 + charsThatFit));
    chunkPtr->clientData = (ClientData) ciPtr;
    ciPtr->numChars = charsThatFit;
    strncpy(ciPtr->chars, p, (size_t) charsThatFit);
    if (p[charsThatFit-1] == '\n') {
	ciPtr->numChars--;
    }

    /*
     * Compute a break location.  If we're in word wrap mode, a
     * break can occur after any space character, or at the end of
     * the chunk if the next segment (ignoring those with zero size)
     * is not a character segment.
     */

    if (wrapMode != tkTextWordUid) {
	chunkPtr->breakIndex = chunkPtr->numChars;
    } else {
	for (count = charsThatFit, p += charsThatFit-1; count > 0;
		count--, p--) {
	    if (isspace(UCHAR(*p))) {
		chunkPtr->breakIndex = count;
		break;
	    }
	}
	if ((charsThatFit+offset) == segPtr->size) {
	    for (nextPtr = segPtr->nextPtr; nextPtr != NULL;
		    nextPtr = nextPtr->nextPtr) {
		if (nextPtr->size != 0) {
		    if (nextPtr->typePtr != &tkTextCharType) {
			chunkPtr->breakIndex = chunkPtr->numChars;
		    }
		    break;
		}
	    }
	}
    }
    return 1;







|
















|





|
|


|



|
|






|

















|

|

|
|
>
|
|
>

|
|







|

|





|

|
















|






|

|
|
|
|









|
|

|






|




|







4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
/*
 *--------------------------------------------------------------
 *
 * TkTextCharLayoutProc --
 *
 *	This procedure is the "layoutProc" for character segments.
 *
n * Results:
 *	If there is something to display for the chunk then a
 *	non-zero value is returned and the fields of chunkPtr
 *	will be filled in (see the declaration of TkTextDispChunk
 *	in tkText.h for details).  If zero is returned it means
 *	that no characters from this chunk fit in the window.
 *	If -1 is returned it means that this segment just doesn't
 *	need to be displayed (never happens for text).
 *
 * Side effects:
 *	Memory is allocated to hold additional information about
 *	the chunk.
 *
 *--------------------------------------------------------------
 */

int
TkTextCharLayoutProc(textPtr, indexPtr, segPtr, byteOffset, maxX, maxBytes,
	noCharsYet, wrapMode, chunkPtr)
    TkText *textPtr;		/* Text widget being layed out. */
    TkTextIndex *indexPtr;	/* Index of first character to lay out
				 * (corresponds to segPtr and offset). */
    TkTextSegment *segPtr;	/* Segment being layed out. */
    int byteOffset;		/* Byte offset within segment of first
				 * character to consider. */
    int maxX;			/* Chunk must not occupy pixels at this
				 * position or higher. */
    int maxBytes;		/* Chunk must not include more than this
				 * many characters. */
    int noCharsYet;		/* Non-zero means no characters have been
				 * assigned to this display line yet. */
    Tk_Uid wrapMode;		/* How to handle line wrapping: char, 
				 * none, or text. */
    register TkTextDispChunk *chunkPtr;
				/* Structure to fill in with information
				 * about this chunk.  The x field has already
				 * been set by the caller. */
{
    Tk_Font tkfont;
    int nextX, bytesThatFit, count;
    CharInfo *ciPtr;
    char *p;
    TkTextSegment *nextPtr;
    Tk_FontMetrics fm;

    /*
     * Figure out how many characters will fit in the space we've got.
     * Include the next character, even though it won't fit completely,
     * if any of the following is true:
     *   (a) the chunk contains no characters and the display line contains
     *	     no characters yet (i.e. the line isn't wide enough to hold
     *	     even a single character).
     *   (b) at least one pixel of the character is visible, we haven't
     *	     already exceeded the character limit, and the next character
     *	     is a white space character.
     */

    p = segPtr->body.chars + byteOffset;
    tkfont = chunkPtr->stylePtr->sValuePtr->tkfont;
    bytesThatFit = MeasureChars(tkfont, p, maxBytes, chunkPtr->x, maxX, 0,
	    &nextX);
    if (bytesThatFit < maxBytes) {
	if ((bytesThatFit == 0) && noCharsYet) {
	    Tcl_UniChar ch;
	    
	    bytesThatFit = MeasureChars(tkfont, p, Tcl_UtfToUniChar(p, &ch),
		    chunkPtr->x, -1, 0, &nextX);
	}
	if ((nextX < maxX) && ((p[bytesThatFit] == ' ')
		|| (p[bytesThatFit] == '\t'))) {
	    /*
	     * Space characters are funny, in that they are considered
	     * to fit if there is at least one pixel of space left on the
	     * line.  Just give the space character whatever space is left.
	     */

	    nextX = maxX;
	    bytesThatFit++;
	}
	if (p[bytesThatFit] == '\n') {
	    /*
	     * A newline character takes up no space, so if the previous
	     * character fits then so does the newline.
	     */

	    bytesThatFit++;
	}
	if (bytesThatFit == 0) {
	    return 0;
	}
    }
	
    Tk_GetFontMetrics(tkfont, &fm);

    /*
     * Fill in the chunk structure and allocate and initialize a
     * CharInfo structure.  If the last character is a newline
     * then don't bother to display it.
     */

    chunkPtr->displayProc = CharDisplayProc;
    chunkPtr->undisplayProc = CharUndisplayProc;
    chunkPtr->measureProc = CharMeasureProc;
    chunkPtr->bboxProc = CharBboxProc;
    chunkPtr->numBytes = bytesThatFit;
    chunkPtr->minAscent = fm.ascent + chunkPtr->stylePtr->sValuePtr->offset;
    chunkPtr->minDescent = fm.descent - chunkPtr->stylePtr->sValuePtr->offset;
    chunkPtr->minHeight = 0;
    chunkPtr->width = nextX - chunkPtr->x;
    chunkPtr->breakIndex = -1;
    ciPtr = (CharInfo *) ckalloc((unsigned)
	    (sizeof(CharInfo) - 3 + bytesThatFit));
    chunkPtr->clientData = (ClientData) ciPtr;
    ciPtr->numBytes = bytesThatFit;
    strncpy(ciPtr->chars, p, (size_t) bytesThatFit);
    if (p[bytesThatFit - 1] == '\n') {
	ciPtr->numBytes--;
    }

    /*
     * Compute a break location.  If we're in word wrap mode, a
     * break can occur after any space character, or at the end of
     * the chunk if the next segment (ignoring those with zero size)
     * is not a character segment.
     */

    if (wrapMode != Tk_GetUid("word")) {
	chunkPtr->breakIndex = chunkPtr->numBytes;
    } else {
	for (count = bytesThatFit, p += bytesThatFit - 1; count > 0;
		count--, p--) {
	    if (isspace(UCHAR(*p))) {
		chunkPtr->breakIndex = count;
		break;
	    }
	}
	if ((bytesThatFit + byteOffset) == segPtr->size) {
	    for (nextPtr = segPtr->nextPtr; nextPtr != NULL;
		    nextPtr = nextPtr->nextPtr) {
		if (nextPtr->size != 0) {
		    if (nextPtr->typePtr != &tkTextCharType) {
			chunkPtr->breakIndex = chunkPtr->numBytes;
		    }
		    break;
		}
	    }
	}
    }
    return 1;
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
					 * chunk. */
    int screenY;			/* Y-coordinate in text window that
					 * corresponds to y. */
{
    CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData;
    TextStyle *stylePtr;
    StyleValues *sValuePtr;
    int offsetChars, offsetX;

    if ((x + chunkPtr->width) <= 0) {
	/*
	 * The chunk is off-screen.
	 */

	return;







|







4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
					 * chunk. */
    int screenY;			/* Y-coordinate in text window that
					 * corresponds to y. */
{
    CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData;
    TextStyle *stylePtr;
    StyleValues *sValuePtr;
    int offsetBytes, offsetX;

    if ((x + chunkPtr->width) <= 0) {
	/*
	 * The chunk is off-screen.
	 */

	return;
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
     * over the characters that aren't in the visible part of the
     * window.  This is essential if x is very negative (such as
     * less than 32K);  otherwise overflow problems will occur
     * in servers that use 16-bit arithmetic, like X.
     */

    offsetX = x;
    offsetChars = 0;
    if (x < 0) {
	offsetChars = MeasureChars(sValuePtr->tkfont, ciPtr->chars,
	    ciPtr->numChars, x, 0, x - chunkPtr->x, &offsetX);
    }

    /*
     * Draw the text, underline, and overstrike for this chunk.
     */

    if (ciPtr->numChars > offsetChars) {
	int numChars = ciPtr->numChars - offsetChars;
	char *string = ciPtr->chars + offsetChars;

	if ((numChars > 0) && (string[numChars - 1] == '\t')) {
	    numChars--;
	}
	Tk_DrawChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont, string,
		numChars, offsetX, y + baseline - sValuePtr->offset);
	if (sValuePtr->underline) {
	    Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont,
		    ciPtr->chars + offsetChars, offsetX,
		    y + baseline - sValuePtr->offset,
		    0, numChars);

	}
	if (sValuePtr->overstrike) {
	    Tk_FontMetrics fm;
	    
	    Tk_GetFontMetrics(sValuePtr->tkfont, &fm);
	    Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont,
		    ciPtr->chars + offsetChars, offsetX,
		    y + baseline - sValuePtr->offset
			    - fm.descent - (fm.ascent * 3) / 10,
		    0, numChars);
	}
    }
}

/*
 *--------------------------------------------------------------
 *







|

|
|






|
|
|

|
|


|


|
|
<







|


|







4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449

4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
     * over the characters that aren't in the visible part of the
     * window.  This is essential if x is very negative (such as
     * less than 32K);  otherwise overflow problems will occur
     * in servers that use 16-bit arithmetic, like X.
     */

    offsetX = x;
    offsetBytes = 0;
    if (x < 0) {
	offsetBytes = MeasureChars(sValuePtr->tkfont, ciPtr->chars,
	    ciPtr->numBytes, x, 0, x - chunkPtr->x, &offsetX);
    }

    /*
     * Draw the text, underline, and overstrike for this chunk.
     */

    if (ciPtr->numBytes > offsetBytes) {
	int numBytes = ciPtr->numBytes - offsetBytes;
	char *string = ciPtr->chars + offsetBytes;

	if ((numBytes > 0) && (string[numBytes - 1] == '\t')) {
	    numBytes--;
	}
	Tk_DrawChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont, string,
		numBytes, offsetX, y + baseline - sValuePtr->offset);
	if (sValuePtr->underline) {
	    Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont,
		    ciPtr->chars + offsetBytes, offsetX,
		    y + baseline - sValuePtr->offset, 0, numBytes);


	}
	if (sValuePtr->overstrike) {
	    Tk_FontMetrics fm;
	    
	    Tk_GetFontMetrics(sValuePtr->tkfont, &fm);
	    Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont,
		    ciPtr->chars + offsetBytes, offsetX,
		    y + baseline - sValuePtr->offset
			    - fm.descent - (fm.ascent * 3) / 10,
		    0, numBytes);
	}
    }
}

/*
 *--------------------------------------------------------------
 *
4503
4504
4505
4506
4507
4508
4509
4510

4511
4512
4513
4514
4515
4516
4517
    int x;				/* X-coordinate, in same coordinate
					 * system as chunkPtr->x. */
{
    CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData;
    int endX;

    return MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, ciPtr->chars,
	    chunkPtr->numChars-1, chunkPtr->x, x, 0, &endX);

}

/*
 *--------------------------------------------------------------
 *
 * CharBboxProc --
 *







|
>







4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
    int x;				/* X-coordinate, in same coordinate
					 * system as chunkPtr->x. */
{
    CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData;
    int endX;

    return MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, ciPtr->chars,
	    chunkPtr->numBytes - 1, chunkPtr->x, x, 0, &endX);
						/* CHAR OFFSET */
}

/*
 *--------------------------------------------------------------
 *
 * CharBboxProc --
 *
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static void
CharBboxProc(chunkPtr, index, y, lineHeight, baseline, xPtr, yPtr,
	widthPtr, heightPtr)
    TkTextDispChunk *chunkPtr;		/* Chunk containing desired char. */
    int index;				/* Index of desired character within
					 * the chunk. */
    int y;				/* Topmost pixel in area allocated
					 * for this line. */
    int lineHeight;			/* Height of line, in pixels. */
    int baseline;			/* Location of line's baseline, in
					 * pixels measured down from y. */
    int *xPtr, *yPtr;			/* Gets filled in with coords of
					 * character's upper-left pixel. 
					 * X-coord is in same coordinate
					 * system as chunkPtr->x. */
    int *widthPtr;			/* Gets filled in with width of
					 * character, in pixels. */
    int *heightPtr;			/* Gets filled in with height of
					 * character, in pixels. */
{
    CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData;
    int maxX;

    maxX = chunkPtr->width + chunkPtr->x;
    MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, ciPtr->chars, index,
	    chunkPtr->x, 1000000, 0, xPtr);

    if (index == ciPtr->numChars) {
	/*
	 * This situation only happens if the last character in a line
	 * is a space character, in which case it absorbs all of the
	 * extra space in the line (see TkTextCharLayoutProc).
	 */

	*widthPtr = maxX - *xPtr;
    } else if ((ciPtr->chars[index] == '\t')
	    && (index == (ciPtr->numChars-1))) {
	/*
	 * The desired character is a tab character that terminates a
	 * chunk;  give it all the space left in the chunk.
	 */

	*widthPtr = maxX - *xPtr;
    } else {
	MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, 
		ciPtr->chars + index, 1, *xPtr, 1000000, 0, widthPtr);
	if (*widthPtr > maxX) {
	    *widthPtr = maxX - *xPtr;
	} else {
	    *widthPtr -= *xPtr;
	}
    }
    *yPtr = y + baseline - chunkPtr->minAscent;







|


|
|


















|
|

|







|
|








|







4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static void
CharBboxProc(chunkPtr, byteIndex, y, lineHeight, baseline, xPtr, yPtr,
	widthPtr, heightPtr)
    TkTextDispChunk *chunkPtr;		/* Chunk containing desired char. */
    int byteIndex;				/* Byte offset of desired character
					 * within the chunk. */
    int y;				/* Topmost pixel in area allocated
					 * for this line. */
    int lineHeight;			/* Height of line, in pixels. */
    int baseline;			/* Location of line's baseline, in
					 * pixels measured down from y. */
    int *xPtr, *yPtr;			/* Gets filled in with coords of
					 * character's upper-left pixel. 
					 * X-coord is in same coordinate
					 * system as chunkPtr->x. */
    int *widthPtr;			/* Gets filled in with width of
					 * character, in pixels. */
    int *heightPtr;			/* Gets filled in with height of
					 * character, in pixels. */
{
    CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData;
    int maxX;

    maxX = chunkPtr->width + chunkPtr->x;
    MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, ciPtr->chars,
	    byteIndex, chunkPtr->x, -1, 0, xPtr);

    if (byteIndex == ciPtr->numBytes) {
	/*
	 * This situation only happens if the last character in a line
	 * is a space character, in which case it absorbs all of the
	 * extra space in the line (see TkTextCharLayoutProc).
	 */

	*widthPtr = maxX - *xPtr;
    } else if ((ciPtr->chars[byteIndex] == '\t')
	    && (byteIndex == ciPtr->numBytes - 1)) {
	/*
	 * The desired character is a tab character that terminates a
	 * chunk;  give it all the space left in the chunk.
	 */

	*widthPtr = maxX - *xPtr;
    } else {
	MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, 
		ciPtr->chars + byteIndex, 1, *xPtr, -1, 0, widthPtr);
	if (*widthPtr > maxX) {
	    *widthPtr = maxX - *xPtr;
	} else {
	    *widthPtr -= *xPtr;
	}
    }
    *yPtr = y + baseline - chunkPtr->minAscent;
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
    decimal = gotDigit = 0;
    for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL;
	    chunkPtr2 = chunkPtr2->nextPtr) {
	if (chunkPtr2->displayProc != CharDisplayProc) {
	    continue;
	}
	ciPtr = (CharInfo *) chunkPtr2->clientData;
	for (p = ciPtr->chars, i = 0; i < ciPtr->numChars; p++, i++) {
	    if (isdigit(UCHAR(*p))) {
		gotDigit = 1;
	    } else if ((*p == '.') || (*p == ',')) {
		decimal = p-ciPtr->chars;
		decimalChunkPtr = chunkPtr2;
	    } else if (gotDigit) {
		if (decimalChunkPtr == NULL) {
		    decimal = p-ciPtr->chars;
		    decimalChunkPtr = chunkPtr2;
		}
		goto endOfNumber;
	    }
	}
    }
    endOfNumber:
    if (decimalChunkPtr != NULL) {
	int curX;

	ciPtr = (CharInfo *) decimalChunkPtr->clientData;
	MeasureChars(decimalChunkPtr->stylePtr->sValuePtr->tkfont,
		ciPtr->chars, decimal, decimalChunkPtr->x, 1000000, 0, &curX);
	desired = tabX - (curX - x);
	goto update;
    } else {
	/*
	 * There wasn't a decimal point.  Right justify the text.
	 */
    







|




















|







4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
    decimal = gotDigit = 0;
    for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL;
	    chunkPtr2 = chunkPtr2->nextPtr) {
	if (chunkPtr2->displayProc != CharDisplayProc) {
	    continue;
	}
	ciPtr = (CharInfo *) chunkPtr2->clientData;
	for (p = ciPtr->chars, i = 0; i < ciPtr->numBytes; p++, i++) {
	    if (isdigit(UCHAR(*p))) {
		gotDigit = 1;
	    } else if ((*p == '.') || (*p == ',')) {
		decimal = p-ciPtr->chars;
		decimalChunkPtr = chunkPtr2;
	    } else if (gotDigit) {
		if (decimalChunkPtr == NULL) {
		    decimal = p-ciPtr->chars;
		    decimalChunkPtr = chunkPtr2;
		}
		goto endOfNumber;
	    }
	}
    }
    endOfNumber:
    if (decimalChunkPtr != NULL) {
	int curX;

	ciPtr = (CharInfo *) decimalChunkPtr->clientData;
	MeasureChars(decimalChunkPtr->stylePtr->sValuePtr->tkfont,
		ciPtr->chars, decimal, decimalChunkPtr->x, -1, 0, &curX);
	desired = tabX - (curX - x);
	goto update;
    } else {
	/*
	 * There wasn't a decimal point.  Right justify the text.
	 */
    
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
     * at the desired location, then expand the chunk containing the
     * tab.  Be sure that the tab occupies at least the width of a
     * space character.
     */

    update:
    delta = desired - x;
    MeasureChars(textPtr->tkfont, " ", 1, 0, INT_MAX, 0, &spaceWidth);
    if (delta < spaceWidth) {
	delta = spaceWidth;
    }
    for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL;
	    chunkPtr2 = chunkPtr2->nextPtr) {
	chunkPtr2->x += delta;
    }







|







4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
     * at the desired location, then expand the chunk containing the
     * tab.  Be sure that the tab occupies at least the width of a
     * space character.
     */

    update:
    delta = desired - x;
    MeasureChars(textPtr->tkfont, " ", 1, 0, -1, 0, &spaceWidth);
    if (delta < spaceWidth) {
	delta = spaceWidth;
    }
    for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL;
	    chunkPtr2 = chunkPtr2->nextPtr) {
	chunkPtr2->x += delta;
    }
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
    if (tabX > x) {
	result = tabX - x;
    } else {
	result = 0;
    }

    done:
    MeasureChars(textPtr->tkfont, " ", 1, 0, INT_MAX, 0, &spaceWidth);
    if (result < spaceWidth) {
	result = spaceWidth;
    }
    return result;
}

/*







|







4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
    if (tabX > x) {
	result = tabX - x;
    } else {
	result = 0;
    }

    done:
    MeasureChars(textPtr->tkfont, " ", 1, 0, -1, 0, &spaceWidth);
    if (result < spaceWidth) {
	result = spaceWidth;
    }
    return result;
}

/*
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
 *	to the next tab stop, unless the TK_IGNORE_TABS flag is specified.
 *
 *	If a newline is encountered in the string, the line will be
 *	broken at that point, unless the TK_NEWSLINES_NOT_SPECIAL flag
 *	is specified.  
 *
 * Results:
 *	The return value is the number of characters from source
 *	that fit in the span given by startX and maxX.  *nextXPtr
 *	is filled in with the x-coordinate at which the first
 *	character that didn't fit would be drawn, if it were to
 *	be drawn.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
MeasureChars(tkfont, source, maxChars, startX, maxX, tabOrigin, nextXPtr)
    Tk_Font tkfont;		/* Font in which to draw characters. */
    CONST char *source;		/* Characters to be displayed.  Need not
				 * be NULL-terminated. */
    int maxChars;		/* Maximum # of characters to consider from
				 * source. */
    int startX;			/* X-position at which first character will
				 * be drawn. */
    int maxX;			/* Don't consider any character that would
				 * cross this x-position. */
    int tabOrigin;		/* X-location that serves as "origin" for
				 * tab stops. */
    int *nextXPtr;		/* Return x-position of terminating
				 * character here. */
{
    int curX, width, ch;
    CONST char *special, *end, *start;

    ch = 0;			/* lint. */
    curX = startX;
    special = source;
    end = source + maxChars;
    for (start = source; start < end; ) {
	if (start >= special) {
	    /*
	     * Find the next special character in the string.
	     */

	    for (special = start; special < end; special++) {
		ch = *special;
		if ((ch == '\t') || (ch == '\n')) {
		    break;
		}
	    }
	}

	/*
	 * Special points at the next special character (or the end of the
	 * string).  Process characters between start and special.
	 */

	if (curX >= maxX) {
	    break;
	}
	start += Tk_MeasureChars(tkfont, start, special - start, maxX - curX,
		0, &width);
	curX += width;
	if (start < special) {
	    /*







|












|



|
















|



















|







4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
 *	to the next tab stop, unless the TK_IGNORE_TABS flag is specified.
 *
 *	If a newline is encountered in the string, the line will be
 *	broken at that point, unless the TK_NEWSLINES_NOT_SPECIAL flag
 *	is specified.  
 *
 * Results:
 *	The return value is the number of bytes from source
 *	that fit in the span given by startX and maxX.  *nextXPtr
 *	is filled in with the x-coordinate at which the first
 *	character that didn't fit would be drawn, if it were to
 *	be drawn.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

static int
MeasureChars(tkfont, source, maxBytes, startX, maxX, tabOrigin, nextXPtr)
    Tk_Font tkfont;		/* Font in which to draw characters. */
    CONST char *source;		/* Characters to be displayed.  Need not
				 * be NULL-terminated. */
    int maxBytes;		/* Maximum # of bytes to consider from
				 * source. */
    int startX;			/* X-position at which first character will
				 * be drawn. */
    int maxX;			/* Don't consider any character that would
				 * cross this x-position. */
    int tabOrigin;		/* X-location that serves as "origin" for
				 * tab stops. */
    int *nextXPtr;		/* Return x-position of terminating
				 * character here. */
{
    int curX, width, ch;
    CONST char *special, *end, *start;

    ch = 0;			/* lint. */
    curX = startX;
    special = source;
    end = source + maxBytes;
    for (start = source; start < end; ) {
	if (start >= special) {
	    /*
	     * Find the next special character in the string.
	     */

	    for (special = start; special < end; special++) {
		ch = *special;
		if ((ch == '\t') || (ch == '\n')) {
		    break;
		}
	    }
	}

	/*
	 * Special points at the next special character (or the end of the
	 * string).  Process characters between start and special.
	 */

	if ((maxX >= 0) && (curX >= maxX)) {
	    break;
	}
	start += Tk_MeasureChars(tkfont, start, special - start, maxX - curX,
		0, &width);
	curX += width;
	if (start < special) {
	    /*

Changes to generic/tkTextImage.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkImage.c --
 *
 *	This file contains code that allows images to be
 *	nested inside text widgets.  It also implements the "image"
 *	widget command for texts.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkTextImage.c 1.7 97/08/25 15:47:27
 */

#include "tk.h"
#include "tkText.h"
#include "tkPort.h"

/*







|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkImage.c --
 *
 *	This file contains code that allows images to be
 *	nested inside text widgets.  It also implements the "image"
 *	widget command for texts.
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkTextImage.c,v 1.1.4.3 1999/02/16 11:39:33 lfb Exp $
 */

#include "tk.h"
#include "tkText.h"
#include "tkPort.h"

/*
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
	/*
	 * Don't allow insertions on the last (dummy) line of the text.
	 */
    
	lineIndex = TkBTreeLineIndex(index.linePtr);
	if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
	    lineIndex--;
	    TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, &index);
	}

	/*
	 * Create the new image segment and initialize it.
	 */

	eiPtr = (TkTextSegment *) ckalloc(EI_SEG_SIZE);







|







217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
	/*
	 * Don't allow insertions on the last (dummy) line of the text.
	 */
    
	lineIndex = TkBTreeLineIndex(index.linePtr);
	if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
	    lineIndex--;
	    TkTextMakeByteIndex(textPtr->tree, lineIndex, 1000000, &index);
	}

	/*
	 * Create the new image segment and initialize it.
	 */

	eiPtr = (TkTextSegment *) ckalloc(EI_SEG_SIZE);
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
 * EmbImageConfigure --
 *
 *	This procedure is called to handle configuration options
 *	for an embedded image, using an argc/argv list.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message..
 *
 * Side effects:
 *	Configuration information for the embedded image changes,
 *	such as alignment, or name of the image.
 *
 *--------------------------------------------------------------
 */







|







284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
 * EmbImageConfigure --
 *
 *	This procedure is called to handle configuration options
 *	for an embedded image, using an argc/argv list.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message..
 *
 * Side effects:
 *	Configuration information for the embedded image changes,
 *	such as alignment, or name of the image.
 *
 *--------------------------------------------------------------
 */
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
	}
    }

    Tcl_DStringInit(&newName);
    Tcl_DStringAppend(&newName,name, -1);

    if (conflict) {
    	char buf[10];
	sprintf(buf, "#%d",count+1);
	Tcl_DStringAppend(&newName,buf, -1);
    }
    name = Tcl_DStringValue(&newName);
    hPtr = Tcl_CreateHashEntry(&textPtr->imageTable, name, &new);
    Tcl_SetHashValue(hPtr, eiPtr);
    Tcl_AppendResult(textPtr->interp, name , (char *) NULL);







|







380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
	}
    }

    Tcl_DStringInit(&newName);
    Tcl_DStringAppend(&newName,name, -1);

    if (conflict) {
    	char buf[4 + TCL_INTEGER_SPACE];
	sprintf(buf, "#%d",count+1);
	Tcl_DStringAppend(&newName,buf, -1);
    }
    name = Tcl_DStringValue(&newName);
    hPtr = Tcl_CreateHashEntry(&textPtr->imageTable, name, &new);
    Tcl_SetHashValue(hPtr, eiPtr);
    Tcl_AppendResult(textPtr->interp, name , (char *) NULL);
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
				 * indexPtr (always 0). */
    int maxX;			/* Chunk must not occupy pixels at this
				 * position or higher. */
    int maxChars;		/* Chunk must not include more than this
				 * many characters. */
    int noCharsYet;		/* Non-zero means no characters have been
				 * assigned to this line yet. */
    Tk_Uid wrapMode;		/* Wrap mode to use for line: tkTextCharUid,
				 * tkTextNoneUid, or tkTextWordUid. */
    register TkTextDispChunk *chunkPtr;
				/* Structure to fill in with information
				 * about this chunk.  The x field has already
				 * been set by the caller. */
{
    int width, height;








|
|







600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
				 * indexPtr (always 0). */
    int maxX;			/* Chunk must not occupy pixels at this
				 * position or higher. */
    int maxChars;		/* Chunk must not include more than this
				 * many characters. */
    int noCharsYet;		/* Non-zero means no characters have been
				 * assigned to this line yet. */
    Tk_Uid wrapMode;		/* Wrap mode to use for line: char, 
				 * text, or word. */
    register TkTextDispChunk *chunkPtr;
				/* Structure to fill in with information
				 * about this chunk.  The x field has already
				 * been set by the caller. */
{
    int width, height;

626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
	height = 0;
    } else {
	Tk_SizeOfImage(eiPtr->body.ei.image, &width, &height);
	width += 2*eiPtr->body.ei.padX;
	height += 2*eiPtr->body.ei.padY;
    }
    if ((width > (maxX - chunkPtr->x))
	    && !noCharsYet && (textPtr->wrapMode != tkTextNoneUid)) {
	return 0;
    }

    /*
     * Fill in the chunk structure.
     */

    chunkPtr->displayProc = EmbImageDisplayProc;
    chunkPtr->undisplayProc = (Tk_ChunkUndisplayProc *) NULL;
    chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL;
    chunkPtr->bboxProc = EmbImageBboxProc;
    chunkPtr->numChars = 1;
    if (eiPtr->body.ei.align == ALIGN_BASELINE) {
	chunkPtr->minAscent = height - eiPtr->body.ei.padY;
	chunkPtr->minDescent = eiPtr->body.ei.padY;
	chunkPtr->minHeight = 0;
    } else {
	chunkPtr->minAscent = 0;
	chunkPtr->minDescent = 0;







|











|







626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
	height = 0;
    } else {
	Tk_SizeOfImage(eiPtr->body.ei.image, &width, &height);
	width += 2*eiPtr->body.ei.padX;
	height += 2*eiPtr->body.ei.padY;
    }
    if ((width > (maxX - chunkPtr->x))
	    && !noCharsYet && (textPtr->wrapMode != Tk_GetUid("none"))) {
	return 0;
    }

    /*
     * Fill in the chunk structure.
     */

    chunkPtr->displayProc = EmbImageDisplayProc;
    chunkPtr->undisplayProc = (Tk_ChunkUndisplayProc *) NULL;
    chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL;
    chunkPtr->bboxProc = EmbImageBboxProc;
    chunkPtr->numBytes = 1;
    if (eiPtr->body.ei.align == ALIGN_BASELINE) {
	chunkPtr->minAscent = height - eiPtr->body.ei.padY;
	chunkPtr->minDescent = eiPtr->body.ei.padY;
	chunkPtr->minHeight = 0;
    } else {
	chunkPtr->minAscent = 0;
	chunkPtr->minDescent = 0;
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
    hPtr = Tcl_FindHashEntry(&textPtr->imageTable, name);
    if (hPtr == NULL) {
	return 0;
    }
    eiPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
    indexPtr->tree = textPtr->tree;
    indexPtr->linePtr = eiPtr->body.ei.linePtr;
    indexPtr->charIndex = TkTextSegToOffset(eiPtr, indexPtr->linePtr);
    return 1;
}

/*
 *--------------------------------------------------------------
 *
 * EmbImageProc --







|







853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
    hPtr = Tcl_FindHashEntry(&textPtr->imageTable, name);
    if (hPtr == NULL) {
	return 0;
    }
    eiPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
    indexPtr->tree = textPtr->tree;
    indexPtr->linePtr = eiPtr->body.ei.linePtr;
    indexPtr->byteIndex = TkTextSegToOffset(eiPtr, indexPtr->linePtr);
    return 1;
}

/*
 *--------------------------------------------------------------
 *
 * EmbImageProc --
889
890
891
892
893
894
895
896
897
898

{
    TkTextSegment *eiPtr = (TkTextSegment *) clientData;
    TkTextIndex index;

    index.tree = eiPtr->body.ei.textPtr->tree;
    index.linePtr = eiPtr->body.ei.linePtr;
    index.charIndex = TkTextSegToOffset(eiPtr, eiPtr->body.ei.linePtr);
    TkTextChanged(eiPtr->body.ei.textPtr, &index, &index);
}







|


889
890
891
892
893
894
895
896
897
898

{
    TkTextSegment *eiPtr = (TkTextSegment *) clientData;
    TkTextIndex index;

    index.tree = eiPtr->body.ei.textPtr->tree;
    index.linePtr = eiPtr->body.ei.linePtr;
    index.byteIndex = TkTextSegToOffset(eiPtr, eiPtr->body.ei.linePtr);
    TkTextChanged(eiPtr->body.ei.textPtr, &index, &index);
}

Changes to generic/tkTextIndex.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkTextIndex.c --
 *
 *	This module provides procedures that manipulate indices for
 *	text widgets.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkTextIndex.c 1.15 97/06/17 17:49:24
 */

#include "default.h"
#include "tkPort.h"
#include "tkInt.h"
#include "tkText.h"








|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkTextIndex.c --
 *
 *	This module provides procedures that manipulate indices for
 *	text widgets.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkTextIndex.c,v 1.1.4.4 1999/03/29 23:50:33 redman Exp $
 */

#include "default.h"
#include "tkPort.h"
#include "tkInt.h"
#include "tkText.h"

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

static char *		ForwBack _ANSI_ARGS_((char *string,
			    TkTextIndex *indexPtr));
static char *		StartEnd _ANSI_ARGS_(( char *string,
			    TkTextIndex *indexPtr));

/*
 *--------------------------------------------------------------
 *
 * TkTextMakeIndex --
 *



























































































 *	Given a line index and a character index, look things up
 *	in the B-tree and fill in a TkTextIndex structure.
 *
 * Results:
 *	The structure at *indexPtr is filled in with information
 *	about the character at lineIndex and charIndex (or the
 *	closest existing character, if the specified one doesn't
 *	exist), and indexPtr is returned as result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

TkTextIndex *
TkTextMakeIndex(tree, lineIndex, charIndex, indexPtr)
    TkTextBTree tree;		/* Tree that lineIndex and charIndex refer
				 * to. */
    int lineIndex;		/* Index of desired line (0 means first
				 * line of text). */
    int charIndex;		/* Index of desired character. */
    TkTextIndex *indexPtr;	/* Structure to fill in. */
{
    register TkTextSegment *segPtr;

    int index;


    indexPtr->tree = tree;
    if (lineIndex < 0) {
	lineIndex = 0;
	charIndex = 0;
    }
    if (charIndex < 0) {
	charIndex = 0;
    }
    indexPtr->linePtr = TkBTreeFindLine(tree, lineIndex);
    if (indexPtr->linePtr == NULL) {
	indexPtr->linePtr = TkBTreeFindLine(tree, TkBTreeNumLines(tree));
	charIndex = 0;
    }

    /*
     * Verify that the index is within the range of the line.
     * If not, just use the index of the last character in the line.
     */


    for (index = 0, segPtr = indexPtr->linePtr->segPtr; ;
	    segPtr = segPtr->nextPtr) {
	if (segPtr == NULL) {






	    indexPtr->charIndex = index-1;
	    break;
	}














	index += segPtr->size;


	if (index > charIndex) {
	    indexPtr->charIndex = charIndex;
	    break;



	}
    }
    return indexPtr;
}

/*
 *--------------------------------------------------------------
 *
 * TkTextIndexToSeg --
 *
 *	Given an index, this procedure returns the segment and
 *	offset within segment for the index.
 *
 * Results:
 *	The return value is a pointer to the segment referred to
 *	by indexPtr;  this will always be a segment with non-zero
 *	size.  The variable at *offsetPtr is set to hold the
 *	integer offset within the segment of the character
 *	given by indexPtr.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

TkTextSegment *
TkTextIndexToSeg(indexPtr, offsetPtr)
    TkTextIndex *indexPtr;		/* Text index. */
    int *offsetPtr;			/* Where to store offset within
					 * segment, or NULL if offset isn't
					 * wanted. */
{
    register TkTextSegment *segPtr;
    int offset;

    for (offset = indexPtr->charIndex, segPtr = indexPtr->linePtr->segPtr;
	    offset >= segPtr->size;
	    offset -= segPtr->size, segPtr = segPtr->nextPtr) {
	/* Empty loop body. */
    }
    if (offsetPtr != NULL) {
	*offsetPtr = offset;
    }
    return segPtr;
}

/*
 *--------------------------------------------------------------
 *
 * TkTextSegToOffset --
 *
 *	Given a segment pointer and the line containing it, this
 *	procedure returns the offset of the segment within its
 *	line.
 *
 * Results:
 *	The return value is the offset (within its line) of the
 *	first character in segPtr.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

int
TkTextSegToOffset(segPtr, linePtr)
    TkTextSegment *segPtr;		/* Segment whose offset is desired. */
    TkTextLine *linePtr;		/* Line containing segPtr. */
{
    TkTextSegment *segPtr2;
    int offset;

    offset = 0;
    for (segPtr2 = linePtr->segPtr; segPtr2 != segPtr;
	    segPtr2 = segPtr2->nextPtr) {
	offset += segPtr2->size;
    }
    return offset;
}

/*
 *----------------------------------------------------------------------
 *
 * TkTextGetIndex --
 *
 *	Given a string, return the line and character indices that
 *	it describes.
 *
 * Results:
 *	The return value is a standard Tcl return result.  If
 *	TCL_OK is returned, then everything went well and the index
 *	at *indexPtr is filled in;  otherwise TCL_ERROR is returned
 *	and an error message is left in interp->result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TkTextGetIndex(interp, textPtr, string, indexPtr)
    Tcl_Interp *interp;		/* Use this for error reporting. */
    TkText *textPtr;		/* Information about text widget. */
    char *string;		/* Textual description of position. */
    TkTextIndex *indexPtr;	/* Index structure to fill in. */
{
    register char *p;
    char *end, *endOfBase;
    Tcl_HashEntry *hPtr;
    TkTextTag *tagPtr;
    TkTextSearch search;
    TkTextIndex first, last;
    int wantLast, result;
    char c;








|

|

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


|
|
|
|




|



|








>
|
>




















>
|
<

>
>
>
>
>
>
|


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






|



|
|


|
|
|
|
<




|




|
|
|
<

|


|











|



|
|
<


|
|




|




|
|

|











|



|
<


|
|
|
|




|









<
|







30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181

182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232

233
234
235
236
237
238
239
240
241
242
243
244

245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266

267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299

300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319

320
321
322
323
324
325
326
327

static char *		ForwBack _ANSI_ARGS_((char *string,
			    TkTextIndex *indexPtr));
static char *		StartEnd _ANSI_ARGS_(( char *string,
			    TkTextIndex *indexPtr));

/*
 *---------------------------------------------------------------------------
 *
 * TkTextMakeByteIndex --
 *
 *	Given a line index and a byte index, look things up in the B-tree
 *	and fill in a TkTextIndex structure.
 *
 * Results:
 *	The structure at *indexPtr is filled in with information about the
 *	character at lineIndex and byteIndex (or the closest existing
 *	character, if the specified one doesn't exist), and indexPtr is
 *	returned as result.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

TkTextIndex *
TkTextMakeByteIndex(tree, lineIndex, byteIndex, indexPtr)
    TkTextBTree tree;		/* Tree that lineIndex and charIndex refer
				 * to. */
    int lineIndex;		/* Index of desired line (0 means first
				 * line of text). */
    int byteIndex;		/* Byte index of desired character. */
    TkTextIndex *indexPtr;	/* Structure to fill in. */
{
    TkTextSegment *segPtr;
    int index;
    char *p, *start;
    Tcl_UniChar ch;

    indexPtr->tree = tree;
    if (lineIndex < 0) {
	lineIndex = 0;
	byteIndex = 0;
    }
    if (byteIndex < 0) {
	byteIndex = 0;
    }
    indexPtr->linePtr = TkBTreeFindLine(tree, lineIndex);
    if (indexPtr->linePtr == NULL) {
	indexPtr->linePtr = TkBTreeFindLine(tree, TkBTreeNumLines(tree));
	byteIndex = 0;
    }
    if (byteIndex == 0) {
	indexPtr->byteIndex = byteIndex;
	return indexPtr;
    }

    /*
     * Verify that the index is within the range of the line and points
     * to a valid character boundary.  
     */

    index = 0;
    for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) {
	if (segPtr == NULL) {
	    /*
	     * Use the index of the last character in the line.  Since
	     * the last character on the line is guaranteed to be a '\n',
	     * we can back up a constant sizeof(char) bytes.
	     */
	     
	    indexPtr->byteIndex = index - sizeof(char);
	    break;
	}
	if (index + segPtr->size > byteIndex) {
	    indexPtr->byteIndex = byteIndex;
	    if ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType)) {
		/*
		 * Prevent UTF-8 character from being split up by ensuring
		 * that byteIndex falls on a character boundary.  If index
		 * falls in the middle of a UTF-8 character, it will be
		 * adjusted to the end of that UTF-8 character.
		 */

		start = segPtr->body.chars + (byteIndex - index);
		p = Tcl_UtfPrev(start, segPtr->body.chars);
		p += Tcl_UtfToUniChar(p, &ch);
		indexPtr->byteIndex += p - start;
	    }
	    break;
	}
	index += segPtr->size;
    }
    return indexPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkTextMakeCharIndex --
 *
 *	Given a line index and a character index, look things up in the
 *	B-tree and fill in a TkTextIndex structure.
 *
 * Results:
 *	The structure at *indexPtr is filled in with information about the
 *	character at lineIndex and charIndex (or the closest existing
 *	character, if the specified one doesn't exist), and indexPtr is
 *	returned as result.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

TkTextIndex *
TkTextMakeCharIndex(tree, lineIndex, charIndex, indexPtr)
    TkTextBTree tree;		/* Tree that lineIndex and charIndex refer
				 * to. */
    int lineIndex;		/* Index of desired line (0 means first
				 * line of text). */
    int charIndex;		/* Index of desired character. */
    TkTextIndex *indexPtr;	/* Structure to fill in. */
{
    register TkTextSegment *segPtr;
    char *p, *start, *end;
    int index, offset;
    Tcl_UniChar ch;

    indexPtr->tree = tree;
    if (lineIndex < 0) {
	lineIndex = 0;
	charIndex = 0;
    }
    if (charIndex < 0) {
	charIndex = 0;
    }
    indexPtr->linePtr = TkBTreeFindLine(tree, lineIndex);
    if (indexPtr->linePtr == NULL) {
	indexPtr->linePtr = TkBTreeFindLine(tree, TkBTreeNumLines(tree));
	charIndex = 0;
    }

    /*
     * Verify that the index is within the range of the line.
     * If not, just use the index of the last character in the line.
     */

    index = 0;
    for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) {

	if (segPtr == NULL) {
	    /*
	     * Use the index of the last character in the line.  Since
	     * the last character on the line is guaranteed to be a '\n',
	     * we can back up a constant sizeof(char) bytes.
	     */
	     
	    indexPtr->byteIndex = index - sizeof(char);
	    break;
	}
	if (segPtr->typePtr == &tkTextCharType) {
	    /*
	     * Turn character offset into a byte offset.
	     */

	    start = segPtr->body.chars;
	    end = start + segPtr->size;
	    for (p = start; p < end; p += offset) {
		if (charIndex == 0) {
		    indexPtr->byteIndex = index;
		    return indexPtr;
		}
		charIndex--;
		offset = Tcl_UtfToUniChar(p, &ch);
		index += offset;
	    }
	} else {
	    if (charIndex < segPtr->size) {
		indexPtr->byteIndex = index;
		break;
	    }
	    charIndex -= segPtr->size;
	    index += segPtr->size;
	}
    }
    return indexPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkTextIndexToSeg --
 *
 *	Given an index, this procedure returns the segment and offset
 *	within segment for the index.
 *
 * Results:
 *	The return value is a pointer to the segment referred to by
 *	indexPtr; this will always be a segment with non-zero size.  The
 *	variable at *offsetPtr is set to hold the integer offset within
 *	the segment of the character given by indexPtr.

 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

TkTextSegment *
TkTextIndexToSeg(indexPtr, offsetPtr)
    CONST TkTextIndex *indexPtr;/* Text index. */
    int *offsetPtr;		/* Where to store offset within segment, or
				 * NULL if offset isn't wanted. */

{
    TkTextSegment *segPtr;
    int offset;

    for (offset = indexPtr->byteIndex, segPtr = indexPtr->linePtr->segPtr;
	    offset >= segPtr->size;
	    offset -= segPtr->size, segPtr = segPtr->nextPtr) {
	/* Empty loop body. */
    }
    if (offsetPtr != NULL) {
	*offsetPtr = offset;
    }
    return segPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkTextSegToOffset --
 *
 *	Given a segment pointer and the line containing it, this procedure
 *	returns the offset of the segment within its line.

 *
 * Results:
 *	The return value is the offset (within its line) of the first
 *	character in segPtr.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TkTextSegToOffset(segPtr, linePtr)
    CONST TkTextSegment *segPtr;/* Segment whose offset is desired. */
    CONST TkTextLine *linePtr;	/* Line containing segPtr. */
{
    CONST TkTextSegment *segPtr2;
    int offset;

    offset = 0;
    for (segPtr2 = linePtr->segPtr; segPtr2 != segPtr;
	    segPtr2 = segPtr2->nextPtr) {
	offset += segPtr2->size;
    }
    return offset;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkTextGetIndex --
 *
 *	Given a string, return the index that is described.

 *
 * Results:
 *	The return value is a standard Tcl return result.  If TCL_OK is
 *	returned, then everything went well and the index at *indexPtr is
 *	filled in; otherwise TCL_ERROR is returned and an error message
 *	is left in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TkTextGetIndex(interp, textPtr, string, indexPtr)
    Tcl_Interp *interp;		/* Use this for error reporting. */
    TkText *textPtr;		/* Information about text widget. */
    char *string;		/* Textual description of position. */
    TkTextIndex *indexPtr;	/* Index structure to fill in. */
{

    char *p, *end, *endOfBase;
    Tcl_HashEntry *hPtr;
    TkTextTag *tagPtr;
    TkTextSearch search;
    TkTextIndex first, last;
    int wantLast, result;
    char c;

255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
	*p = 0;
	hPtr = Tcl_FindHashEntry(&textPtr->tagTable, string);
	*p = '.';
	if (hPtr == NULL) {
	    goto tryxy;
	}
	tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr);
	TkTextMakeIndex(textPtr->tree, 0, 0, &first);
	TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0,
		&last);
	TkBTreeStartSearch(&first, &last, tagPtr, &search);
	if (!TkBTreeCharTagged(&first, tagPtr) && !TkBTreeNextTag(&search)) {
	    Tcl_AppendResult(interp,
		    "text doesn't contain any characters tagged with \"",
		    Tcl_GetHashKey(&textPtr->tagTable, hPtr), "\"",
			    (char *) NULL);







|
|







368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
	*p = 0;
	hPtr = Tcl_FindHashEntry(&textPtr->tagTable, string);
	*p = '.';
	if (hPtr == NULL) {
	    goto tryxy;
	}
	tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr);
	TkTextMakeByteIndex(textPtr->tree, 0, 0, &first);
	TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0,
		&last);
	TkBTreeStartSearch(&first, &last, tagPtr, &search);
	if (!TkBTreeCharTagged(&first, tagPtr) && !TkBTreeNextTag(&search)) {
	    Tcl_AppendResult(interp,
		    "text doesn't contain any characters tagged with \"",
		    Tcl_GetHashKey(&textPtr->tagTable, hPtr), "\"",
			    (char *) NULL);
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
	} else {
	    charIndex = strtol(p, &end, 0);
	    if (end == p) {
		goto error;
	    }
	    endOfBase = end;
	}
	TkTextMakeIndex(textPtr->tree, lineIndex, charIndex, indexPtr);
	goto gotBase;
    }

    for (p = string; *p != 0; p++) {
	if (isspace(UCHAR(*p)) || (*p == '+') || (*p == '-')) {
	    break;
	}







|







433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
	} else {
	    charIndex = strtol(p, &end, 0);
	    if (end == p) {
		goto error;
	    }
	    endOfBase = end;
	}
	TkTextMakeCharIndex(textPtr->tree, lineIndex, charIndex, indexPtr);
	goto gotBase;
    }

    for (p = string; *p != 0; p++) {
	if (isspace(UCHAR(*p)) || (*p == '+') || (*p == '-')) {
	    break;
	}
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
    }
    if ((string[0] == 'e')
	    && (strncmp(string, "end", (size_t) (endOfBase-string)) == 0)) {
	/*
	 * Base position is end of text.
	 */

	TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
		0, indexPtr);
	goto gotBase;
    } else {
	/*
	 * See if the base position is the name of a mark.
	 */








|







462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
    }
    if ((string[0] == 'e')
	    && (strncmp(string, "end", (size_t) (endOfBase-string)) == 0)) {
	/*
	 * Base position is end of text.
	 */

	TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
		0, indexPtr);
	goto gotBase;
    } else {
	/*
	 * See if the base position is the name of a mark.
	 */

416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445





















446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
    error:
    Tcl_AppendResult(interp, "bad text index \"", string, "\"",
	    (char *) NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TkTextPrintIndex --
 *
 *	
 *	This procedure generates a string description of an index,
 *	suitable for reading in again later.
 *
 * Results:
 *	The characters pointed to by string are modified.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TkTextPrintIndex(indexPtr, string)
    TkTextIndex *indexPtr;	/* Pointer to index. */
    char *string;		/* Place to store the position.  Must have
				 * at least TK_POS_CHARS characters. */
{





















    sprintf(string, "%d.%d", TkBTreeLineIndex(indexPtr->linePtr) + 1,
	    indexPtr->charIndex);
}

/*
 *--------------------------------------------------------------
 *
 * TkTextIndexCmp --
 *
 *	Compare two indices to see which one is earlier in
 *	the text.
 *
 * Results:
 *	The return value is 0 if index1Ptr and index2Ptr refer
 *	to the same position in the file, -1 if index1Ptr refers
 *	to an earlier position than index2Ptr, and 1 otherwise.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

int
TkTextIndexCmp(index1Ptr, index2Ptr)
    TkTextIndex *index1Ptr;		/* First index. */
    TkTextIndex *index2Ptr;		/* Second index. */
{
    int line1, line2;

    if (index1Ptr->linePtr == index2Ptr->linePtr) {
	if (index1Ptr->charIndex < index2Ptr->charIndex) {
	    return -1;
	} else if (index1Ptr->charIndex > index2Ptr->charIndex) {
	    return 1;
	} else {
	    return 0;
	}
    }
    line1 = TkBTreeLineIndex(index1Ptr->linePtr);
    line2 = TkBTreeLineIndex(index2Ptr->linePtr);
    if (line1 < line2) {
	return -1;
    }
    if (line1 > line2) {
	return 1;
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * ForwBack --
 *
 *	This procedure handles +/- modifiers for indices to adjust
 *	the index forwards or backwards.
 *
 * Results:
 *	If the modifier in string is successfully parsed then the
 *	return value is the address of the first character after the
 *	modifier, and *indexPtr is updated to reflect the modifier.
 *	If there is a syntax error in the modifier then NULL is returned.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
ForwBack(string, indexPtr)
    char *string;		/* String to parse for additional info
				 * about modifier (count and units). 
				 * Points to "+" or "-" that starts







|


|
<
|
|







|




|



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

|



|



|
<


|
|
|




|




|
|




|

|

















|



|
|


|
|
|
|




|







529
530
531
532
533
534
535
536
537
538
539

540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588

589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
    error:
    Tcl_AppendResult(interp, "bad text index \"", string, "\"",
	    (char *) NULL);
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkTextPrintIndex --
 *	

 *	This procedure generates a string description of an index, suitable
 *	for reading in again later.
 *
 * Results:
 *	The characters pointed to by string are modified.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void
TkTextPrintIndex(indexPtr, string)
    CONST TkTextIndex *indexPtr;/* Pointer to index. */
    char *string;		/* Place to store the position.  Must have
				 * at least TK_POS_CHARS characters. */
{
    TkTextSegment *segPtr;
    int numBytes, charIndex;

    numBytes = indexPtr->byteIndex;
    charIndex = 0;
    for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) {
	if (numBytes <= segPtr->size) {
	    break;
	}
	if (segPtr->typePtr == &tkTextCharType) {
	    charIndex += Tcl_NumUtfChars(segPtr->body.chars, segPtr->size);
	} else {
	    charIndex += segPtr->size;
	}
	numBytes -= segPtr->size;
    }
    if (segPtr->typePtr == &tkTextCharType) {
	charIndex += Tcl_NumUtfChars(segPtr->body.chars, numBytes);
    } else {
	charIndex += numBytes;
    }
    sprintf(string, "%d.%d", TkBTreeLineIndex(indexPtr->linePtr) + 1,
	    charIndex);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkTextIndexCmp --
 *
 *	Compare two indices to see which one is earlier in the text.

 *
 * Results:
 *	The return value is 0 if index1Ptr and index2Ptr refer to the same
 *	position in the file, -1 if index1Ptr refers to an earlier position
 *	than index2Ptr, and 1 otherwise.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TkTextIndexCmp(index1Ptr, index2Ptr)
    CONST TkTextIndex *index1Ptr;		/* First index. */
    CONST TkTextIndex *index2Ptr;		/* Second index. */
{
    int line1, line2;

    if (index1Ptr->linePtr == index2Ptr->linePtr) {
	if (index1Ptr->byteIndex < index2Ptr->byteIndex) {
	    return -1;
	} else if (index1Ptr->byteIndex > index2Ptr->byteIndex) {
	    return 1;
	} else {
	    return 0;
	}
    }
    line1 = TkBTreeLineIndex(index1Ptr->linePtr);
    line2 = TkBTreeLineIndex(index2Ptr->linePtr);
    if (line1 < line2) {
	return -1;
    }
    if (line1 > line2) {
	return 1;
    }
    return 0;
}

/*
 *---------------------------------------------------------------------------
 *
 * ForwBack --
 *
 *	This procedure handles +/- modifiers for indices to adjust the
 *	index forwards or backwards.
 *
 * Results:
 *	If the modifier in string is successfully parsed then the return
 *	value is the address of the first character after the modifier,
 *	and *indexPtr is updated to reflect the modifier.  If there is a
 *	syntax error in the modifier then NULL is returned.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static char *
ForwBack(string, indexPtr)
    char *string;		/* String to parse for additional info
				 * about modifier (count and units). 
				 * Points to "+" or "-" that starts
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
    /*
     * Find the end of this modifier (next space or + or - character),
     * then parse the unit specifier and update the position
     * accordingly.
     */

    units = p; 
    while ((*p != 0) && !isspace(UCHAR(*p)) && (*p != '+') && (*p != '-')) {
	p++;
    }
    length = p - units;
    if ((*units == 'c') && (strncmp(units, "chars", length) == 0)) {
	if (*string == '+') {
	    TkTextIndexForwChars(indexPtr, count, indexPtr);
	} else {







|







678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
    /*
     * Find the end of this modifier (next space or + or - character),
     * then parse the unit specifier and update the position
     * accordingly.
     */

    units = p; 
    while ((*p != '\0') && !isspace(UCHAR(*p)) && (*p != '+') && (*p != '-')) {
	p++;
    }
    length = p - units;
    if ((*units == 'c') && (strncmp(units, "chars", length) == 0)) {
	if (*string == '+') {
	    TkTextIndexForwChars(indexPtr, count, indexPtr);
	} else {
574
575
576
577
578
579
580











581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
























































































651
652
653


654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718




















































































































719
720
721
722
723
724
725
	     * TkTextMakeIndex.
	     */

	    if (lineIndex < 0) {
		lineIndex = 0;
	    }
	}











	TkTextMakeIndex(indexPtr->tree, lineIndex, indexPtr->charIndex,
		indexPtr);
    } else {
	return NULL;
    }
    return p;
}

/*
 *----------------------------------------------------------------------
 *
 * TkTextIndexForwChars --
 *
 *	Given an index for a text widget, this procedure creates a
 *	new index that points "count" characters ahead of the source
 *	index.
 *
 * Results:
 *	*dstPtr is modified to refer to the character "count" characters
 *	after srcPtr, or to the last character in the file if there aren't
 *	"count" characters left in the file.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
void
TkTextIndexForwChars(srcPtr, count, dstPtr)
    TkTextIndex *srcPtr;		/* Source index. */
    int count;				/* How many characters forward to
					 * move.  May be negative. */
    TkTextIndex *dstPtr;		/* Destination index: gets modified. */
{
    TkTextLine *linePtr;
    TkTextSegment *segPtr;
    int lineLength;

    if (count < 0) {
	TkTextIndexBackChars(srcPtr, -count, dstPtr);
	return;
    }

    *dstPtr = *srcPtr;
    dstPtr->charIndex += count;
    while (1) {
	/*
	 * Compute the length of the current line.
	 */

	lineLength = 0;
	for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL;
		segPtr = segPtr->nextPtr) {
	    lineLength += segPtr->size;
	}

	/*
	 * If the new index is in the same line then we're done.
	 * Otherwise go on to the next line.
	 */

	if (dstPtr->charIndex < lineLength) {
	    return;
	}
	dstPtr->charIndex -= lineLength;
	linePtr = TkBTreeNextLine(dstPtr->linePtr);
	if (linePtr == NULL) {
	    dstPtr->charIndex = lineLength - 1;
























































































	    return;
	}
	dstPtr->linePtr = linePtr;


    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkTextIndexBackChars --
 *
 *	Given an index for a text widget, this procedure creates a
 *	new index that points "count" characters earlier than the
 *	source index.
 *
 * Results:
 *	*dstPtr is modified to refer to the character "count" characters
 *	before srcPtr, or to the first character in the file if there aren't
 *	"count" characters earlier than srcPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TkTextIndexBackChars(srcPtr, count, dstPtr)
    TkTextIndex *srcPtr;		/* Source index. */
    int count;				/* How many characters backward to
					 * move.  May be negative. */
    TkTextIndex *dstPtr;		/* Destination index: gets modified. */
{
    TkTextSegment *segPtr;
    int lineIndex;

    if (count < 0) {
	TkTextIndexForwChars(srcPtr, -count, dstPtr);
	return;
    }

    *dstPtr = *srcPtr;
    dstPtr->charIndex -= count;
    lineIndex = -1;
    while (dstPtr->charIndex < 0) {
	/*
	 * Move back one line in the text.  If we run off the beginning
	 * of the file then just return the first character in the text.
	 */

	if (lineIndex < 0) {
	    lineIndex = TkBTreeLineIndex(dstPtr->linePtr);
	}
	if (lineIndex == 0) {
	    dstPtr->charIndex = 0;
	    return;
	}
	lineIndex--;
	dstPtr->linePtr = TkBTreeFindLine(dstPtr->tree, lineIndex);

	/*
	 * Compute the length of the line and add that to dstPtr->charIndex.
	 */

	for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL;
		segPtr = segPtr->nextPtr) {
	    dstPtr->charIndex += segPtr->size;
	}




















































































































    }
}

/*
 *----------------------------------------------------------------------
 *
 * StartEnd --







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








|

|

|
|
<


|
|
|




|


<

|
|
|
|
|





|
|




|
















|


|


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



>
>




|

|

|
|
<


|
|
|




|



|
|
|
|
|




|
|




|

|









|











|

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







706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738

739
740
741
742
743
744
745
746
747
748
749
750

751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894

895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
	     * TkTextMakeIndex.
	     */

	    if (lineIndex < 0) {
		lineIndex = 0;
	    }
	}
	/*
	 * This doesn't work quite right if using a proportional font or
	 * UTF-8 characters with varying numbers of bytes.  The cursor will
	 * bop around, keeping a constant number of bytes (not characters)
	 * from the left edge (but making sure not to split any UTF-8
	 * characters), regardless of the x-position the index corresponds
	 * to.  The proper way to do this is to get the x-position of the
	 * index and then pick the character at the same x-position in the
	 * new line.
	 */

	TkTextMakeByteIndex(indexPtr->tree, lineIndex, indexPtr->byteIndex,
		indexPtr);
    } else {
	return NULL;
    }
    return p;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkTextIndexForwBytes --
 *
 *	Given an index for a text widget, this procedure creates a new
 *	index that points "count" bytes ahead of the source index.

 *
 * Results:
 *	*dstPtr is modified to refer to the character "count" bytes after
 *	srcPtr, or to the last character in the TkText if there aren't
 *	"count" bytes left.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */


void
TkTextIndexForwBytes(srcPtr, byteCount, dstPtr)
    CONST TkTextIndex *srcPtr;	/* Source index. */
    int byteCount;		/* How many bytes forward to move.  May be
				 * negative. */
    TkTextIndex *dstPtr;	/* Destination index: gets modified. */
{
    TkTextLine *linePtr;
    TkTextSegment *segPtr;
    int lineLength;

    if (byteCount < 0) {
	TkTextIndexBackBytes(srcPtr, -byteCount, dstPtr);
	return;
    }

    *dstPtr = *srcPtr;
    dstPtr->byteIndex += byteCount;
    while (1) {
	/*
	 * Compute the length of the current line.
	 */

	lineLength = 0;
	for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL;
		segPtr = segPtr->nextPtr) {
	    lineLength += segPtr->size;
	}

	/*
	 * If the new index is in the same line then we're done.
	 * Otherwise go on to the next line.
	 */

	if (dstPtr->byteIndex < lineLength) {
	    return;
	}
	dstPtr->byteIndex -= lineLength;
	linePtr = TkBTreeNextLine(dstPtr->linePtr);
	if (linePtr == NULL) {
	    dstPtr->byteIndex = lineLength - 1;
	    return;
	}
	dstPtr->linePtr = linePtr;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TkTextIndexForwChars --
 *
 *	Given an index for a text widget, this procedure creates a new
 *	index that points "count" characters ahead of the source index.
 *
 * Results:
 *	*dstPtr is modified to refer to the character "count" characters
 *	after srcPtr, or to the last character in the TkText if there
 *	aren't "count" characters left in the file.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void
TkTextIndexForwChars(srcPtr, charCount, dstPtr)
    CONST TkTextIndex *srcPtr;	/* Source index. */
    int charCount;		/* How many characters forward to move.
				 * May be negative. */
    TkTextIndex *dstPtr;	/* Destination index: gets modified. */
{
    TkTextLine *linePtr;
    TkTextSegment *segPtr;
    int byteOffset;
    char *start, *end, *p;
    Tcl_UniChar ch;

    if (charCount < 0) {
	TkTextIndexBackChars(srcPtr, -charCount, dstPtr);
	return;
    }

    *dstPtr = *srcPtr;

    /*
     * Find seg that contains src byteIndex.
     * Move forward specified number of chars.
     */

    segPtr = TkTextIndexToSeg(dstPtr, &byteOffset);
    while (1) {
	/*
	 * Go through each segment in line looking for specified character
	 * index.
	 */

	for ( ; segPtr != NULL; segPtr = segPtr->nextPtr) {
	    if (segPtr->typePtr == &tkTextCharType) {
		start = segPtr->body.chars + byteOffset;
		end = segPtr->body.chars + segPtr->size;
		for (p = start; p < end; p += Tcl_UtfToUniChar(p, &ch)) {
		    if (charCount == 0) {
			dstPtr->byteIndex += (p - start);
			return;
		    }
		    charCount--;
		}
	    } else {
		if (charCount < segPtr->size - byteOffset) {
		    dstPtr->byteIndex += charCount;
		    return;
		}
		charCount -= segPtr->size - byteOffset;
	    }
	    dstPtr->byteIndex += segPtr->size - byteOffset;
	    byteOffset = 0;
	}

	/*
	 * Go to the next line.  If we are at the end of the text item,
	 * back up one byte (for the terminal '\n' character) and return
	 * that index.
	 */
	 
	linePtr = TkBTreeNextLine(dstPtr->linePtr);
	if (linePtr == NULL) {
	    dstPtr->byteIndex -= sizeof(char);
	    return;
	}
	dstPtr->linePtr = linePtr;
	dstPtr->byteIndex = 0;
	segPtr = dstPtr->linePtr->segPtr;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TkTextIndexBackBytes --
 *
 *	Given an index for a text widget, this procedure creates a new
 *	index that points "count" bytes earlier than the source index.

 *
 * Results:
 *	*dstPtr is modified to refer to the character "count" bytes before
 *	srcPtr, or to the first character in the TkText if there aren't
 *	"count" bytes earlier than srcPtr.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void
TkTextIndexBackBytes(srcPtr, byteCount, dstPtr)
    CONST TkTextIndex *srcPtr;	/* Source index. */
    int byteCount;		/* How many bytes backward to move.  May be
				 * negative. */
    TkTextIndex *dstPtr;	/* Destination index: gets modified. */
{
    TkTextSegment *segPtr;
    int lineIndex;

    if (byteCount < 0) {
	TkTextIndexForwBytes(srcPtr, -byteCount, dstPtr);
	return;
    }

    *dstPtr = *srcPtr;
    dstPtr->byteIndex -= byteCount;
    lineIndex = -1;
    while (dstPtr->byteIndex < 0) {
	/*
	 * Move back one line in the text.  If we run off the beginning
	 * of the file then just return the first character in the text.
	 */

	if (lineIndex < 0) {
	    lineIndex = TkBTreeLineIndex(dstPtr->linePtr);
	}
	if (lineIndex == 0) {
	    dstPtr->byteIndex = 0;
	    return;
	}
	lineIndex--;
	dstPtr->linePtr = TkBTreeFindLine(dstPtr->tree, lineIndex);

	/*
	 * Compute the length of the line and add that to dstPtr->charIndex.
	 */

	for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL;
		segPtr = segPtr->nextPtr) {
	    dstPtr->byteIndex += segPtr->size;
	}
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TkTextIndexBackChars --
 *
 *	Given an index for a text widget, this procedure creates a new
 *	index that points "count" characters earlier than the source index.
 *
 * Results:
 *	*dstPtr is modified to refer to the character "count" characters
 *	before srcPtr, or to the first character in the file if there
 *	aren't "count" characters earlier than srcPtr.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void
TkTextIndexBackChars(srcPtr, charCount, dstPtr)
    CONST TkTextIndex *srcPtr;	/* Source index. */
    int charCount;		/* How many characters backward to move.
				 * May be negative. */
    TkTextIndex *dstPtr;	/* Destination index: gets modified. */
{
    TkTextSegment *segPtr, *oldPtr;
    int lineIndex, segSize;
    char *p, *start, *end;

    if (charCount <= 0) {
	TkTextIndexForwChars(srcPtr, -charCount, dstPtr);
	return;
    }

    *dstPtr = *srcPtr;

    /*
     * Find offset within seg that contains byteIndex.
     * Move backward specified number of chars.
     */

    lineIndex = -1;
    
    segSize = dstPtr->byteIndex;
    for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) {
	if (segSize <= segPtr->size) {
	    break;
	}
	segSize -= segPtr->size;
    }
    while (1) {
	if (segPtr->typePtr == &tkTextCharType) {
	    start = segPtr->body.chars;
	    end = segPtr->body.chars + segSize;
	    for (p = end; ; p = Tcl_UtfPrev(p, start)) {
		if (charCount == 0) {
		    dstPtr->byteIndex -= (end - p);
		    return;
		}
		if (p == start) {
		    break;
		}
		charCount--;
	    }
	} else {
	    if (charCount <= segSize) {
		dstPtr->byteIndex -= charCount;
		return;
	    }
	    charCount -= segSize;
	}
	dstPtr->byteIndex -= segSize;

	/*
	 * Move back into previous segment.
	 */

	oldPtr = segPtr;
	segPtr = dstPtr->linePtr->segPtr;
	if (segPtr != oldPtr) {
	    for ( ; segPtr->nextPtr != oldPtr; segPtr = segPtr->nextPtr) {
		/* Empty body. */
	    }
	    segSize = segPtr->size;
	    continue;
	}

	/*
	 * Move back to previous line.
	 */

	if (lineIndex < 0) {
	    lineIndex = TkBTreeLineIndex(dstPtr->linePtr);
	}
	if (lineIndex == 0) {
	    dstPtr->byteIndex = 0;
	    return;
	}
	lineIndex--;
	dstPtr->linePtr = TkBTreeFindLine(dstPtr->tree, lineIndex);

	/*
	 * Compute the length of the line and add that to dstPtr->byteIndex.
	 */

	oldPtr = dstPtr->linePtr->segPtr;
	for (segPtr = oldPtr; segPtr != NULL; segPtr = segPtr->nextPtr) {
	    dstPtr->byteIndex += segPtr->size;
	    oldPtr = segPtr;
	}
	segPtr = oldPtr;
	segSize = segPtr->size;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * StartEnd --
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

    for (p = string; isalnum(UCHAR(*p)); p++) {
	/* Empty loop body. */
    }
    length = p-string;
    if ((*string == 'l') && (strncmp(string, "lineend", length) == 0)
	    && (length >= 5)) {
	indexPtr->charIndex = 0;
	for (segPtr = indexPtr->linePtr->segPtr; segPtr != NULL;
		segPtr = segPtr->nextPtr) {
	    indexPtr->charIndex += segPtr->size;
	}
	indexPtr->charIndex -= 1;
    } else if ((*string == 'l') && (strncmp(string, "linestart", length) == 0)
	    && (length >= 5)) {
	indexPtr->charIndex = 0;
    } else if ((*string == 'w') && (strncmp(string, "wordend", length) == 0)
	    && (length >= 5)) {
	int firstChar = 1;

	/*
	 * If the current character isn't part of a word then just move
	 * forward one character.  Otherwise move forward until finding
	 * a character that isn't part of a word and stop there.
	 */

	segPtr = TkTextIndexToSeg(indexPtr, &offset);
	while (1) {
	    if (segPtr->typePtr == &tkTextCharType) {
		c = segPtr->body.chars[offset];
		if (!isalnum(UCHAR(c)) && (c != '_')) {
		    break;
		}
		firstChar = 0;
	    }
	    offset += 1;
	    indexPtr->charIndex += 1;
	    if (offset >= segPtr->size) {
		segPtr = TkTextIndexToSeg(indexPtr, &offset);
	    }
	}
	if (firstChar) {
	    TkTextIndexForwChars(indexPtr, 1, indexPtr);
	}







|


|

|


|




















|







1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147

    for (p = string; isalnum(UCHAR(*p)); p++) {
	/* Empty loop body. */
    }
    length = p-string;
    if ((*string == 'l') && (strncmp(string, "lineend", length) == 0)
	    && (length >= 5)) {
	indexPtr->byteIndex = 0;
	for (segPtr = indexPtr->linePtr->segPtr; segPtr != NULL;
		segPtr = segPtr->nextPtr) {
	    indexPtr->byteIndex += segPtr->size;
	}
	indexPtr->byteIndex -= sizeof(char);
    } else if ((*string == 'l') && (strncmp(string, "linestart", length) == 0)
	    && (length >= 5)) {
	indexPtr->byteIndex = 0;
    } else if ((*string == 'w') && (strncmp(string, "wordend", length) == 0)
	    && (length >= 5)) {
	int firstChar = 1;

	/*
	 * If the current character isn't part of a word then just move
	 * forward one character.  Otherwise move forward until finding
	 * a character that isn't part of a word and stop there.
	 */

	segPtr = TkTextIndexToSeg(indexPtr, &offset);
	while (1) {
	    if (segPtr->typePtr == &tkTextCharType) {
		c = segPtr->body.chars[offset];
		if (!isalnum(UCHAR(c)) && (c != '_')) {
		    break;
		}
		firstChar = 0;
	    }
	    offset += 1;
	    indexPtr->byteIndex += sizeof(char);
	    if (offset >= segPtr->size) {
		segPtr = TkTextIndexToSeg(indexPtr, &offset);
	    }
	}
	if (firstChar) {
	    TkTextIndexForwChars(indexPtr, 1, indexPtr);
	}
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
		c = segPtr->body.chars[offset];
		if (!isalnum(UCHAR(c)) && (c != '_')) {
		    break;
		}
		firstChar = 0;
	    }
	    offset -= 1;
	    indexPtr->charIndex -= 1;
	    if (offset < 0) {
		if (indexPtr->charIndex < 0) {
		    indexPtr->charIndex = 0;
		    goto done;
		}
		segPtr = TkTextIndexToSeg(indexPtr, &offset);
	    }
	}
	if (!firstChar) {
	    TkTextIndexForwChars(indexPtr, 1, indexPtr);







|

|
|







1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
		c = segPtr->body.chars[offset];
		if (!isalnum(UCHAR(c)) && (c != '_')) {
		    break;
		}
		firstChar = 0;
	    }
	    offset -= 1;
	    indexPtr->byteIndex -= sizeof(char);
	    if (offset < 0) {
		if (indexPtr->byteIndex < 0) {
		    indexPtr->byteIndex = 0;
		    goto done;
		}
		segPtr = TkTextIndexToSeg(indexPtr, &offset);
	    }
	}
	if (!firstChar) {
	    TkTextIndexForwChars(indexPtr, 1, indexPtr);

Changes to generic/tkTextMark.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkTextMark.c --
 *
 *	This file contains the procedure that implement marks for
 *	text widgets.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkTextMark.c 1.18 97/10/20 11:12:50
 */

#include "tkInt.h"
#include "tkText.h"
#include "tkPort.h"

/*












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkTextMark.c --
 *
 *	This file contains the procedure that implement marks for
 *	text widgets.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkTextMark.c,v 1.1.4.2 1998/09/30 02:17:25 stanton Exp $
 */

#include "tkInt.h"
#include "tkText.h"
#include "tkPort.h"

/*
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
	    Tcl_AppendResult(interp, "there is no mark named \"",
		    argv[3], "\"", (char *) NULL);
	    return TCL_ERROR;
	}
	markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
	if (argc == 4) {
	    if (markPtr->typePtr == &tkTextRightMarkType) {
		interp->result = "right";
	    } else {
		interp->result = "left";
	    }
	    return TCL_OK;
	}
	length = strlen(argv[4]);
	c = argv[4][0];
	if ((c == 'l') && (strncmp(argv[4], "left", length) == 0)) {
	    newTypePtr = &tkTextLeftMarkType;







|

|







130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
	    Tcl_AppendResult(interp, "there is no mark named \"",
		    argv[3], "\"", (char *) NULL);
	    return TCL_ERROR;
	}
	markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
	if (argc == 4) {
	    if (markPtr->typePtr == &tkTextRightMarkType) {
		Tcl_SetResult(interp, "right", TCL_STATIC);
	    } else {
		Tcl_SetResult(interp, "left", TCL_STATIC);
	    }
	    return TCL_OK;
	}
	length = strlen(argv[4]);
	c = argv[4][0];
	if ((c == 'l') && (strncmp(argv[4], "left", length) == 0)) {
	    newTypePtr = &tkTextLeftMarkType;
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
    TkTextSegment *markPtr;	/* Mark segment. */
    TkTextIndex *indexPtr;	/* Index information gets stored here.  */
{
    TkTextSegment *segPtr;

    indexPtr->tree = textPtr->tree;
    indexPtr->linePtr = markPtr->body.mark.linePtr;
    indexPtr->charIndex = 0;
    for (segPtr = indexPtr->linePtr->segPtr; segPtr != markPtr;
	    segPtr = segPtr->nextPtr) {
	indexPtr->charIndex += segPtr->size;
    }
}

/*
 *--------------------------------------------------------------
 *
 * TkTextMarkNameToIndex --







|


|







315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
    TkTextSegment *markPtr;	/* Mark segment. */
    TkTextIndex *indexPtr;	/* Index information gets stored here.  */
{
    TkTextSegment *segPtr;

    indexPtr->tree = textPtr->tree;
    indexPtr->linePtr = markPtr->body.mark.linePtr;
    indexPtr->byteIndex = 0;
    for (segPtr = indexPtr->linePtr->segPtr; segPtr != markPtr;
	    segPtr = segPtr->nextPtr) {
	indexPtr->byteIndex += segPtr->size;
    }
}

/*
 *--------------------------------------------------------------
 *
 * TkTextMarkNameToIndex --
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
	return -1;
    }

    chunkPtr->displayProc = TkTextInsertDisplayProc;
    chunkPtr->undisplayProc = InsertUndisplayProc;
    chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL;
    chunkPtr->bboxProc = (Tk_ChunkBboxProc *) NULL;
    chunkPtr->numChars = 0;
    chunkPtr->minAscent = 0;
    chunkPtr->minDescent = 0;
    chunkPtr->minHeight = 0;
    chunkPtr->width = 0;

    /*
     * Note: can't break a line after the insertion cursor:  this







|







464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
	return -1;
    }

    chunkPtr->displayProc = TkTextInsertDisplayProc;
    chunkPtr->undisplayProc = InsertUndisplayProc;
    chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL;
    chunkPtr->bboxProc = (Tk_ChunkBboxProc *) NULL;
    chunkPtr->numBytes = 0;
    chunkPtr->minAscent = 0;
    chunkPtr->minDescent = 0;
    chunkPtr->minHeight = 0;
    chunkPtr->width = 0;

    /*
     * Note: can't break a line after the insertion cursor:  this
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
	 * For non-mark name indices we want to return any marks that
	 * are right at the index.
	 */
	if (TkTextGetIndex(interp, textPtr, string, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	for (offset = 0, segPtr = index.linePtr->segPtr; 
		segPtr != NULL && offset < index.charIndex;
		offset += segPtr->size,	segPtr = segPtr->nextPtr) {
	    /* Empty loop body */ ;
	}
    }
    while (1) {
	/*
	 * segPtr points at the first possible candidate,







|







665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
	 * For non-mark name indices we want to return any marks that
	 * are right at the index.
	 */
	if (TkTextGetIndex(interp, textPtr, string, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	for (offset = 0, segPtr = index.linePtr->segPtr; 
		segPtr != NULL && offset < index.byteIndex;
		offset += segPtr->size,	segPtr = segPtr->nextPtr) {
	    /* Empty loop body */ ;
	}
    }
    while (1) {
	/*
	 * segPtr points at the first possible candidate,
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
		return TCL_OK;
	    }
	}
	index.linePtr = TkBTreeNextLine(index.linePtr);
	if (index.linePtr == (TkTextLine *) NULL) {
	    return TCL_OK;
	}
	index.charIndex = 0;
	segPtr = index.linePtr->segPtr;
    }
}

/*
 *--------------------------------------------------------------
 *







|







688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
		return TCL_OK;
	    }
	}
	index.linePtr = TkBTreeNextLine(index.linePtr);
	if (index.linePtr == (TkTextLine *) NULL) {
	    return TCL_OK;
	}
	index.byteIndex = 0;
	segPtr = index.linePtr->segPtr;
    }
}

/*
 *--------------------------------------------------------------
 *
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
	 * For non-mark name indices we do not return any marks that
	 * are right at the index.
	 */
	if (TkTextGetIndex(interp, textPtr, string, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	for (offset = 0, segPtr = index.linePtr->segPtr; 
		segPtr != NULL && offset < index.charIndex;
		offset += segPtr->size, segPtr = segPtr->nextPtr) {
	    /* Empty loop body */ ;
	}
    }
    while (1) {
	/*
	 * segPtr points just past the first possible candidate,







|







738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
	 * For non-mark name indices we do not return any marks that
	 * are right at the index.
	 */
	if (TkTextGetIndex(interp, textPtr, string, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	for (offset = 0, segPtr = index.linePtr->segPtr; 
		segPtr != NULL && offset < index.byteIndex;
		offset += segPtr->size, segPtr = segPtr->nextPtr) {
	    /* Empty loop body */ ;
	}
    }
    while (1) {
	/*
	 * segPtr points just past the first possible candidate,

Changes to generic/tkTextTag.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkTextTag.c --
 *
 *	This module implements the "tag" subcommand of the widget command
 *	for text widgets, plus most of the other high-level functions
 *	related to tags.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkTextTag.c 1.39 97/02/07 13:51:52
 */

#include "default.h"
#include "tkPort.h"
#include "tk.h"
#include "tkText.h"









|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkTextTag.c --
 *
 *	This module implements the "tag" subcommand of the widget command
 *	for text widgets, plus most of the other high-level functions
 *	related to tags.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkTextTag.c,v 1.1.4.3 1999/02/16 11:39:33 lfb Exp $
 */

#include "default.h"
#include "tkPort.h"
#include "tk.h"
#include "tkText.h"

231
232
233
234
235
236
237









238


239

240

241
242
243
244
245
246
247
	    }
	} else if (argc == 5) {
	    char *command;
    
	    command = Tk_GetBinding(interp, textPtr->bindingTable,
		    (ClientData) tagPtr, argv[4]);
	    if (command == NULL) {









		return TCL_ERROR;


	    }

	    interp->result = command;

	} else {
	    Tk_GetAllBindings(interp, textPtr->bindingTable,
		    (ClientData) tagPtr);
	}
    } else if ((c == 'c') && (strncmp(argv[2], "cget", length) == 0)
	    && (length >= 2)) {
	if (argc != 5) {







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







231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
	    }
	} else if (argc == 5) {
	    char *command;
    
	    command = Tk_GetBinding(interp, textPtr->bindingTable,
		    (ClientData) tagPtr, argv[4]);
	    if (command == NULL) {
		char *string = Tcl_GetStringResult(interp); 

		/*
		 * Ignore missing binding errors.  This is a special hack
		 * that relies on the error message returned by FindSequence
		 * in tkBind.c.
		 */

		if (string[0] != '\0') {
		    return TCL_ERROR;
		} else {
		    Tcl_ResetResult(interp);
		}
	    } else {
		Tcl_SetResult(interp, command, TCL_STATIC);
	    }
	} else {
	    Tk_GetAllBindings(interp, textPtr->bindingTable,
		    (ClientData) tagPtr);
	}
    } else if ((c == 'c') && (strncmp(argv[2], "cget", length) == 0)
	    && (length >= 2)) {
	if (argc != 5) {
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
	    if (tagPtr->underlineString != NULL) {
		if (Tcl_GetBoolean(interp, tagPtr->underlineString,
			&tagPtr->underline) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    if ((tagPtr->wrapMode != NULL)
		    && (tagPtr->wrapMode != tkTextCharUid)
		    && (tagPtr->wrapMode != tkTextNoneUid)
		    && (tagPtr->wrapMode != tkTextWordUid)) {
		Tcl_AppendResult(interp, "bad wrap mode \"", tagPtr->wrapMode,
			"\": must be char, none, or word", (char *) NULL);
		tagPtr->wrapMode = NULL;
		return TCL_ERROR;
	    }

	    /*







|
|
|







388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
	    if (tagPtr->underlineString != NULL) {
		if (Tcl_GetBoolean(interp, tagPtr->underlineString,
			&tagPtr->underline) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    if ((tagPtr->wrapMode != NULL)
		    && (tagPtr->wrapMode != Tk_GetUid("char"))
		    && (tagPtr->wrapMode != Tk_GetUid("none"))
		    && (tagPtr->wrapMode != Tk_GetUid("word"))) {
		Tcl_AppendResult(interp, "bad wrap mode \"", tagPtr->wrapMode,
			"\": must be char, none, or word", (char *) NULL);
		tagPtr->wrapMode = NULL;
		return TCL_ERROR;
	    }

	    /*
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
	    if (tagPtr == textPtr->selTagPtr) {
		continue;
	    }
	    if (tagPtr->affectsDisplay) {
		TkTextRedrawTag(textPtr, (TkTextIndex *) NULL,
			(TkTextIndex *) NULL, tagPtr, 1);
	    }
	    TkBTreeTag(TkTextMakeIndex(textPtr->tree, 0, 0, &first),
		    TkTextMakeIndex(textPtr->tree,
			    TkBTreeNumLines(textPtr->tree), 0, &last),
		    tagPtr, 0);
	    Tcl_DeleteHashEntry(hPtr);
	    if (textPtr->bindingTable != NULL) {
		Tk_DeleteAllBindings(textPtr->bindingTable,
			(ClientData) tagPtr);
	    }
	
	    /*







|
|
|
|







457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
	    if (tagPtr == textPtr->selTagPtr) {
		continue;
	    }
	    if (tagPtr->affectsDisplay) {
		TkTextRedrawTag(textPtr, (TkTextIndex *) NULL,
			(TkTextIndex *) NULL, tagPtr, 1);
	    }
	    TkTextMakeByteIndex(textPtr->tree, 0, 0, &first);
	    TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
		    0, &last),
	    TkBTreeTag(&first, &last, tagPtr, 0);
	    Tcl_DeleteHashEntry(hPtr);
	    if (textPtr->bindingTable != NULL) {
		Tk_DeleteAllBindings(textPtr->bindingTable,
			(ClientData) tagPtr);
	    }
	
	    /*
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
	tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, argv[3]);
	if (tagPtr == NULL) {
	    return TCL_OK;
	}
	if (TkTextGetIndex(interp, textPtr, argv[4], &index1) != TCL_OK) {
	    return TCL_ERROR;
	}
	TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
		0, &last);
	if (argc == 5) {
	    index2 = last;
	} else if (TkTextGetIndex(interp, textPtr, argv[5], &index2)
		!= TCL_OK) {
	    return TCL_ERROR;
	}







|







561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
	tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, argv[3]);
	if (tagPtr == NULL) {
	    return TCL_OK;
	}
	if (TkTextGetIndex(interp, textPtr, argv[4], &index1) != TCL_OK) {
	    return TCL_ERROR;
	}
	TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
		0, &last);
	if (argc == 5) {
	    index2 = last;
	} else if (TkTextGetIndex(interp, textPtr, argv[5], &index2)
		!= TCL_OK) {
	    return TCL_ERROR;
	}
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592

	    /*
	     * The first character is tagged.  See if there is an
	     * on-toggle just before the character.  If not, then
	     * skip to the end of this tagged range.
	     */

	    for (segPtr = index1.linePtr->segPtr, offset = index1.charIndex; 
		    offset >= 0;
		    offset -= segPtr->size, segPtr = segPtr->nextPtr) {
		if ((offset == 0) && (segPtr->typePtr == &tkTextToggleOnType)
			&& (segPtr->body.toggle.tagPtr == tagPtr)) {
		    goto gotStart;
		}
	    }







|







591
592
593
594
595
596
597
598
599
600
601
602
603
604
605

	    /*
	     * The first character is tagged.  See if there is an
	     * on-toggle just before the character.  If not, then
	     * skip to the end of this tagged range.
	     */

	    for (segPtr = index1.linePtr->segPtr, offset = index1.byteIndex; 
		    offset >= 0;
		    offset -= segPtr->size, segPtr = segPtr->nextPtr) {
		if ((offset == 0) && (segPtr->typePtr == &tkTextToggleOnType)
			&& (segPtr->body.toggle.tagPtr == tagPtr)) {
		    goto gotStart;
		}
	    }
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
	if (tagPtr == NULL) {
	    return TCL_OK;
	}
	if (TkTextGetIndex(interp, textPtr, argv[4], &index1) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (argc == 5) {
	    TkTextMakeIndex(textPtr->tree, 0, 0, &index2);
	} else if (TkTextGetIndex(interp, textPtr, argv[5], &index2)
		!= TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * The search below is a bit weird.  The previous toggle can be
	 * either an on or off toggle. If it is an on toggle, then we
	 * need to turn around and search forward for the end toggle.
	 * Otherwise we keep searching backwards.
	 */

	TkBTreeStartSearchBack(&index1, &index2, tagPtr, &tSearch);

	if (!TkBTreePrevTag(&tSearch)) {
	    return TCL_OK;
	}
	if (tSearch.segPtr->typePtr == &tkTextToggleOnType) {
	    TkTextPrintIndex(&tSearch.curIndex, position1);
	    TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
		    0, &last);
	    TkBTreeStartSearch(&tSearch.curIndex, &last, tagPtr, &tSearch);
	    TkBTreeNextTag(&tSearch);
	    TkTextPrintIndex(&tSearch.curIndex, position2);
	} else {
	    TkTextPrintIndex(&tSearch.curIndex, position2);
	    TkBTreePrevTag(&tSearch);







|



















|







640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
	if (tagPtr == NULL) {
	    return TCL_OK;
	}
	if (TkTextGetIndex(interp, textPtr, argv[4], &index1) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (argc == 5) {
	    TkTextMakeByteIndex(textPtr->tree, 0, 0, &index2);
	} else if (TkTextGetIndex(interp, textPtr, argv[5], &index2)
		!= TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * The search below is a bit weird.  The previous toggle can be
	 * either an on or off toggle. If it is an on toggle, then we
	 * need to turn around and search forward for the end toggle.
	 * Otherwise we keep searching backwards.
	 */

	TkBTreeStartSearchBack(&index1, &index2, tagPtr, &tSearch);

	if (!TkBTreePrevTag(&tSearch)) {
	    return TCL_OK;
	}
	if (tSearch.segPtr->typePtr == &tkTextToggleOnType) {
	    TkTextPrintIndex(&tSearch.curIndex, position1);
	    TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
		    0, &last);
	    TkBTreeStartSearch(&tSearch.curIndex, &last, tagPtr, &tSearch);
	    TkBTreeNextTag(&tSearch);
	    TkTextPrintIndex(&tSearch.curIndex, position2);
	} else {
	    TkTextPrintIndex(&tSearch.curIndex, position2);
	    TkBTreePrevTag(&tSearch);
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
		    argv[0], " tag ranges tagName\"", (char *) NULL);
	    return TCL_ERROR;
	}
	tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, argv[3]);
	if (tagPtr == NULL) {
	    return TCL_OK;
	}
	TkTextMakeIndex(textPtr->tree, 0, 0, &first);
	TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
		0, &last);
	TkBTreeStartSearch(&first, &last, tagPtr, &tSearch);
	if (TkBTreeCharTagged(&first, tagPtr)) {
	    TkTextPrintIndex(&first, position);
	    Tcl_AppendElement(interp, position);
	}
	while (TkBTreeNextTag(&tSearch)) {







|
|







720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
		    argv[0], " tag ranges tagName\"", (char *) NULL);
	    return TCL_ERROR;
	}
	tagPtr = FindTag((Tcl_Interp *) NULL, textPtr, argv[3]);
	if (tagPtr == NULL) {
	    return TCL_OK;
	}
	TkTextMakeByteIndex(textPtr->tree, 0, 0, &first);
	TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
		0, &last);
	TkBTreeStartSearch(&first, &last, tagPtr, &tSearch);
	if (TkBTreeCharTagged(&first, tagPtr)) {
	    TkTextPrintIndex(&first, position);
	    Tcl_AppendElement(interp, position);
	}
	while (TkBTreeNextTag(&tSearch)) {
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
 * FindTag --
 *
 *	See if tag is defined for a given widget.
 *
 * Results:
 *	If tagName is defined in textPtr, a pointer to its TkTextTag
 *	structure is returned.  Otherwise NULL is returned and an
 *	error message is recorded in interp->result unless interp
 *	is NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */







|







837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
 * FindTag --
 *
 *	See if tag is defined for a given widget.
 *
 * Results:
 *	If tagName is defined in textPtr, a pointer to its TkTextTag
 *	structure is returned.  Otherwise NULL is returned and an
 *	error message is recorded in the interp's result unless interp
 *	is NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Changes to generic/tkTextWind.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkTextWind.c --
 *
 *	This file contains code that allows arbitrary windows to be
 *	nested inside text widgets.  It also implements the "window"
 *	widget command for texts.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkTextWind.c 1.14 97/04/25 16:52:09
 */

#include "tk.h"
#include "tkText.h"
#include "tkPort.h"

/*








|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkTextWind.c --
 *
 *	This file contains code that allows arbitrary windows to be
 *	nested inside text widgets.  It also implements the "window"
 *	widget command for texts.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkTextWind.c,v 1.1.4.3 1999/02/16 11:39:33 lfb Exp $
 */

#include "tk.h"
#include "tkText.h"
#include "tkPort.h"

/*
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
	/*
	 * Don't allow insertions on the last (dummy) line of the text.
	 */
    
	lineIndex = TkBTreeLineIndex(index.linePtr);
	if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
	    lineIndex--;
	    TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, &index);
	}

	/*
	 * Create the new window segment and initialize it.
	 */

	ewPtr = (TkTextSegment *) ckalloc(EW_SEG_SIZE);







|







240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
	/*
	 * Don't allow insertions on the last (dummy) line of the text.
	 */
    
	lineIndex = TkBTreeLineIndex(index.linePtr);
	if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
	    lineIndex--;
	    TkTextMakeByteIndex(textPtr->tree, lineIndex, 1000000, &index);
	}

	/*
	 * Create the new window segment and initialize it.
	 */

	ewPtr = (TkTextSegment *) ckalloc(EW_SEG_SIZE);
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
 * EmbWinConfigure --
 *
 *	This procedure is called to handle configuration options
 *	for an embedded window, using an argc/argv list.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then interp->result contains an error message..
 *
 * Side effects:
 *	Configuration information for the embedded window changes,
 *	such as alignment, stretching, or name of the embedded
 *	window.
 *
 *--------------------------------------------------------------







|







307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
 * EmbWinConfigure --
 *
 *	This procedure is called to handle configuration options
 *	for an embedded window, using an argc/argv list.
 *
 * Results:
 *	The return value is a standard Tcl result.  If TCL_ERROR is
 *	returned, then the interp's result contains an error message..
 *
 * Side effects:
 *	Configuration information for the embedded window changes,
 *	such as alignment, stretching, or name of the embedded
 *	window.
 *
 *--------------------------------------------------------------
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
    }

    Tcl_DeleteHashEntry(Tcl_FindHashEntry(&ewPtr->body.ew.textPtr->windowTable,
	    Tk_PathName(ewPtr->body.ew.tkwin)));
    ewPtr->body.ew.tkwin = NULL;
    index.tree = ewPtr->body.ew.textPtr->tree;
    index.linePtr = ewPtr->body.ew.linePtr;
    index.charIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
    TkTextChanged(ewPtr->body.ew.textPtr, &index, &index);
}

/*
 *--------------------------------------------------------------
 *
 * EmbWinRequestProc --







|







537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
    }

    Tcl_DeleteHashEntry(Tcl_FindHashEntry(&ewPtr->body.ew.textPtr->windowTable,
	    Tk_PathName(ewPtr->body.ew.tkwin)));
    ewPtr->body.ew.tkwin = NULL;
    index.tree = ewPtr->body.ew.textPtr->tree;
    index.linePtr = ewPtr->body.ew.linePtr;
    index.byteIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
    TkTextChanged(ewPtr->body.ew.textPtr, &index, &index);
}

/*
 *--------------------------------------------------------------
 *
 * EmbWinRequestProc --
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
					 * size. */
{
    TkTextSegment *ewPtr = (TkTextSegment *) clientData;
    TkTextIndex index;

    index.tree = ewPtr->body.ew.textPtr->tree;
    index.linePtr = ewPtr->body.ew.linePtr;
    index.charIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
    TkTextChanged(ewPtr->body.ew.textPtr, &index, &index);
}

/*
 *--------------------------------------------------------------
 *
 * EmbWinLostSlaveProc --







|







571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
					 * size. */
{
    TkTextSegment *ewPtr = (TkTextSegment *) clientData;
    TkTextIndex index;

    index.tree = ewPtr->body.ew.textPtr->tree;
    index.linePtr = ewPtr->body.ew.linePtr;
    index.byteIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
    TkTextChanged(ewPtr->body.ew.textPtr, &index, &index);
}

/*
 *--------------------------------------------------------------
 *
 * EmbWinLostSlaveProc --
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
	Tk_UnmapWindow(tkwin);
    }
    Tcl_DeleteHashEntry(Tcl_FindHashEntry(&ewPtr->body.ew.textPtr->windowTable,
	    Tk_PathName(ewPtr->body.ew.tkwin)));
    ewPtr->body.ew.tkwin = NULL;
    index.tree = ewPtr->body.ew.textPtr->tree;
    index.linePtr = ewPtr->body.ew.linePtr;
    index.charIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
    TkTextChanged(ewPtr->body.ew.textPtr, &index, &index);
}

/*
 *--------------------------------------------------------------
 *
 * EmbWinDeleteProc --







|







616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
	Tk_UnmapWindow(tkwin);
    }
    Tcl_DeleteHashEntry(Tcl_FindHashEntry(&ewPtr->body.ew.textPtr->windowTable,
	    Tk_PathName(ewPtr->body.ew.tkwin)));
    ewPtr->body.ew.tkwin = NULL;
    index.tree = ewPtr->body.ew.textPtr->tree;
    index.linePtr = ewPtr->body.ew.linePtr;
    index.byteIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
    TkTextChanged(ewPtr->body.ew.textPtr, &index, &index);
}

/*
 *--------------------------------------------------------------
 *
 * EmbWinDeleteProc --
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
	code = Tcl_GlobalEval(textPtr->interp, ewPtr->body.ew.create);
	if (code != TCL_OK) {
	    createError:
	    Tcl_BackgroundError(textPtr->interp);
	    goto gotWindow;
	}
	Tcl_DStringInit(&name);
	Tcl_DStringAppend(&name, textPtr->interp->result, -1);
	Tcl_ResetResult(textPtr->interp);
	ewPtr->body.ew.tkwin = Tk_NameToWindow(textPtr->interp,
		Tcl_DStringValue(&name), textPtr->tkwin);
	if (ewPtr->body.ew.tkwin == NULL) {
	    goto createError;
	}
	for (ancestor = textPtr->tkwin; ;







|







774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
	code = Tcl_GlobalEval(textPtr->interp, ewPtr->body.ew.create);
	if (code != TCL_OK) {
	    createError:
	    Tcl_BackgroundError(textPtr->interp);
	    goto gotWindow;
	}
	Tcl_DStringInit(&name);
	Tcl_DStringAppend(&name, Tcl_GetStringResult(textPtr->interp), -1);
	Tcl_ResetResult(textPtr->interp);
	ewPtr->body.ew.tkwin = Tk_NameToWindow(textPtr->interp,
		Tcl_DStringValue(&name), textPtr->tkwin);
	if (ewPtr->body.ew.tkwin == NULL) {
	    goto createError;
	}
	for (ancestor = textPtr->tkwin; ;
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
	width = 0;
	height = 0;
    } else {
	width = Tk_ReqWidth(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padX;
	height = Tk_ReqHeight(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padY;
    }
    if ((width > (maxX - chunkPtr->x))
	    && !noCharsYet && (textPtr->wrapMode != tkTextNoneUid)) {
	return 0;
    }

    /*
     * Fill in the chunk structure.
     */

    chunkPtr->displayProc = EmbWinDisplayProc;
    chunkPtr->undisplayProc = EmbWinUndisplayProc;
    chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL;
    chunkPtr->bboxProc = EmbWinBboxProc;
    chunkPtr->numChars = 1;
    if (ewPtr->body.ew.align == ALIGN_BASELINE) {
	chunkPtr->minAscent = height - ewPtr->body.ew.padY;
	chunkPtr->minDescent = ewPtr->body.ew.padY;
	chunkPtr->minHeight = 0;
    } else {
	chunkPtr->minAscent = 0;
	chunkPtr->minDescent = 0;







|











|







831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
	width = 0;
	height = 0;
    } else {
	width = Tk_ReqWidth(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padX;
	height = Tk_ReqHeight(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padY;
    }
    if ((width > (maxX - chunkPtr->x))
	    && !noCharsYet && (textPtr->wrapMode != Tk_GetUid("none"))) {
	return 0;
    }

    /*
     * Fill in the chunk structure.
     */

    chunkPtr->displayProc = EmbWinDisplayProc;
    chunkPtr->undisplayProc = EmbWinUndisplayProc;
    chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL;
    chunkPtr->bboxProc = EmbWinBboxProc;
    chunkPtr->numBytes = 1;
    if (ewPtr->body.ew.align == ALIGN_BASELINE) {
	chunkPtr->minAscent = height - ewPtr->body.ew.padY;
	chunkPtr->minDescent = ewPtr->body.ew.padY;
	chunkPtr->minHeight = 0;
    } else {
	chunkPtr->minAscent = 0;
	chunkPtr->minDescent = 0;
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
    hPtr = Tcl_FindHashEntry(&textPtr->windowTable, name);
    if (hPtr == NULL) {
	return 0;
    }
    ewPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
    indexPtr->tree = textPtr->tree;
    indexPtr->linePtr = ewPtr->body.ew.linePtr;
    indexPtr->charIndex = TkTextSegToOffset(ewPtr, indexPtr->linePtr);
    return 1;
}







|


1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
    hPtr = Tcl_FindHashEntry(&textPtr->windowTable, name);
    if (hPtr == NULL) {
	return 0;
    }
    ewPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
    indexPtr->tree = textPtr->tree;
    indexPtr->linePtr = ewPtr->body.ew.linePtr;
    indexPtr->byteIndex = TkTextSegToOffset(ewPtr, indexPtr->linePtr);
    return 1;
}

Changes to generic/tkTrig.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
/* 
 * tkTrig.c --
 *
 *	This file contains a collection of trigonometry utility
 *	routines that are used by Tk and in particular by the
 *	canvas code.  It also has miscellaneous geometry functions
 *	used by canvases.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkTrig.c 1.27 97/03/07 11:34:35
 */

#include <stdio.h>
#include "tkInt.h"
#include "tkPort.h"
#include "tkCanvas.h"










|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
/* 
 * tkTrig.c --
 *
 *	This file contains a collection of trigonometry utility
 *	routines that are used by Tk and in particular by the
 *	canvas code.  It also has miscellaneous geometry functions
 *	used by canvases.
 *
 * Copyright (c) 1992-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkTrig.c,v 1.1.4.2 1998/09/30 02:17:27 stanton Exp $
 */

#include <stdio.h>
#include "tkInt.h"
#include "tkPort.h"
#include "tkCanvas.h"

1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
 * TkMakeBezierPostscript --
 *
 *	This procedure generates Postscript commands that create
 *	a path corresponding to a given Bezier curve.
 *
 * Results:
 *	None.  Postscript commands to generate the path are appended
 *	to interp->result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */








|







1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
 * TkMakeBezierPostscript --
 *
 *	This procedure generates Postscript commands that create
 *	a path corresponding to a given Bezier curve.
 *
 * Results:
 *	None.  Postscript commands to generate the path are appended
 *	to the interp's result.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

Changes to generic/tkUtil.c.

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
/* 
 * tkUtil.c --
 *
 *	This file contains miscellaneous utility procedures that
 *	are used by the rest of Tk, such as a procedure for drawing
 *	a focus highlight.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUtil.c 1.13 97/06/06 11:16:22
 */

#include "tkInt.h"
#include "tkPort.h"















/*
 *----------------------------------------------------------------------
 *
 * TkDrawInsetFocusHighlight --
 *
 *	This procedure draws a rectangular ring around the outside of








|




|




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







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
/* 
 * tkUtil.c --
 *
 *	This file contains miscellaneous utility procedures that
 *	are used by the rest of Tk, such as a procedure for drawing
 *	a focus highlight.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUtil.c,v 1.1.4.3 1999/02/16 11:39:34 lfb Exp $
 */

#include "tkInt.h"
#include "tkPort.h"

/*
 * The structure below defines the implementation of the "statekey"
 * Tcl object, used for quickly finding a mapping in a TkStateMap.
 */

static Tcl_ObjType stateKeyType = {
    "statekey",				/* name */
    (Tcl_FreeInternalRepProc *) NULL,	/* freeIntRepProc */
    (Tcl_DupInternalRepProc *) NULL,	/* dupIntRepProc */
    (Tcl_UpdateStringProc *) NULL,	/* updateStringProc */
    (Tcl_SetFromAnyProc *) NULL		/* setFromAnyProc */
};


/*
 *----------------------------------------------------------------------
 *
 * TkDrawInsetFocusHighlight --
 *
 *	This procedure draws a rectangular ring around the outside of
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
 * Results:
 *	The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES,
 *	TK_SCROLL_UNITS, or TK_SCROLL_ERROR.  This indicates whether
 *	the command was successfully parsed and what form the command
 *	took.  If TK_SCROLL_MOVETO, *dblPtr is filled in with the
 *	desired position;  if TK_SCROLL_PAGES or TK_SCROLL_UNITS,
 *	*intPtr is filled in with the number of lines to move (may be
 *	negative);  if TK_SCROLL_ERROR, interp->result contains an
 *	error message.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */







|







142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
 * Results:
 *	The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES,
 *	TK_SCROLL_UNITS, or TK_SCROLL_ERROR.  This indicates whether
 *	the command was successfully parsed and what form the command
 *	took.  If TK_SCROLL_MOVETO, *dblPtr is filled in with the
 *	desired position;  if TK_SCROLL_PAGES or TK_SCROLL_UNITS,
 *	*intPtr is filled in with the number of lines to move (may be
 *	negative);  if TK_SCROLL_ERROR, the interp's result contains an
 *	error message.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
191
192
193
194
195
196
197















































































198
199
200
201
202
203
204
	    return TK_SCROLL_ERROR;
	}
    }
    Tcl_AppendResult(interp, "unknown option \"", argv[2],
	    "\": must be moveto or scroll", (char *) NULL);
    return TK_SCROLL_ERROR;
}
















































































/*
 *---------------------------------------------------------------------------
 *
 * TkComputeAnchor --
 *
 *	Determine where to place a rectangle so that it will be properly







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







205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
	    return TK_SCROLL_ERROR;
	}
    }
    Tcl_AppendResult(interp, "unknown option \"", argv[2],
	    "\": must be moveto or scroll", (char *) NULL);
    return TK_SCROLL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetScrollInfoObj --
 *
 *	This procedure is invoked to parse "xview" and "yview"
 *	scrolling commands for widgets using the new scrolling
 *	command syntax ("moveto" or "scroll" options).
 *
 * Results:
 *	The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES,
 *	TK_SCROLL_UNITS, or TK_SCROLL_ERROR.  This indicates whether
 *	the command was successfully parsed and what form the command
 *	took.  If TK_SCROLL_MOVETO, *dblPtr is filled in with the
 *	desired position;  if TK_SCROLL_PAGES or TK_SCROLL_UNITS,
 *	*intPtr is filled in with the number of lines to move (may be
 *	negative);  if TK_SCROLL_ERROR, the interp's result contains an
 *	error message.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetScrollInfoObj(interp, objc, objv, dblPtr, intPtr)
    Tcl_Interp *interp;			/* Used for error reporting. */
    int objc;				/* # arguments for command. */
    Tcl_Obj *CONST objv[];		/* Arguments for command. */
    double *dblPtr;			/* Filled in with argument "moveto"
					 * option, if any. */
    int *intPtr;			/* Filled in with number of pages
					 * or lines to scroll, if any. */
{
    int c;
    size_t length;
    char *arg2, *arg4;

    arg2 = Tcl_GetString(objv[2]);
    length = strlen(arg2);
    c = arg2[0];
    if ((c == 'm') && (strncmp(arg2, "moveto", length) == 0)) {
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "moveto fraction");
	    return TK_SCROLL_ERROR;
	}
	if (Tcl_GetDoubleFromObj(interp, objv[3], dblPtr) != TCL_OK) {
	    return TK_SCROLL_ERROR;
	}
	return TK_SCROLL_MOVETO;
    } else if ((c == 's')
	    && (strncmp(arg2, "scroll", length) == 0)) {
	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "scroll number units|pages");
	    return TK_SCROLL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[3], intPtr) != TCL_OK) {
	    return TK_SCROLL_ERROR;
	}
	arg4 = Tcl_GetString(objv[4]);
	length = (strlen(arg4));
	c = arg4[0];
	if ((c == 'p') && (strncmp(arg4, "pages", length) == 0)) {
	    return TK_SCROLL_PAGES;
	} else if ((c == 'u')
		&& (strncmp(arg4, "units", length) == 0)) {
	    return TK_SCROLL_UNITS;
	} else {
	    Tcl_AppendResult(interp, "bad argument \"", arg4,
		    "\": must be units or pages", (char *) NULL);
	    return TK_SCROLL_ERROR;
	}
    }
    Tcl_AppendResult(interp, "unknown option \"", arg2,
	    "\": must be moveto or scroll", (char *) NULL);
    return TK_SCROLL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkComputeAnchor --
 *
 *	Determine where to place a rectangle so that it will be properly
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340










































341

342
343
344


345
346
347
348
 *
 * Results:
 *	If strKey was equal to the string keys of one of the elements
 *	in the table, returns the numeric key of that element.
 *	Returns the numKey associated with the last element (the NULL
 *	string one) in the table if strKey was not equal to any of the
 *	string keys in the table.  In that case, an error message is
 *	also left in interp->result (if interp is not NULL).
 *
 * Side effects.
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TkFindStateNum(interp, field, mapPtr, strKey)
    Tcl_Interp *interp;		/* Interp for error reporting. */
    CONST char *field;		/* String to use when constructing error. */
    CONST TkStateMap *mapPtr;	/* Lookup table. */
    CONST char *strKey;		/* String to try to find in lookup table. */
{
    CONST TkStateMap *mPtr;

    if (mapPtr->strKey == NULL) {
	panic("TkFindStateNum: no choices in lookup table");
    }

    for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
	if (strcmp(strKey, mPtr->strKey) == 0) {
	    return mPtr->numKey;
	}
    }
    if (interp != NULL) {
	mPtr = mapPtr;










































	Tcl_AppendResult(interp, "bad ", field, " value \"", strKey,

		"\": must be ", mPtr->strKey, (char *) NULL);
	for (mPtr++; mPtr->strKey != NULL; mPtr++) {
	    Tcl_AppendResult(interp, ", ", mPtr->strKey, (char *) NULL);


	}
    }
    return mPtr->numKey;
}







|








|

|





<
<
<
<







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


|
>
>




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
 *
 * Results:
 *	If strKey was equal to the string keys of one of the elements
 *	in the table, returns the numeric key of that element.
 *	Returns the numKey associated with the last element (the NULL
 *	string one) in the table if strKey was not equal to any of the
 *	string keys in the table.  In that case, an error message is
 *	also left in the interp's result (if interp is not NULL).
 *
 * Side effects.
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TkFindStateNum(interp, option, mapPtr, strKey)
    Tcl_Interp *interp;		/* Interp for error reporting. */
    CONST char *option;		/* String to use when constructing error. */
    CONST TkStateMap *mapPtr;	/* Lookup table. */
    CONST char *strKey;		/* String to try to find in lookup table. */
{
    CONST TkStateMap *mPtr;





    for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
	if (strcmp(strKey, mPtr->strKey) == 0) {
	    return mPtr->numKey;
	}
    }
    if (interp != NULL) {
	mPtr = mapPtr;
	Tcl_AppendResult(interp, "bad ", option, " value \"", strKey,
		"\": must be ", mPtr->strKey, (char *) NULL);
	for (mPtr++; mPtr->strKey != NULL; mPtr++) {
	    Tcl_AppendResult(interp, 
		    ((mPtr[1].strKey != NULL) ? ", " : ", or "), 
		    mPtr->strKey, (char *) NULL);
	}
    }
    return mPtr->numKey;
}

int
TkFindStateNumObj(interp, optionPtr, mapPtr, keyPtr)
    Tcl_Interp *interp;		/* Interp for error reporting. */
    Tcl_Obj *optionPtr;		/* String to use when constructing error. */
    CONST TkStateMap *mapPtr;	/* Lookup table. */
    Tcl_Obj *keyPtr;		/* String key to find in lookup table. */
{
    CONST TkStateMap *mPtr;
    CONST char *key;
    CONST Tcl_ObjType *typePtr;

    if ((keyPtr->typePtr == &stateKeyType)
	    && (keyPtr->internalRep.twoPtrValue.ptr1 == (VOID *) mapPtr)) {
	return (int) keyPtr->internalRep.twoPtrValue.ptr2;
    }

    key = Tcl_GetStringFromObj(keyPtr, NULL);
    for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
	if (strcmp(key, mPtr->strKey) == 0) {
	    typePtr = keyPtr->typePtr;
	    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
		(*typePtr->freeIntRepProc)(keyPtr);
	    }
	    keyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) mapPtr;
	    keyPtr->internalRep.twoPtrValue.ptr2 = (VOID *) mPtr->numKey;
	    keyPtr->typePtr = &stateKeyType;	    
	    return mPtr->numKey;
	}
    }
    if (interp != NULL) {
	mPtr = mapPtr;
	Tcl_AppendResult(interp, "bad ",
		Tcl_GetStringFromObj(optionPtr, NULL), " value \"", key,
		"\": must be ", mPtr->strKey, (char *) NULL);
	for (mPtr++; mPtr->strKey != NULL; mPtr++) {
	    Tcl_AppendResult(interp, 
		((mPtr[1].strKey != NULL) ? ", " : ", or "), 
		mPtr->strKey, (char *) NULL);
	}
    }
    return mPtr->numKey;
}

Changes to generic/tkVisual.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkVisual.c --
 *
 *	This file contains library procedures for allocating and
 *	freeing visuals and colormaps.  This code is based on a
 *	prototype implementation by Paul Mackerras.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkVisual.c 1.19 97/04/25 16:52:17
 */

#include "tkInt.h"
#include "tkPort.h"

/*
 * The table below maps from symbolic names for visual classes








|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkVisual.c --
 *
 *	This file contains library procedures for allocating and
 *	freeing visuals and colormaps.  This code is based on a
 *	prototype implementation by Paul Mackerras.
 *
 * Copyright (c) 1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkVisual.c,v 1.1.4.2 1998/09/30 02:17:28 stanton Exp $
 */

#include "tkInt.h"
#include "tkPort.h"

/*
 * The table below maps from symbolic names for visual classes
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
 *
 *	Given a string identifying a particular kind of visual, this
 *	procedure returns a visual and depth that matches the specification.
 *
 * Results:
 *	The return value is normally a pointer to a visual.  If an
 *	error occurred in looking up the visual, NULL is returned and
 *	an error message is left in interp->result.  The depth of the
 *	visual is returned to *depthPtr under normal returns.  If
 *	colormapPtr is non-NULL, then this procedure also finds a
 *	suitable colormap for use with the visual in tkwin, and it
 *	returns that colormap in *colormapPtr unless an error occurs.
 *
 * Side effects:
 *	A new colormap may be allocated.







|







70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
 *
 *	Given a string identifying a particular kind of visual, this
 *	procedure returns a visual and depth that matches the specification.
 *
 * Results:
 *	The return value is normally a pointer to a visual.  If an
 *	error occurred in looking up the visual, NULL is returned and
 *	an error message is left in the interp's result.  The depth of the
 *	visual is returned to *depthPtr under normal returns.  If
 *	colormapPtr is non-NULL, then this procedure also finds a
 *	suitable colormap for use with the visual in tkwin, and it
 *	returns that colormap in *colormapPtr unless an error occurs.
 *
 * Side effects:
 *	A new colormap may be allocated.
239
240
241
242
243
244
245
246

247
248
249
250
251
252
253
     */

    template.screen = Tk_ScreenNumber(tkwin);
    mask |= VisualScreenMask;
    visInfoList = XGetVisualInfo(Tk_Display(tkwin), mask, &template,
	    &numVisuals);
    if (visInfoList == NULL) {
	interp->result = "couldn't find an appropriate visual";

	return NULL;
    }

    /*
     * Search through the visuals that were returned to find the best
     * one.  The choice is based on the following criteria, in decreasing
     * order of importance:







|
>







239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
     */

    template.screen = Tk_ScreenNumber(tkwin);
    mask |= VisualScreenMask;
    visInfoList = XGetVisualInfo(Tk_Display(tkwin), mask, &template,
	    &numVisuals);
    if (visInfoList == NULL) {
	Tcl_SetResult(interp, "couldn't find an appropriate visual",
		TCL_STATIC);
	return NULL;
    }

    /*
     * Search through the visuals that were returned to find the best
     * one.  The choice is based on the following criteria, in decreasing
     * order of importance:
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
 *
 *	Given a string identifying a colormap, this procedure finds
 *	an appropriate colormap.
 *
 * Results:
 *	The return value is normally the X resource identifier for the
 *	colormap.  If an error occurs, None is returned and an error
 *	message is placed in interp->result.
 *
 * Side effects:
 *	A reference count is incremented for the colormap, so
 *	Tk_FreeColormap must eventually be called exactly once for
 *	each call to Tk_GetColormap.
 *
 *----------------------------------------------------------------------







|







349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
 *
 *	Given a string identifying a colormap, this procedure finds
 *	an appropriate colormap.
 *
 * Results:
 *	The return value is normally the X resource identifier for the
 *	colormap.  If an error occurs, None is returned and an error
 *	message is placed in the interp's result.
 *
 * Side effects:
 *	A reference count is incremented for the colormap, so
 *	Tk_FreeColormap must eventually be called exactly once for
 *	each call to Tk_GetColormap.
 *
 *----------------------------------------------------------------------

Changes to generic/tkWindow.c.

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
 *
 * Copyright (c) 1989-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWindow.c 1.233 97/10/31 09:55:23
 */

#include "tkPort.h"
#include "tkInt.h"

/*

 * Count of number of main windows currently open in this process.
 */


static int numMainWindows;


/*


 * First in list of all main windows managed by this process.
 */

TkMainInfo *tkMainWindowList = NULL;

/*
 * List of all displays currently in use.
 */

TkDisplay *tkDisplayList = NULL;

/*
 * Have statics in this module been initialized?
 */

static int initialized = 0;

/*
 * The variables below hold several uid's that are used in many places
 * in the toolkit.

 */

Tk_Uid tkDisabledUid = NULL;
Tk_Uid tkActiveUid = NULL;
Tk_Uid tkNormalUid = NULL;


/*
 * Default values for "changes" and "atts" fields of TkWindows.  Note
 * that Tk always requests all events for all windows, except StructureNotify
 * events on internal windows:  these events are generated internally.
 */








|





<
>
|
<
>

<

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

|
<
<
>


<
<
<
>







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
 *
 * Copyright (c) 1989-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWindow.c,v 1.1.4.13 1999/04/09 23:32:33 redman Exp $
 */

#include "tkPort.h"
#include "tkInt.h"


#if !defined(__WIN32__) && !defined(MAC_TCL)
#include "tkUnixInt.h"

#endif



typedef struct ThreadSpecificData {
    int numMainWindows;    /* Count of numver of main windows currently
			    * open in this thread. */
    TkMainInfo *mainWindowList;
                           /* First in list of all main windows managed

			    * by this thread. */

    TkDisplay *displayList;

                           /* List of all displays currently in use by 

			    * the current thread. */

    int initialized;       /* 0 means the structures above need 

			    * initializing. */

} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/* 


 * The Mutex below is used to lock access to the Tk_Uids above. 
 */




TCL_DECLARE_MUTEX(windowMutex)

/*
 * Default values for "changes" and "atts" fields of TkWindows.  Note
 * that Tk always requests all events for all windows, except StructureNotify
 * events on internal windows:  these events are generated internally.
 */

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
typedef struct {
    char *name;			/* Name of command. */
    Tcl_CmdProc *cmdProc;	/* Command's string-based procedure. */
    Tcl_ObjCmdProc *objProc;	/* Command's object-based procedure. */
    int isSafe;			/* If !0, this command will be exposed in
                                 * a safe interpreter. Otherwise it will be
                                 * hidden in a safe interpreter. */




} TkCmd;

static TkCmd commands[] = {
    /*
     * Commands that are part of the intrinsics:
     */

    {"bell",		Tk_BellCmd,		NULL,			0},
    {"bind",		Tk_BindCmd,		NULL,			1},
    {"bindtags",	Tk_BindtagsCmd,		NULL,			1},
    {"clipboard",	Tk_ClipboardCmd,	NULL,			0},
    {"destroy",		Tk_DestroyCmd,		NULL,			1},
    {"event",		Tk_EventCmd,		NULL,			1},
    {"focus",		Tk_FocusCmd,		NULL,			1},
    {"font",		NULL,			Tk_FontObjCmd,		1},
    {"grab",		Tk_GrabCmd,		NULL,			0},
    {"grid",		Tk_GridCmd,		NULL,			1},
    {"image",		Tk_ImageCmd,		NULL,			1},
    {"lower",		Tk_LowerCmd,		NULL,			1},
    {"option",		Tk_OptionCmd,		NULL,			1},
    {"pack",		Tk_PackCmd,		NULL,			1},
    {"place",		Tk_PlaceCmd,		NULL,			1},
    {"raise",		Tk_RaiseCmd,		NULL,			1},
    {"selection",	Tk_SelectionCmd,	NULL,			0},
    {"tk",		NULL,			Tk_TkObjCmd,		0},
    {"tkwait",		Tk_TkwaitCmd,		NULL,			1},

    {"tk_chooseColor",  Tk_ChooseColorCmd,	NULL,			0},

    {"tk_getOpenFile",  Tk_GetOpenFileCmd,	NULL,			0},
    {"tk_getSaveFile",  Tk_GetSaveFileCmd,	NULL,			0},


    {"tk_messageBox",   Tk_MessageBoxCmd,	NULL,			0},

    {"update",		Tk_UpdateCmd,		NULL,			1},
    {"winfo",		NULL,			Tk_WinfoObjCmd,		1},
    {"wm",		Tk_WmCmd,		NULL,			0},

    /*
     * Widget class commands.
     */
    {"button",		Tk_ButtonCmd,		NULL,			1},

    {"canvas",		Tk_CanvasCmd,		NULL,			1},
    {"checkbutton",	Tk_CheckbuttonCmd,	NULL,			1},
    {"entry",		Tk_EntryCmd,		NULL,			1},
    {"frame",		Tk_FrameCmd,		NULL,			1},
    {"label",		Tk_LabelCmd,		NULL,			1},
    {"listbox",		Tk_ListboxCmd,		NULL,			1},
    {"menu",		Tk_MenuCmd,		NULL,			0},
    {"menubutton",	Tk_MenubuttonCmd,	NULL,			1},
    {"message",		Tk_MessageCmd,		NULL,			1},
    {"radiobutton",	Tk_RadiobuttonCmd,	NULL,			1},
    {"scale",		Tk_ScaleCmd,		NULL,			1},
    {"scrollbar",	Tk_ScrollbarCmd,	NULL,			1},
    {"text",		Tk_TextCmd,		NULL,			1},
    {"toplevel",	Tk_ToplevelCmd,		NULL,			0},

    /*
     * Misc.
     */

#ifdef MAC_TCL
    {"unsupported1",	TkUnsupported1Cmd,	NULL,			1},
#endif
    {(char *) NULL,	(int (*) _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **))) NULL, NULL, 0}
};
    
/*
 * The variables and table below are used to parse arguments from
 * the "argv" variable in Tk_Init.
 */

static int synchronize = 0;
static char *name = NULL;







>
>
>
>







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




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






|



|







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
typedef struct {
    char *name;			/* Name of command. */
    Tcl_CmdProc *cmdProc;	/* Command's string-based procedure. */
    Tcl_ObjCmdProc *objProc;	/* Command's object-based procedure. */
    int isSafe;			/* If !0, this command will be exposed in
                                 * a safe interpreter. Otherwise it will be
                                 * hidden in a safe interpreter. */
    int passMainWindow;		/* 0 means provide NULL clientData to
				 * command procedure; 1 means pass main
				 * window as clientData to command
				 * procedure. */
} TkCmd;

static TkCmd commands[] = {
    /*
     * Commands that are part of the intrinsics:
     */

    {"bell",		NULL,			Tk_BellObjCmd,		0, 1},
    {"bind",		Tk_BindCmd,		NULL,			1, 1},
    {"bindtags",	Tk_BindtagsCmd,		NULL,			1, 1},
    {"clipboard",	Tk_ClipboardCmd,	NULL,			0, 1},
    {"destroy",		Tk_DestroyCmd,		NULL,			1, 1},
    {"event",		NULL,			Tk_EventObjCmd,		1, 1},
    {"focus",		NULL,			Tk_FocusObjCmd,		1, 1},
    {"font",		NULL,			Tk_FontObjCmd,		1, 1},
    {"grab",		Tk_GrabCmd,		NULL,			0, 1},
    {"grid",		Tk_GridCmd,		NULL,			1, 1},
    {"image",		Tk_ImageCmd,		NULL,			1, 1},
    {"lower",		Tk_LowerCmd,		NULL,			1, 1},
    {"option",		Tk_OptionCmd,		NULL,			1, 1},
    {"pack",		Tk_PackCmd,		NULL,			1, 1},
    {"place",		Tk_PlaceCmd,		NULL,			1, 1},
    {"raise",		Tk_RaiseCmd,		NULL,			1, 1},
    {"selection",	Tk_SelectionCmd,	NULL,			0, 1},
    {"tk",		NULL,			Tk_TkObjCmd,		0, 1},
    {"tkwait",		Tk_TkwaitCmd,		NULL,			1, 1},
#if defined(__WIN32__) || defined(MAC_TCL)
    {"tk_chooseColor",  NULL,			Tk_ChooseColorObjCmd,	0, 1},
    {"tk_chooseDirectory", NULL,		Tk_ChooseDirectoryObjCmd, 0, 1},
    {"tk_getOpenFile",  NULL,			Tk_GetOpenFileObjCmd,	0, 1},
    {"tk_getSaveFile",  NULL,			Tk_GetSaveFileObjCmd,	0, 1},
#endif
#ifdef __WIN32__
    {"tk_messageBox",   NULL,			Tk_MessageBoxObjCmd,	0, 1},
#endif
    {"update",		NULL,			Tk_UpdateObjCmd,	1, 1},
    {"winfo",		NULL,			Tk_WinfoObjCmd,		1, 1},
    {"wm",		Tk_WmCmd,		NULL,			0, 1},

    /*
     * Widget class commands.
     */

    {"button",		NULL,			Tk_ButtonObjCmd,	1, 0},
    {"canvas",		Tk_CanvasCmd,		NULL,			1, 1},
    {"checkbutton",	NULL,			Tk_CheckbuttonObjCmd,	1, 0},
    {"entry",		NULL,                   Tk_EntryObjCmd,		1, 0},
    {"frame",		Tk_FrameCmd,		NULL,			1, 1},
    {"label",		NULL,			Tk_LabelObjCmd,		1, 0},
    {"listbox",		Tk_ListboxCmd,		NULL,			1, 1},

    {"menubutton",	NULL,                   Tk_MenubuttonObjCmd,	1, 0},
    {"message",		Tk_MessageCmd,		NULL,			1, 1},
    {"radiobutton",	NULL,			Tk_RadiobuttonObjCmd,	1, 0},
    {"scale",		NULL,	                Tk_ScaleObjCmd,		1, 0},
    {"scrollbar",	Tk_ScrollbarCmd,	NULL,			1, 1},
    {"text",		Tk_TextCmd,		NULL,			1, 1},
    {"toplevel",	Tk_ToplevelCmd,		NULL,			0, 1},

    /*
     * Misc.
     */

#ifdef MAC_TCL
    {"unsupported1",	TkUnsupported1Cmd,	NULL,			1, 1},
#endif
    {(char *) NULL,	(int (*) _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **))) NULL, NULL, 0}
};

/*
 * The variables and table below are used to parse arguments from
 * the "argv" variable in Tk_Init.
 */

static int synchronize = 0;
static char *name = NULL;
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
 *	Make a new window that will be at top-level (its parent will
 *	be the root window of a screen).
 *
 * Results:
 *	The return value is a token for the new window, or NULL if
 *	an error prevented the new window from being created.  If
 *	NULL is returned, an error message will be left in
 *	interp->result.
 *
 * Side effects:
 *	A new window structure is allocated locally.  An X
 *	window is NOT initially created, but will be created
 *	the first time the window is mapped.
 *
 *----------------------------------------------------------------------







|







218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
 *	Make a new window that will be at top-level (its parent will
 *	be the root window of a screen).
 *
 * Results:
 *	The return value is a token for the new window, or NULL if
 *	an error prevented the new window from being created.  If
 *	NULL is returned, an error message will be left in
 *	the interp's result.
 *
 * Side effects:
 *	A new window structure is allocated locally.  An X
 *	window is NOT initially created, but will be created
 *	the first time the window is mapped.
 *
 *----------------------------------------------------------------------
245
246
247
248
249
250
251


252
253
254
255
256
257
258
259
260
261
262
263
264
				 * variable to determine.  Empty string means
				 * use parent's screen, or DISPLAY if no
				 * parent. */
{
    register TkWindow *winPtr;
    register TkDisplay *dispPtr;
    int screenId;



    if (!initialized) {
	initialized = 1;
	tkActiveUid = Tk_GetUid("active");
	tkDisabledUid = Tk_GetUid("disabled");
	tkNormalUid = Tk_GetUid("normal");

	/*
	 * Create built-in image types.
	 */
    
	Tk_CreateImageType(&tkBitmapImageType);
	Tk_CreateImageType(&tkPhotoImageType);







>
>

|
|
<
<
<







246
247
248
249
250
251
252
253
254
255
256
257



258
259
260
261
262
263
264
				 * variable to determine.  Empty string means
				 * use parent's screen, or DISPLAY if no
				 * parent. */
{
    register TkWindow *winPtr;
    register TkDisplay *dispPtr;
    int screenId;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (!tsdPtr->initialized) {
	tsdPtr->initialized = 1;




	/*
	 * Create built-in image types.
	 */
    
	Tk_CreateImageType(&tkBitmapImageType);
	Tk_CreateImageType(&tkPhotoImageType);
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
 *	Given a string name for a display-plus-screen, find the
 *	TkDisplay structure for the display and return the screen
 *	number too.
 *
 * Results:
 *	The return value is a pointer to information about the display,
 *	or NULL if the display couldn't be opened.  In this case, an
 *	error message is left in interp->result.  The location at
 *	*screenPtr is overwritten with the screen number parsed from
 *	screenName.
 *
 * Side effects:
 *	A new connection is opened to the display if there is no
 *	connection already.  A new TkDisplay data structure is also
 *	setup, if necessary.







|







327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
 *	Given a string name for a display-plus-screen, find the
 *	TkDisplay structure for the display and return the screen
 *	number too.
 *
 * Results:
 *	The return value is a pointer to information about the display,
 *	or NULL if the display couldn't be opened.  In this case, an
 *	error message is left in the interp's result.  The location at
 *	*screenPtr is overwritten with the screen number parsed from
 *	screenName.
 *
 * Side effects:
 *	A new connection is opened to the display if there is no
 *	connection already.  A new TkDisplay data structure is also
 *	setup, if necessary.
350
351
352
353
354
355
356


357
358
359
360
361
362
363
364
365
366
367
368

369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405




406




407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425













426
427
428
429
430
431
432
433

434




435
436
437
438
439
440
441
442
443
444


445

446
447
448
449
450
451
452
				 * use DISPLAY envariable. */
    int *screenPtr;		/* Where to store screen number. */
{
    register TkDisplay *dispPtr;
    char *p;
    int screenId;
    size_t length;



    /*
     * Separate the screen number from the rest of the display
     * name.  ScreenName is assumed to have the syntax
     * <display>.<screen> with the dot and the screen being
     * optional.
     */

    screenName = TkGetDefaultScreenName(interp, screenName);
    if (screenName == NULL) {
	interp->result =
	    "no display name and no $DISPLAY environment variable";

	return (TkDisplay *) NULL;
    }
    length = strlen(screenName);
    screenId = 0;
    p = screenName+length-1;
    while (isdigit(UCHAR(*p)) && (p != screenName)) {
	p--;
    }
    if ((*p == '.') && (p[1] != '\0')) {
	length = p - screenName;
	screenId = strtoul(p+1, (char **) NULL, 10);
    }

    /*
     * See if we already have a connection to this display.  If not,
     * then open a new connection.
     */

    for (dispPtr = tkDisplayList; ; dispPtr = dispPtr->nextPtr) {
	if (dispPtr == NULL) {
	    dispPtr = TkpOpenDisplay(screenName);
	    if (dispPtr == NULL) {
		Tcl_AppendResult(interp, "couldn't connect to display \"",
			screenName, "\"", (char *) NULL);
		return (TkDisplay *) NULL;
	    }
	    dispPtr->nextPtr = tkDisplayList;
	    dispPtr->name = (char *) ckalloc((unsigned) (length+1));
	    dispPtr->lastEventTime = CurrentTime;
	    strncpy(dispPtr->name, screenName, length);
	    dispPtr->name[length] = '\0';
	    dispPtr->bindInfoStale = 1;
	    dispPtr->modeModMask = 0;
	    dispPtr->metaModMask = 0;
	    dispPtr->altModMask = 0;
	    dispPtr->numModKeyCodes = 0;
	    dispPtr->modKeyCodes = NULL;




	    OpenIM(dispPtr);




	    dispPtr->errorPtr = NULL;
	    dispPtr->deleteCount = 0;
	    dispPtr->commTkwin = NULL;
	    dispPtr->selectionInfoPtr = NULL;
	    dispPtr->multipleAtom = None;
	    dispPtr->clipWindow = NULL;
	    dispPtr->clipboardActive = 0;
	    dispPtr->clipboardAppPtr = NULL;
	    dispPtr->clipTargetPtr = NULL;
	    dispPtr->atomInit = 0;
	    dispPtr->cursorFont = None;
	    dispPtr->grabWinPtr = NULL;
	    dispPtr->eventualGrabWinPtr = NULL;
	    dispPtr->buttonWinPtr = NULL;
	    dispPtr->serverWinPtr = NULL;
	    dispPtr->firstGrabEventPtr = NULL;
	    dispPtr->lastGrabEventPtr = NULL;
	    dispPtr->grabFlags = 0;
	    TkInitXId(dispPtr);













	    dispPtr->destroyCount = 0;
	    dispPtr->lastDestroyRequest = 0;
	    dispPtr->cmapPtr = NULL;
	    dispPtr->implicitWinPtr = NULL;
	    dispPtr->focusPtr = NULL;
	    dispPtr->stressPtr = NULL;
	    dispPtr->delayedMotionPtr = NULL;
	    Tcl_InitHashTable(&dispPtr->winTable, TCL_ONE_WORD_KEYS);

            dispPtr->refCount = 0;




            
	    tkDisplayList = dispPtr;
	    break;
	}
	if ((strncmp(dispPtr->name, screenName, length) == 0)
		&& (dispPtr->name[length] == '\0')) {
	    break;
	}
    }
    if (screenId >= ScreenCount(dispPtr->display)) {


	sprintf(interp->result, "bad screen number \"%d\"", screenId);

	return (TkDisplay *) NULL;
    }
    *screenPtr = screenId;
    return dispPtr;
}

/*







>
>










|
|
>


















|







|


|
|






>
>
>
>
|
>
>
>
>


|
<
|
|
|
<
|
|
|







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



<
<
<
<

>

>
>
>
>
|
|








>
>
|
>







350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420

421
422
423

424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450




451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
				 * use DISPLAY envariable. */
    int *screenPtr;		/* Where to store screen number. */
{
    register TkDisplay *dispPtr;
    char *p;
    int screenId;
    size_t length;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Separate the screen number from the rest of the display
     * name.  ScreenName is assumed to have the syntax
     * <display>.<screen> with the dot and the screen being
     * optional.
     */

    screenName = TkGetDefaultScreenName(interp, screenName);
    if (screenName == NULL) {
	Tcl_SetResult(interp,
		"no display name and no $DISPLAY environment variable",
		TCL_STATIC);
	return (TkDisplay *) NULL;
    }
    length = strlen(screenName);
    screenId = 0;
    p = screenName+length-1;
    while (isdigit(UCHAR(*p)) && (p != screenName)) {
	p--;
    }
    if ((*p == '.') && (p[1] != '\0')) {
	length = p - screenName;
	screenId = strtoul(p+1, (char **) NULL, 10);
    }

    /*
     * See if we already have a connection to this display.  If not,
     * then open a new connection.
     */

    for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) {
	if (dispPtr == NULL) {
	    dispPtr = TkpOpenDisplay(screenName);
	    if (dispPtr == NULL) {
		Tcl_AppendResult(interp, "couldn't connect to display \"",
			screenName, "\"", (char *) NULL);
		return (TkDisplay *) NULL;
	    }
	    dispPtr->nextPtr = TkGetDisplayList();
	    dispPtr->name = (char *) ckalloc((unsigned) (length+1));
	    dispPtr->lastEventTime = CurrentTime;
	    dispPtr->borderInit = 0;
	    dispPtr->atomInit = 0;
	    dispPtr->bindInfoStale = 1;
	    dispPtr->modeModMask = 0;
	    dispPtr->metaModMask = 0;
	    dispPtr->altModMask = 0;
	    dispPtr->numModKeyCodes = 0;
	    dispPtr->modKeyCodes = NULL;
	    dispPtr->bitmapInit = 0;
	    dispPtr->bitmapAutoNumber = 0;
	    dispPtr->numIdSearches = 0;
	    dispPtr->numSlowSearches = 0;
	    dispPtr->colorInit = 0;
	    dispPtr->stressPtr = NULL;
	    dispPtr->cursorInit = 0;
	    dispPtr->cursorString[0] = '\0';
	    dispPtr->cursorFont = None;
	    dispPtr->errorPtr = NULL;
	    dispPtr->deleteCount = 0;
	    dispPtr->delayedMotionPtr = NULL;

	    dispPtr->focusDebug = 0;
	    dispPtr->implicitWinPtr = NULL;
	    dispPtr->focusPtr = NULL;

	    dispPtr->gcInit = 0;
	    dispPtr->geomInit = 0;
	    dispPtr->uidInit = 0;
	    dispPtr->grabWinPtr = NULL;
	    dispPtr->eventualGrabWinPtr = NULL;
	    dispPtr->buttonWinPtr = NULL;
	    dispPtr->serverWinPtr = NULL;
	    dispPtr->firstGrabEventPtr = NULL;
	    dispPtr->lastGrabEventPtr = NULL;
	    dispPtr->grabFlags = 0;
	    dispPtr->gridInit = 0;
	    dispPtr->imageId = 0;
	    dispPtr->packInit = 0;
	    dispPtr->placeInit = 0;
	    dispPtr->selectionInfoPtr = NULL;
	    dispPtr->multipleAtom = None;
	    dispPtr->clipWindow = NULL;
	    dispPtr->clipboardActive = 0;
	    dispPtr->clipboardAppPtr = NULL;
	    dispPtr->clipTargetPtr = NULL;
	    dispPtr->commTkwin = NULL;
	    dispPtr->wmTracing = 0;
	    dispPtr->firstWmPtr = NULL;
	    dispPtr->foregroundWmPtr = NULL;
	    dispPtr->destroyCount = 0;
	    dispPtr->lastDestroyRequest = 0;
	    dispPtr->cmapPtr = NULL;




	    Tcl_InitHashTable(&dispPtr->winTable, TCL_ONE_WORD_KEYS);

            dispPtr->refCount = 0;
	    strncpy(dispPtr->name, screenName, length);
	    dispPtr->name[length] = '\0';
	    OpenIM(dispPtr);
	    TkInitXId(dispPtr);

	    tsdPtr->displayList = dispPtr;
	    break;
	}
	if ((strncmp(dispPtr->name, screenName, length) == 0)
		&& (dispPtr->name[length] == '\0')) {
	    break;
	}
    }
    if (screenId >= ScreenCount(dispPtr->display)) {
	char buf[32 + TCL_INTEGER_SPACE];
	
	sprintf(buf, "bad screen number \"%d\"", screenId);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	return (TkDisplay *) NULL;
    }
    *screenPtr = screenId;
    return dispPtr;
}

/*
468
469
470
471
472
473
474


475
476
477
478
479
480
481
482
483
484




















































485
486
487
488
489
490
491
 */

TkDisplay *
TkGetDisplay(display)
     Display *display;          /* X's display pointer */
{
    TkDisplay *dispPtr;



    for (dispPtr = tkDisplayList; dispPtr != NULL;
	    dispPtr = dispPtr->nextPtr) {
	if (dispPtr->display == display) {
	    break;
	}
    }
    return dispPtr;
}





















































/*
 *--------------------------------------------------------------
 *
 * TkAllocWindow --
 *
 *	This procedure creates and initializes a TkWindow structure.
 *







>
>

|








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







494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
 */

TkDisplay *
TkGetDisplay(display)
     Display *display;          /* X's display pointer */
{
    TkDisplay *dispPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    for (dispPtr = tsdPtr->displayList; dispPtr != NULL;
	    dispPtr = dispPtr->nextPtr) {
	if (dispPtr->display == display) {
	    break;
	}
    }
    return dispPtr;
}

/*
 *--------------------------------------------------------------
 *
 * TkGetDisplayList --
 *
 *	This procedure returns a pointer to the thread-local
 *      list of TkDisplays corresponding to the open displays.
 *
 * Results:
 *	The return value is a pointer to the first TkDisplay
 *      structure in thread-local-storage.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */
TkDisplay *
TkGetDisplayList()
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    
    return tsdPtr->displayList;
}

/*
 *--------------------------------------------------------------
 *
 * TkGetMainInfoList --
 *
 *	This procedure returns a pointer to the list of structures
 *      containing information about all main windows for the
 *      current thread.
 *
 * Results:
 *	The return value is a pointer to the first TkMainInfo
 *      structure in thread local storage.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */
TkMainInfo *
TkGetMainInfoList()
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    
    return tsdPtr->mainWindowList;
}
/*
 *--------------------------------------------------------------
 *
 * TkAllocWindow --
 *
 *	This procedure creates and initializes a TkWindow structure.
 *
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
 *	top-level window used as the outermost window in an
 *	application.
 *
 * Results:
 *	The return value is a token for the new window, or NULL if
 *	an error prevented the new window from being created.  If
 *	NULL is returned, an error message will be left in
 *	interp->result.
 *
 * Side effects:
 *	A new window structure is allocated locally;  "interp" is
 *	associated with the window and registered for "send" commands
 *	under "baseName".  BaseName may be extended with an instance
 *	number in the form "#2" if necessary to make it globally
 *	unique.  Tk-related commands are bound into interp.







|







751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
 *	top-level window used as the outermost window in an
 *	application.
 *
 * Results:
 *	The return value is a token for the new window, or NULL if
 *	an error prevented the new window from being created.  If
 *	NULL is returned, an error message will be left in
 *	the interp's result.
 *
 * Side effects:
 *	A new window structure is allocated locally;  "interp" is
 *	associated with the window and registered for "send" commands
 *	under "baseName".  BaseName may be extended with an instance
 *	number in the form "#2" if necessary to make it globally
 *	unique.  Tk-related commands are bound into interp.
699
700
701
702
703
704
705



706
707
708
709
710
711
712
    Tk_Window tkwin;
    int dummy;
    int isSafe;
    Tcl_HashEntry *hPtr;
    register TkMainInfo *mainPtr;
    register TkWindow *winPtr;
    register TkCmd *cmdPtr;



    
    /*
     * Panic if someone updated the TkWindow structure without
     * also updating the Tk_FakeWin structure (or vice versa).
     */

    if (sizeof(TkWindow) != sizeof(Tk_FakeWin)) {







>
>
>







779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
    Tk_Window tkwin;
    int dummy;
    int isSafe;
    Tcl_HashEntry *hPtr;
    register TkMainInfo *mainPtr;
    register TkWindow *winPtr;
    register TkCmd *cmdPtr;
    ClientData clientData;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    
    /*
     * Panic if someone updated the TkWindow structure without
     * also updating the Tk_FakeWin structure (or vice versa).
     */

    if (sizeof(TkWindow) != sizeof(Tk_FakeWin)) {
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

    winPtr = (TkWindow *) tkwin;
    mainPtr = (TkMainInfo *) ckalloc(sizeof(TkMainInfo));
    mainPtr->winPtr = winPtr;
    mainPtr->refCount = 1;
    mainPtr->interp = interp;
    Tcl_InitHashTable(&mainPtr->nameTable, TCL_STRING_KEYS);

    TkBindInit(mainPtr);
    TkFontPkgInit(mainPtr);
    mainPtr->tlFocusPtr = NULL;
    mainPtr->displayFocusPtr = NULL;
    mainPtr->optionRootPtr = NULL;
    Tcl_InitHashTable(&mainPtr->imageTable, TCL_STRING_KEYS);
    mainPtr->strictMotif = 0;
    if (Tcl_LinkVar(interp, "tk_strictMotif", (char *) &mainPtr->strictMotif,
	    TCL_LINK_BOOLEAN) != TCL_OK) {
	Tcl_ResetResult(interp);
    }
    mainPtr->nextPtr = tkMainWindowList;
    tkMainWindowList = mainPtr;
    winPtr->mainPtr = mainPtr;
    hPtr = Tcl_CreateHashEntry(&mainPtr->nameTable, ".", &dummy);
    Tcl_SetHashValue(hPtr, winPtr);
    winPtr->pathName = Tcl_GetHashKey(&mainPtr->nameTable, hPtr);

    /*
     * We have just created another Tk application; increment the refcount







>











|
|







813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840

    winPtr = (TkWindow *) tkwin;
    mainPtr = (TkMainInfo *) ckalloc(sizeof(TkMainInfo));
    mainPtr->winPtr = winPtr;
    mainPtr->refCount = 1;
    mainPtr->interp = interp;
    Tcl_InitHashTable(&mainPtr->nameTable, TCL_STRING_KEYS);
    TkEventInit();
    TkBindInit(mainPtr);
    TkFontPkgInit(mainPtr);
    mainPtr->tlFocusPtr = NULL;
    mainPtr->displayFocusPtr = NULL;
    mainPtr->optionRootPtr = NULL;
    Tcl_InitHashTable(&mainPtr->imageTable, TCL_STRING_KEYS);
    mainPtr->strictMotif = 0;
    if (Tcl_LinkVar(interp, "tk_strictMotif", (char *) &mainPtr->strictMotif,
	    TCL_LINK_BOOLEAN) != TCL_OK) {
	Tcl_ResetResult(interp);
    }
    mainPtr->nextPtr = tsdPtr->mainWindowList;
    tsdPtr->mainWindowList = mainPtr;
    winPtr->mainPtr = mainPtr;
    hPtr = Tcl_CreateHashEntry(&mainPtr->nameTable, ".", &dummy);
    Tcl_SetHashValue(hPtr, winPtr);
    winPtr->pathName = Tcl_GetHashKey(&mainPtr->nameTable, hPtr);

    /*
     * We have just created another Tk application; increment the refcount
770
771
772
773
774
775
776





777
778
779
780
781
782
783
784
785
786
787
788
789
790


791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
     */

    isSafe = Tcl_IsSafe(interp);
    for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
	if ((cmdPtr->cmdProc == NULL) && (cmdPtr->objProc == NULL)) {
	    panic("TkCreateMainWindow: builtin command with NULL string and object procs");
	}





	if (cmdPtr->cmdProc != NULL) {
	    Tcl_CreateCommand(interp, cmdPtr->name, cmdPtr->cmdProc,
		    (ClientData) tkwin, (void (*) _ANSI_ARGS_((ClientData))) NULL);
	} else {
	    Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc,
		    (ClientData) tkwin, NULL);
	}
        if (isSafe) {
            if (!(cmdPtr->isSafe)) {
                Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name);
            }
        }
    }



    /*
     * Set variables for the intepreter.
     */

    Tcl_SetVar(interp, "tk_patchLevel", TK_PATCH_LEVEL, TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "tk_version", TK_VERSION, TCL_GLOBAL_ONLY);

    numMainWindows++;
    return tkwin;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_CreateWindow --
 *
 *	Create a new internal or top-level window as a child of an
 *	existing window.
 *
 * Results:
 *	The return value is a token for the new window.  This
 *	is not the same as X's token for the window.  If an error
 *	occurred in creating the window (e.g. no such display or
 *	screen), then an error message is left in interp->result and
 *	NULL is returned.
 *
 * Side effects:
 *	A new window structure is allocated locally.  An X
 *	window is not initially created, but will be created
 *	the first time the window is mapped.
 *
 *--------------------------------------------------------------
 */

Tk_Window
Tk_CreateWindow(interp, parent, name, screenName)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting.
				 * Interp->result is assumed to be
				 * initialized by the caller. */
    Tk_Window parent;		/* Token for parent of new window. */
    char *name;			/* Name for new window.  Must be unique
				 * among parent's children. */
    char *screenName;		/* If NULL, new window will be internal on
				 * same screen as its parent.  If non-NULL,
				 * gives name of screen on which to create







>
>
>
>
>


|


|








>
>







|















|













|







854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
     */

    isSafe = Tcl_IsSafe(interp);
    for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
	if ((cmdPtr->cmdProc == NULL) && (cmdPtr->objProc == NULL)) {
	    panic("TkCreateMainWindow: builtin command with NULL string and object procs");
	}
	if (cmdPtr->passMainWindow) {
	    clientData = (ClientData) tkwin;
	} else {
	    clientData = (ClientData) NULL;
	}
	if (cmdPtr->cmdProc != NULL) {
	    Tcl_CreateCommand(interp, cmdPtr->name, cmdPtr->cmdProc,
		    clientData, (void (*) _ANSI_ARGS_((ClientData))) NULL);
	} else {
	    Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc,
		    clientData, NULL);
	}
        if (isSafe) {
            if (!(cmdPtr->isSafe)) {
                Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name);
            }
        }
    }

    TkCreateMenuCmd(interp);

    /*
     * Set variables for the intepreter.
     */

    Tcl_SetVar(interp, "tk_patchLevel", TK_PATCH_LEVEL, TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "tk_version", TK_VERSION, TCL_GLOBAL_ONLY);

    tsdPtr->numMainWindows++;
    return tkwin;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_CreateWindow --
 *
 *	Create a new internal or top-level window as a child of an
 *	existing window.
 *
 * Results:
 *	The return value is a token for the new window.  This
 *	is not the same as X's token for the window.  If an error
 *	occurred in creating the window (e.g. no such display or
 *	screen), then an error message is left in the interp's result and
 *	NULL is returned.
 *
 * Side effects:
 *	A new window structure is allocated locally.  An X
 *	window is not initially created, but will be created
 *	the first time the window is mapped.
 *
 *--------------------------------------------------------------
 */

Tk_Window
Tk_CreateWindow(interp, parent, name, screenName)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting.
				 * the interp's result is assumed to be
				 * initialized by the caller. */
    Tk_Window parent;		/* Token for parent of new window. */
    char *name;			/* Name for new window.  Must be unique
				 * among parent's children. */
    char *screenName;		/* If NULL, new window will be internal on
				 * same screen as its parent.  If non-NULL,
				 * gives name of screen on which to create
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
 *	it uses a path name to create the window, rather than a
 *	parent and a child name.
 *
 * Results:
 *	The return value is a token for the new window.  This
 *	is not the same as X's token for the window.  If an error
 *	occurred in creating the window (e.g. no such display or
 *	screen), then an error message is left in interp->result and
 *	NULL is returned.
 *
 * Side effects:
 *	A new window structure is allocated locally.  An X
 *	window is not initially created, but will be created
 *	the first time the window is mapped.
 *
 *----------------------------------------------------------------------
 */

Tk_Window
Tk_CreateWindowFromPath(interp, tkwin, pathName, screenName)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting.
				 * Interp->result is assumed to be
				 * initialized by the caller. */
    Tk_Window tkwin;		/* Token for any window in application
				 * that is to contain new window. */
    char *pathName;		/* Path name for new window within the
				 * application of tkwin.  The parent of
				 * this window must already exist, but
				 * the window itself must not exist. */







|













|







965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
 *	it uses a path name to create the window, rather than a
 *	parent and a child name.
 *
 * Results:
 *	The return value is a token for the new window.  This
 *	is not the same as X's token for the window.  If an error
 *	occurred in creating the window (e.g. no such display or
 *	screen), then an error message is left in the interp's result and
 *	NULL is returned.
 *
 * Side effects:
 *	A new window structure is allocated locally.  An X
 *	window is not initially created, but will be created
 *	the first time the window is mapped.
 *
 *----------------------------------------------------------------------
 */

Tk_Window
Tk_CreateWindowFromPath(interp, tkwin, pathName, screenName)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting.
				 * the interp's result is assumed to be
				 * initialized by the caller. */
    Tk_Window tkwin;		/* Token for any window in application
				 * that is to contain new window. */
    char *pathName;		/* Path name for new window within the
				 * application of tkwin.  The parent of
				 * this window must already exist, but
				 * the window itself must not exist. */
1007
1008
1009
1010
1011
1012
1013


1014
1015
1016
1017
1018
1019
1020
void
Tk_DestroyWindow(tkwin)
    Tk_Window tkwin;		/* Window to destroy. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    TkDisplay *dispPtr = winPtr->dispPtr;
    XEvent event;



    if (winPtr->flags & TK_ALREADY_DEAD) {
	/*
	 * A destroy event binding caused the window to be destroyed
	 * again.  Ignore the request.
	 */








>
>







1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
void
Tk_DestroyWindow(tkwin)
    Tk_Window tkwin;		/* Window to destroy. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    TkDisplay *dispPtr = winPtr->dispPtr;
    XEvent event;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (winPtr->flags & TK_ALREADY_DEAD) {
	/*
	 * A destroy event binding caused the window to be destroyed
	 * again.  Ignore the request.
	 */

1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
     * Also decrement the display refcount so that if this is the
     * last Tk application in this process on this display, the display
     * can be closed and its data structures deleted.
     */

    if (winPtr->mainPtr->winPtr == winPtr) {
        dispPtr->refCount--;
	if (tkMainWindowList == winPtr->mainPtr) {
	    tkMainWindowList = winPtr->mainPtr->nextPtr;
	} else {
	    TkMainInfo *prevPtr;

	    for (prevPtr = tkMainWindowList;
		    prevPtr->nextPtr != winPtr->mainPtr;
		    prevPtr = prevPtr->nextPtr) {
		/* Empty loop body. */
	    }
	    prevPtr->nextPtr = winPtr->mainPtr->nextPtr;
	}
	numMainWindows--;
    }

    /*
     * Recursively destroy children.
     */

    dispPtr->destroyCount++;







|
|



|






|







1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
     * Also decrement the display refcount so that if this is the
     * last Tk application in this process on this display, the display
     * can be closed and its data structures deleted.
     */

    if (winPtr->mainPtr->winPtr == winPtr) {
        dispPtr->refCount--;
	if (tsdPtr->mainWindowList == winPtr->mainPtr) {
	    tsdPtr->mainWindowList = winPtr->mainPtr->nextPtr;
	} else {
	    TkMainInfo *prevPtr;

	    for (prevPtr = tsdPtr->mainWindowList;
		    prevPtr->nextPtr != winPtr->mainPtr;
		    prevPtr = prevPtr->nextPtr) {
		/* Empty loop body. */
	    }
	    prevPtr->nextPtr = winPtr->mainPtr->nextPtr;
	}
	tsdPtr->numMainWindows--;
    }

    /*
     * Recursively destroy children.
     */

    dispPtr->destroyCount++;
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
                        TkDeadAppCmd, (ClientData) NULL, 
                        (void (*) _ANSI_ARGS_((ClientData))) NULL);
                Tcl_UnlinkVar(winPtr->mainPtr->interp, "tk_strictMotif");
            }
                
	    Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable);
	    TkBindFree(winPtr->mainPtr);
	    TkFontPkgFree(winPtr->mainPtr);
	    TkDeleteAllImages(winPtr->mainPtr);

            /*
             * When embedding Tk into other applications, make sure 
             * that all destroy events reach the server. Otherwise
             * the embedding application may also attempt to destroy
             * the windows, resulting in an X error
             */







|
|







1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
                        TkDeadAppCmd, (ClientData) NULL, 
                        (void (*) _ANSI_ARGS_((ClientData))) NULL);
                Tcl_UnlinkVar(winPtr->mainPtr->interp, "tk_strictMotif");
            }
                
	    Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable);
	    TkBindFree(winPtr->mainPtr);
	    TkDeleteAllImages(winPtr->mainPtr);
	    TkFontPkgFree(winPtr->mainPtr);

            /*
             * When embedding Tk into other applications, make sure 
             * that all destroy events reach the server. Otherwise
             * the embedding application may also attempt to destroy
             * the windows, resulting in an X error
             */
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
                
                TkDisplay *theDispPtr, *backDispPtr;
                
                /*
                 * Splice this display out of the list of displays.
                 */
                
                for (theDispPtr = tkDisplayList, backDispPtr = NULL;
                         (theDispPtr != winPtr->dispPtr) &&
                             (theDispPtr != NULL);
                         theDispPtr = theDispPtr->nextPtr) {
                    backDispPtr = theDispPtr;
                }
                if (theDispPtr == NULL) {
                    panic("could not find display to close!");
                }
                if (backDispPtr == NULL) {
                    tkDisplayList = theDispPtr->nextPtr;
                } else {
                    backDispPtr->nextPtr = theDispPtr->nextPtr;
                }
                
                /*
                 * Found and spliced it out, now actually do the cleanup.
                 */







|









|







1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
                
                TkDisplay *theDispPtr, *backDispPtr;
                
                /*
                 * Splice this display out of the list of displays.
                 */
                
                for (theDispPtr = displayList, backDispPtr = NULL;
                         (theDispPtr != winPtr->dispPtr) &&
                             (theDispPtr != NULL);
                         theDispPtr = theDispPtr->nextPtr) {
                    backDispPtr = theDispPtr;
                }
                if (theDispPtr == NULL) {
                    panic("could not find display to close!");
                }
                if (backDispPtr == NULL) {
                    displayList = theDispPtr->nextPtr;
                } else {
                    backDispPtr->nextPtr = theDispPtr->nextPtr;
                }
                
                /*
                 * Found and spliced it out, now actually do the cleanup.
                 */
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
 *	Given a string name for a window, this procedure
 *	returns the token for the window, if there exists a
 *	window corresponding to the given name.
 *
 * Results:
 *	The return result is either a token for the window corresponding
 *	to "name", or else NULL to indicate that there is no such
 *	window.  In this case, an error message is left in interp->result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */








|







2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
 *	Given a string name for a window, this procedure
 *	returns the token for the window, if there exists a
 *	window corresponding to the given name.
 *
 * Results:
 *	The return result is either a token for the window corresponding
 *	to "name", or else NULL to indicate that there is no such
 *	window.  In this case, an error message is left in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
Tk_IdToWindow(display, window)
    Display *display;		/* X display containing the window. */
    Window window;		/* X window window id. */
{
    TkDisplay *dispPtr;
    Tcl_HashEntry *hPtr;

    for (dispPtr = tkDisplayList; ; dispPtr = dispPtr->nextPtr) {
	if (dispPtr == NULL) {
	    return NULL;
	}
	if (dispPtr->display == display) {
	    break;
	}
    }







|







2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
Tk_IdToWindow(display, window)
    Display *display;		/* X display containing the window. */
    Window window;		/* X window window id. */
{
    TkDisplay *dispPtr;
    Tcl_HashEntry *hPtr;

    for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) {
	if (dispPtr == NULL) {
	    return NULL;
	}
	if (dispPtr->display == display) {
	    break;
	}
    }
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291


2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
 * Tk_MainWindow --
 *
 *	Returns the main window for an application.
 *
 * Results:
 *	If interp has a Tk application associated with it, the main
 *	window for the application is returned.  Otherwise NULL is
 *	returned and an error message is left in interp->result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tk_Window
Tk_MainWindow(interp)
    Tcl_Interp *interp;			/* Interpreter that embodies the
					 * application.  Used for error
					 * reporting also. */
{
    TkMainInfo *mainPtr;



    for (mainPtr = tkMainWindowList; mainPtr != NULL;
	    mainPtr = mainPtr->nextPtr) {
	if (mainPtr->interp == interp) {
	    return (Tk_Window) mainPtr->winPtr;
	}
    }
    interp->result = "this isn't a Tk application";
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_StrictMotif --







|














>
>

|





|







2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
 * Tk_MainWindow --
 *
 *	Returns the main window for an application.
 *
 * Results:
 *	If interp has a Tk application associated with it, the main
 *	window for the application is returned.  Otherwise NULL is
 *	returned and an error message is left in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tk_Window
Tk_MainWindow(interp)
    Tcl_Interp *interp;			/* Interpreter that embodies the
					 * application.  Used for error
					 * reporting also. */
{
    TkMainInfo *mainPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    for (mainPtr = tsdPtr->mainWindowList; mainPtr != NULL;
	    mainPtr = mainPtr->nextPtr) {
	if (mainPtr->interp == interp) {
	    return (Tk_Window) mainPtr->winPtr;
	}
    }
    Tcl_SetResult(interp, "this isn't a Tk application", TCL_STATIC);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_StrictMotif --
2403
2404
2405
2406
2407
2408
2409



2410
2411
2412
2413
2414
2415
2416
2417
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetNumMainWindows()
{



    return numMainWindows;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteWindowsExitProc --
 *







>
>
>
|







2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetNumMainWindows()
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    return tsdPtr->numMainWindows;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteWindowsExitProc --
 *
2429
2430
2431
2432
2433
2434
2435


2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474

2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514

static void
DeleteWindowsExitProc(clientData)
    ClientData clientData;		/* Not used. */
{
    TkDisplay *displayPtr, *nextPtr;
    Tcl_Interp *interp;


    
    while (tkMainWindowList != NULL) {
        /*
         * We must protect the interpreter while deleting the window,
         * because of <Destroy> bindings which could destroy the interpreter
         * while the window is being deleted. This would leave frames on
         * the call stack pointing at deleted memory, causing core dumps.
         */
        
        interp = tkMainWindowList->winPtr->mainPtr->interp;
        Tcl_Preserve((ClientData) interp);
	Tk_DestroyWindow((Tk_Window) tkMainWindowList->winPtr);
        Tcl_Release((ClientData) interp);
    }
    
    displayPtr = tkDisplayList;
    tkDisplayList = NULL;
    
    /*
     * Iterate destroying the displays until no more displays remain.
     * It is possible for displays to get recreated during exit by any
     * code that calls GetScreen, so we must destroy these new displays
     * as well as the old ones.
     */
    
    for (displayPtr = tkDisplayList;
         displayPtr != NULL;
         displayPtr = tkDisplayList) {

        /*
         * Now iterate over the current list of open displays, and first
         * set the global pointer to NULL so we will be able to notice if
         * any new displays got created during deletion of the current set.
         * We must also do this to ensure that Tk_IdToWindow does not find
         * the old display as it is being destroyed, when it wants to see
         * if it needs to dispatch a message.
         */
        
        for (tkDisplayList = NULL; displayPtr != NULL; displayPtr = nextPtr) {

            nextPtr = displayPtr->nextPtr;
            if (displayPtr->name != (char *) NULL) {
                ckfree(displayPtr->name);
            }
            Tcl_DeleteHashTable(&(displayPtr->winTable));
            TkpCloseDisplay(displayPtr);
        }
    }
    
    numMainWindows = 0;
    tkMainWindowList = NULL;
    initialized = 0;
    tkDisabledUid = NULL;
    tkActiveUid = NULL;
    tkNormalUid = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_Init --
 *
 *	This procedure is invoked to add Tk to an interpreter.  It
 *	incorporates all of Tk's commands into the interpreter and
 *	creates the main window for a new Tk application.  If the
 *	interpreter contains a variable "argv", this procedure
 *	extracts several arguments from that variable, uses them
 *	to configure the main window, and modifies argv to exclude
 *	the arguments (see the "wish" documentation for a list of
 *	the arguments that are extracted).
 *
 * Results:
 *	Returns a standard Tcl completion code and sets interp->result
 *	if there is an error.
 *
 * Side effects:
 *	Depends on various initialization scripts that get invoked.
 *
 *----------------------------------------------------------------------
 */







>
>

|







|

|



|
|








|

|










|
>









|
|
|
<
<
<

















|







2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587



2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612

static void
DeleteWindowsExitProc(clientData)
    ClientData clientData;		/* Not used. */
{
    TkDisplay *displayPtr, *nextPtr;
    Tcl_Interp *interp;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    
    while (tsdPtr->mainWindowList != NULL) {
        /*
         * We must protect the interpreter while deleting the window,
         * because of <Destroy> bindings which could destroy the interpreter
         * while the window is being deleted. This would leave frames on
         * the call stack pointing at deleted memory, causing core dumps.
         */
        
        interp = tsdPtr->mainWindowList->winPtr->mainPtr->interp;
        Tcl_Preserve((ClientData) interp);
	Tk_DestroyWindow((Tk_Window) tsdPtr->mainWindowList->winPtr);
        Tcl_Release((ClientData) interp);
    }
    
    displayPtr = tsdPtr->displayList;
    tsdPtr->displayList = NULL;
    
    /*
     * Iterate destroying the displays until no more displays remain.
     * It is possible for displays to get recreated during exit by any
     * code that calls GetScreen, so we must destroy these new displays
     * as well as the old ones.
     */
    
    for (displayPtr = tsdPtr->displayList;
         displayPtr != NULL;
         displayPtr = tsdPtr->displayList) {

        /*
         * Now iterate over the current list of open displays, and first
         * set the global pointer to NULL so we will be able to notice if
         * any new displays got created during deletion of the current set.
         * We must also do this to ensure that Tk_IdToWindow does not find
         * the old display as it is being destroyed, when it wants to see
         * if it needs to dispatch a message.
         */
        
        for (tsdPtr->displayList = NULL; displayPtr != NULL; 
                displayPtr = nextPtr) {
            nextPtr = displayPtr->nextPtr;
            if (displayPtr->name != (char *) NULL) {
                ckfree(displayPtr->name);
            }
            Tcl_DeleteHashTable(&(displayPtr->winTable));
            TkpCloseDisplay(displayPtr);
        }
    }
    
    tsdPtr->numMainWindows = 0;
    tsdPtr->mainWindowList = NULL;
    tsdPtr->initialized = 0;



}

/*
 *----------------------------------------------------------------------
 *
 * Tk_Init --
 *
 *	This procedure is invoked to add Tk to an interpreter.  It
 *	incorporates all of Tk's commands into the interpreter and
 *	creates the main window for a new Tk application.  If the
 *	interpreter contains a variable "argv", this procedure
 *	extracts several arguments from that variable, uses them
 *	to configure the main window, and modifies argv to exclude
 *	the arguments (see the "wish" documentation for a list of
 *	the arguments that are extracted).
 *
 * Results:
 *	Returns a standard Tcl completion code and sets the interp's result
 *	if there is an error.
 *
 * Side effects:
 *	Depends on various initialization scripts that get invoked.
 *
 *----------------------------------------------------------------------
 */
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
 *
 * Tk_SafeInit --
 *
 *	This procedure is invoked to add Tk to a safe interpreter. It
 *	invokes the internal procedure that does the real work.
 *
 * Results:
 *	Returns a standard Tcl completion code and sets interp->result
 *	if there is an error.
 *
 * Side effects:
 *	Depends on various initialization scripts that are invoked.
 *
 *----------------------------------------------------------------------
 */







|







2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
 *
 * Tk_SafeInit --
 *
 *	This procedure is invoked to add Tk to a safe interpreter. It
 *	invokes the internal procedure that does the real work.
 *
 * Results:
 *	Returns a standard Tcl completion code and sets the interp's result
 *	if there is an error.
 *
 * Side effects:
 *	Depends on various initialization scripts that are invoked.
 *
 *----------------------------------------------------------------------
 */
2578
2579
2580
2581
2582
2583
2584



2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608

2609











2610
2611
2612
2613
2614
2615
2616

2617
2618
2619
2620
2621
2622
2623
2624
2625
2626











































































2627
2628
2629
2630
2631
2632

2633
2634


2635
2636
2637
2638

2639
2640
2641
2642
2643
2644
2645
     *  The actual code called is the same as Tk_Init but Tcl_IsSafe()
     *  is checked at several places to differentiate the two initialisations.
     */

    return Initialize(interp);
}




/*
 *----------------------------------------------------------------------
 *
 * Initialize --
 *
 *
 * Results:
 *	A standard Tcl result. Also leaves an error message in interp->result
 *	if there was an error.
 *
 * Side effects:
 *	Depends on the initialization scripts that are invoked.
 *
 *----------------------------------------------------------------------
 */

static int
Initialize(interp)
    Tcl_Interp *interp;		/* Interpreter to initialize. */
{
    char *p;
    int argc, code;
    char **argv, *args[20];
    Tcl_DString class;

    char buffer[30];












    /*
     * Start by initializing all the static variables to default acceptable
     * values so that no information is leaked from a previous run of this
     * code.
     */


    synchronize = 0;
    name = NULL;
    display = NULL;
    geometry = NULL;
    colormap = NULL;
    use = NULL;
    visual = NULL;
    rest = 0;

    /*











































































     * If there is an "argv" variable, get its value, extract out
     * relevant arguments from it, and rewrite the variable without
     * the arguments that we used.
     */

    p = Tcl_GetVar2(interp, "argv", (char *) NULL, TCL_GLOBAL_ONLY);

    argv = NULL;
    if (p != NULL) {


	if (Tcl_SplitList(interp, p, &argc, &argv) != TCL_OK) {
	    argError:
	    Tcl_AddErrorInfo(interp,
		    "\n    (processing arguments in argv variable)");

	    return TCL_ERROR;
	}
	if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv,
		argTable, TK_ARGV_DONT_SKIP_FIRST_ARG|TK_ARGV_NO_DEFAULTS)
		!= TCL_OK) {
	    ckfree((char *) argv);
	    goto argError;







>
>
>







|
|















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







>










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

|
>


>
>




>







2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
     *  The actual code called is the same as Tk_Init but Tcl_IsSafe()
     *  is checked at several places to differentiate the two initialisations.
     */

    return Initialize(interp);
}


extern TkStubs tkStubs;

/*
 *----------------------------------------------------------------------
 *
 * Initialize --
 *
 *
 * Results:
 *	A standard Tcl result. Also leaves an error message in the interp's
 *	result if there was an error.
 *
 * Side effects:
 *	Depends on the initialization scripts that are invoked.
 *
 *----------------------------------------------------------------------
 */

static int
Initialize(interp)
    Tcl_Interp *interp;		/* Interpreter to initialize. */
{
    char *p;
    int argc, code;
    char **argv, *args[20];
    Tcl_DString class;
    ThreadSpecificData *tsdPtr;
    
    /*
     * Ensure that we are getting the matching version of Tcl.  This is
     * really only an issue when Tk is loaded dynamically.
     */

    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
        return TCL_ERROR;
    }

    tsdPtr = (ThreadSpecificData *) 
	Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Start by initializing all the static variables to default acceptable
     * values so that no information is leaked from a previous run of this
     * code.
     */

    Tcl_MutexLock(&windowMutex);
    synchronize = 0;
    name = NULL;
    display = NULL;
    geometry = NULL;
    colormap = NULL;
    use = NULL;
    visual = NULL;
    rest = 0;

    /*
     * We start by resetting the result because it might not be clean
     */
    Tcl_ResetResult(interp);

    if (Tcl_IsSafe(interp)) {
	/*
	 * Get the clearance to start Tk and the "argv" parameters
	 * from the master.
	 */
	Tcl_DString ds;
	
	/*
	 * Step 1 : find the master and construct the interp name
	 * (could be a function if new APIs were ok).
	 * We could also construct the path while walking, but there
	 * is no API to get the name of an interp either.
	 */
	Tcl_Interp *master = interp;

	while (1) {
	    master = Tcl_GetMaster(master);
	    if (master == NULL) {
		Tcl_DStringFree(&ds);
		Tcl_AppendResult(interp, "NULL master", (char *) NULL);
		Tcl_MutexUnlock(&windowMutex);
		return TCL_ERROR;
	    }
	    if (!Tcl_IsSafe(master)) {
		/* Found the trusted master. */
		break;
	    }
	}
	/*
	 * Construct the name (rewalk...)
	 */
	if (Tcl_GetInterpPath(master, interp) != TCL_OK) {
	    Tcl_AppendResult(interp, "error in Tcl_GetInterpPath",
		    (char *) NULL);
	    Tcl_MutexUnlock(&windowMutex);
	    return TCL_ERROR;
	}
	/*
	 * Build the string to eval.
	 */
	Tcl_DStringInit(&ds);
	Tcl_DStringAppendElement(&ds, "::safe::TkInit");
	Tcl_DStringAppendElement(&ds, Tcl_GetStringResult(master));
	
	/*
	 * Step 2 : Eval in the master. The argument is the *reversed*
	 * interp path of the slave.
	 */
	
	if (Tcl_Eval(master, Tcl_DStringValue(&ds)) != TCL_OK) {
	    /*
	     * We might want to transfer the error message or not.
	     * We don't. (no API to do it and maybe security reasons).
	     */
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp, 
		    "not allowed to start Tk by master's safe::TkInit",
		    (char *) NULL);
	    Tcl_MutexUnlock(&windowMutex);
	    return TCL_ERROR;
	}
	Tcl_DStringFree(&ds);
	/* 
	 * Use the master's result as argv.
	 * Note: We don't use the Obj interfaces to avoid dealing with
	 * cross interp refcounting and changing the code below.
	 */

	p = Tcl_GetStringResult(master);
    } else {
	/*
	 * If there is an "argv" variable, get its value, extract out
	 * relevant arguments from it, and rewrite the variable without
	 * the arguments that we used.
	 */

	p = Tcl_GetVar2(interp, "argv", (char *) NULL, TCL_GLOBAL_ONLY);
    }
    argv = NULL;
    if (p != NULL) {
	char buffer[TCL_INTEGER_SPACE];

	if (Tcl_SplitList(interp, p, &argc, &argv) != TCL_OK) {
	    argError:
	    Tcl_AddErrorInfo(interp,
		    "\n    (processing arguments in argv variable)");
	    Tcl_MutexUnlock(&windowMutex);
	    return TCL_ERROR;
	}
	if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv,
		argTable, TK_ARGV_DONT_SKIP_FIRST_ARG|TK_ARGV_NO_DEFAULTS)
		!= TCL_OK) {
	    ckfree((char *) argv);
	    goto argError;
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
	Tcl_DStringAppend(&class, Tcl_DStringValue(&class), offset-1);
	name = Tcl_DStringValue(&class) + offset;
    } else {
	Tcl_DStringAppend(&class, name, -1);
    }

    p = Tcl_DStringValue(&class);
    if (islower(UCHAR(*p))) {
	*p = toupper(UCHAR(*p));
    }

    /*
     * Create an argument list for creating the top-level window,
     * using the information parsed from argv, if any.
     */








|
|







2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
	Tcl_DStringAppend(&class, Tcl_DStringValue(&class), offset-1);
	name = Tcl_DStringValue(&class) + offset;
    } else {
	Tcl_DStringAppend(&class, name, -1);
    }

    p = Tcl_DStringValue(&class);
    if (*p) {
	Tcl_UtfToTitle(p);
    }

    /*
     * Create an argument list for creating the top-level window,
     * using the information parsed from argv, if any.
     */

2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703

	/*
	 * If this is the first application for this process, save
	 * the display name in the DISPLAY environment variable so
	 * that it will be available to subprocesses created by us.
	 */

	if (numMainWindows == 0) {
	    Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
	}
    }
    if (colormap != NULL) {
	args[argc] = "-colormap";
	args[argc+1] = colormap;
	argc += 2;







|







2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896

	/*
	 * If this is the first application for this process, save
	 * the display name in the DISPLAY environment variable so
	 * that it will be available to subprocesses created by us.
	 */

	if (tsdPtr->numMainWindows == 0) {
	    Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
	}
    }
    if (colormap != NULL) {
	args[argc] = "-colormap";
	args[argc+1] = colormap;
	argc += 2;
2736
2737
2738
2739
2740
2741
2742


2743
2744
2745
2746





2747
2748
2749
2750
2751






2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
	Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
	code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
	if (code != TCL_OK) {
	    goto done;
	}
        geometry = NULL;
    }


    if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
	code = TCL_ERROR;
	goto done;
    }





    code = Tcl_PkgProvide(interp, "Tk", TK_VERSION);
    if (code != TCL_OK) {
	goto done;
    }







    /*
     * Invoke platform-specific initialization.
     */

    code = TkpInit(interp);

    done:
    if (argv != NULL) {
	ckfree((char *) argv);
    }
    return code;
}







>
>




>
>
>
>
>
|




>
>
>
>
>
>












2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
	Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
	code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
	if (code != TCL_OK) {
	    goto done;
	}
        geometry = NULL;
    }
    Tcl_MutexUnlock(&windowMutex);

    if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
	code = TCL_ERROR;
	goto done;
    }

    /*
     * Provide Tk and its stub table.
     */

    code = Tcl_PkgProvideEx(interp, "Tk", TK_VERSION, (ClientData) &tkStubs);
    if (code != TCL_OK) {
	goto done;
    }

#ifdef Tk_InitStubs
#undef Tk_InitStubs
#endif

    Tk_InitStubs(interp, TK_VERSION, 1);

    /*
     * Invoke platform-specific initialization.
     */

    code = TkpInit(interp);

    done:
    if (argv != NULL) {
	ckfree((char *) argv);
    }
    return code;
}

Changes to library/bgerror.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# bgerror.tcl --
#
# This file contains a default version of the bgerror procedure.  It
# posts a dialog box with the error message and gives the user a chance
# to see a more detailed stack trace.
#
# SCCS: @(#) bgerror.tcl 1.16 97/08/06 09:19:50
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# bgerror.tcl --
#
# This file contains a default version of the bgerror procedure.  It
# posts a dialog box with the error message and gives the user a chance
# to see a more detailed stack trace.
#
# RCS: @(#) $Id: bgerror.tcl,v 1.1.4.4 1999/04/06 03:52:49 stanton Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

31
32
33
34
35
36
37
38

39
40
41
42
43
44
45
    # Let's try to execute "tkerror" (using catch {tkerror ...} 
    # instead of searching it with info procs so the application gets
    # a chance to auto load it using its favorite "unknown" mecanism.
    # (we do the default dialog only if we get a TCL_ERROR (=1) return
    #  code from the tkerror trial, other ret codes are passed back
    #  to our caller (tcl background error handler) so the called "tkerror"
    #  can still use  return -code break, to skip remaining messages
    #  in the error queue for instance)  -- dl

    set ret [catch {tkerror $err} msg];
    if {$ret != 1} {return -code $ret $msg}

    # Ok the application's tkerror either failed or was not found
    # we use the default dialog then :
    if {$tcl_platform(platform) == "macintosh"} {
	set ok Ok







|
>







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
    # Let's try to execute "tkerror" (using catch {tkerror ...} 
    # instead of searching it with info procs so the application gets
    # a chance to auto load it using its favorite "unknown" mecanism.
    # (we do the default dialog only if we get a TCL_ERROR (=1) return
    #  code from the tkerror trial, other ret codes are passed back
    #  to our caller (tcl background error handler) so the called "tkerror"
    #  can still use  return -code break, to skip remaining messages
    #  in the error queue for instance)

    set ret [catch {tkerror $err} msg];
    if {$ret != 1} {return -code $ret $msg}

    # Ok the application's tkerror either failed or was not found
    # we use the default dialog then :
    if {$tcl_platform(platform) == "macintosh"} {
	set ok Ok
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
    set w .bgerrorTrace
    catch {destroy $w}
    toplevel $w -class ErrorTrace
    wm minsize $w 1 1
    wm title $w "Stack Trace for Error"
    wm iconname $w "Stack Trace"
    button $w.ok -text OK -command "destroy $w" -default active
    if {$tcl_platform(platform) == "macintosh"} {
      text $w.text -relief flat -bd 2 -highlightthickness 0 -setgrid true \
	    -yscrollcommand "$w.scroll set" -width 60 -height 20
    } else {
      text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \
	    -setgrid true -width 60 -height 20
    }
    scrollbar $w.scroll -relief sunken -command "$w.text yview"
    pack $w.ok -side bottom -padx 3m -pady 2m
    pack $w.scroll -side right -fill y
    pack $w.text -side left -expand yes -fill both
    $w.text insert 0.0 $info
    $w.text mark set insert 0.0

    bind $w <Return> "destroy $w"
    bind $w.text <Return> "destroy $w; break"

    # Center the window on the screen.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w

    # Be sure to release any grabs that might be present on the
    # screen, since they could make it impossible for the user
    # to interact with the stack trace.

    if {[grab current .] != ""} {
	grab release [grab current .]
    }
}







|




















|
|
|
|







|



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
    set w .bgerrorTrace
    catch {destroy $w}
    toplevel $w -class ErrorTrace
    wm minsize $w 1 1
    wm title $w "Stack Trace for Error"
    wm iconname $w "Stack Trace"
    button $w.ok -text OK -command "destroy $w" -default active
    if {![string compare $tcl_platform(platform) "macintosh"]} {
      text $w.text -relief flat -bd 2 -highlightthickness 0 -setgrid true \
	    -yscrollcommand "$w.scroll set" -width 60 -height 20
    } else {
      text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \
	    -setgrid true -width 60 -height 20
    }
    scrollbar $w.scroll -relief sunken -command "$w.text yview"
    pack $w.ok -side bottom -padx 3m -pady 2m
    pack $w.scroll -side right -fill y
    pack $w.text -side left -expand yes -fill both
    $w.text insert 0.0 $info
    $w.text mark set insert 0.0

    bind $w <Return> "destroy $w"
    bind $w.text <Return> "destroy $w; break"

    # Center the window on the screen.

    wm withdraw $w
    update idletasks
    set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]}]
    set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]}]
    wm geom $w +$x+$y
    wm deiconify $w

    # Be sure to release any grabs that might be present on the
    # screen, since they could make it impossible for the user
    # to interact with the stack trace.

    if {[string compare [grab current .] ""]} {
	grab release [grab current .]
    }
}

Changes to library/button.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
# button.tcl --
#
# This file defines the default bindings for Tk label, button,
# checkbutton, and radiobutton widgets and provides procedures
# that help in implementing those bindings.
#
# SCCS: @(#) button.tcl 1.22 96/11/14 14:49:11
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# The code below creates the default class bindings for buttons.
#-------------------------------------------------------------------------

if {$tcl_platform(platform) == "macintosh"} {
    bind Radiobutton <Enter> {
	tkButtonEnter %W
    }
    bind Radiobutton <1> {
	tkButtonDown %W
    }
    bind Radiobutton <ButtonRelease-1> {
	tkButtonUp %W
    }
    bind Checkbutton <Enter> {
	tkButtonEnter %W
    }
    bind Checkbutton <1> {
	tkButtonDown %W
    }
    bind Checkbutton <ButtonRelease-1> {
	tkButtonUp %W
    }
}
if {$tcl_platform(platform) == "windows"} {
    bind Checkbutton <equal> {
	tkCheckRadioInvoke %W select
    }
    bind Checkbutton <plus> {
	tkCheckRadioInvoke %W select
    }
    bind Checkbutton <minus> {






|












|



















|







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
# button.tcl --
#
# This file defines the default bindings for Tk label, button,
# checkbutton, and radiobutton widgets and provides procedures
# that help in implementing those bindings.
#
# RCS: @(#) $Id: button.tcl,v 1.1.4.3 1999/04/06 03:52:50 stanton Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# The code below creates the default class bindings for buttons.
#-------------------------------------------------------------------------

if {[string match "macintosh" $tcl_platform(platform)]} {
    bind Radiobutton <Enter> {
	tkButtonEnter %W
    }
    bind Radiobutton <1> {
	tkButtonDown %W
    }
    bind Radiobutton <ButtonRelease-1> {
	tkButtonUp %W
    }
    bind Checkbutton <Enter> {
	tkButtonEnter %W
    }
    bind Checkbutton <1> {
	tkButtonDown %W
    }
    bind Checkbutton <ButtonRelease-1> {
	tkButtonUp %W
    }
}
if {[string match "windows" $tcl_platform(platform)]} {
    bind Checkbutton <equal> {
	tkCheckRadioInvoke %W select
    }
    bind Checkbutton <plus> {
	tkCheckRadioInvoke %W select
    }
    bind Checkbutton <minus> {
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
    bind Radiobutton <ButtonRelease-1> {
	tkButtonUp %W
    }
    bind Radiobutton <Enter> {
	tkCheckRadioEnter %W
    }
}
if {$tcl_platform(platform) == "unix"} {
    bind Checkbutton <Return> {
	if !$tk_strictMotif {
	    tkCheckRadioInvoke %W
	}
    }
    bind Radiobutton <Return> {
	if !$tk_strictMotif {
	    tkCheckRadioInvoke %W
	}
    }
    bind Checkbutton <1> {
	tkCheckRadioInvoke %W
    }
    bind Radiobutton <1> {







|

|




|







63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
    bind Radiobutton <ButtonRelease-1> {
	tkButtonUp %W
    }
    bind Radiobutton <Enter> {
	tkCheckRadioEnter %W
    }
}
if {[string match "unix" $tcl_platform(platform)]} {
    bind Checkbutton <Return> {
	if {!$tk_strictMotif} {
	    tkCheckRadioInvoke %W
	}
    }
    bind Radiobutton <Return> {
	if {!$tk_strictMotif} {
	    tkCheckRadioInvoke %W
	}
    }
    bind Checkbutton <1> {
	tkCheckRadioInvoke %W
    }
    bind Radiobutton <1> {
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
}

bind Radiobutton <FocusIn> {}
bind Radiobutton <Leave> {
    tkButtonLeave %W
}

if {$tcl_platform(platform) == "windows"} {

#########################
# Windows implementation 
#########################

# tkButtonEnter --
# The procedure below is invoked when the mouse pointer enters a
# button widget.  It records the button we're in and changes the
# state of the button to active unless the button is disabled.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonEnter w {
    global tkPriv
    if {[$w cget -state] != "disabled"} {
	if {$tkPriv(buttonWindow) == $w} {
	    $w configure -state active -relief sunken
	}
    }
    set tkPriv(window) $w
}

# tkButtonLeave --
# The procedure below is invoked when the mouse pointer leaves a
# button widget.  It changes the state of the button back to
# inactive.  If we're leaving the button window with a mouse button
# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
# button too.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonLeave w {
    global tkPriv
    if {[$w cget -state] != "disabled"} {
	$w config -state normal
    }
    if {$w == $tkPriv(buttonWindow)} {
	$w configure -relief $tkPriv(relief)
    }
    set tkPriv(window) ""
}

# tkCheckRadioEnter --
# The procedure below is invoked when the mouse pointer enters a
# checkbutton or radiobutton widget.  It records the button we're in
# and changes the state of the button to active unless the button is
# disabled.
#
# Arguments:
# w -		The name of the widget.

proc tkCheckRadioEnter w {
    global tkPriv
    if {[$w cget -state] != "disabled"} {
	if {$tkPriv(buttonWindow) == $w} {
	    $w configure -state active
	}
    }
    set tkPriv(window) $w
}

# tkButtonDown --
# The procedure below is invoked when the mouse button is pressed in
# a button widget.  It records the fact that the mouse is in the button,
# saves the button's relief so it can be restored later, and changes
# the relief to sunken.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonDown w {
    global tkPriv
    set tkPriv(relief) [lindex [$w conf -relief] 4]
    if {[$w cget -state] != "disabled"} {
	set tkPriv(buttonWindow) $w
	$w config -relief sunken -state active
    }
}

# tkCheckRadioDown --
# The procedure below is invoked when the mouse button is pressed in
# a button widget.  It records the fact that the mouse is in the button,
# saves the button's relief so it can be restored later, and changes
# the relief to sunken.
#
# Arguments:
# w -		The name of the widget.

proc tkCheckRadioDown w {
    global tkPriv
    set tkPriv(relief) [lindex [$w conf -relief] 4]
    if {[$w cget -state] != "disabled"} {
	set tkPriv(buttonWindow) $w
	$w config -state active
    }
}

# tkButtonUp --
# The procedure below is invoked when the mouse button is released
# in a button widget.  It restores the button's relief and invokes
# the command as long as the mouse hasn't left the button.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonUp w {
    global tkPriv
    if {$w == $tkPriv(buttonWindow)} {
	set tkPriv(buttonWindow) ""
	if {($w == $tkPriv(window))
		&& ([$w cget -state] != "disabled")} {
	    $w config -relief $tkPriv(relief) -state normal
	    uplevel #0 [list $w invoke]
	}
    }
}

}

if {$tcl_platform(platform) == "unix"} {

#####################
# Unix implementation
#####################

# tkButtonEnter --
# The procedure below is invoked when the mouse pointer enters a
# button widget.  It records the button we're in and changes the
# state of the button to active unless the button is disabled.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonEnter {w} {
    global tkPriv
    if {[$w cget -state] != "disabled"} {
	$w config -state active
	if {$tkPriv(buttonWindow) == $w} {
	    $w configure -state active -relief sunken
	}
    }
    set tkPriv(window) $w
}

# tkButtonLeave --
# The procedure below is invoked when the mouse pointer leaves a
# button widget.  It changes the state of the button back to
# inactive.  If we're leaving the button window with a mouse button
# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
# button too.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonLeave w {
    global tkPriv
    if {[$w cget -state] != "disabled"} {
	$w config -state normal
    }
    if {$w == $tkPriv(buttonWindow)} {
	$w configure -relief $tkPriv(relief)
    }
    set tkPriv(window) ""
}

# tkButtonDown --
# The procedure below is invoked when the mouse button is pressed in
# a button widget.  It records the fact that the mouse is in the button,
# saves the button's relief so it can be restored later, and changes
# the relief to sunken.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonDown w {
    global tkPriv
    set tkPriv(relief) [lindex [$w config -relief] 4]
    if {[$w cget -state] != "disabled"} {
	set tkPriv(buttonWindow) $w
	$w config -relief sunken
    }
}

# tkButtonUp --
# The procedure below is invoked when the mouse button is released
# in a button widget.  It restores the button's relief and invokes
# the command as long as the mouse hasn't left the button.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonUp w {
    global tkPriv
    if {$w == $tkPriv(buttonWindow)} {
	set tkPriv(buttonWindow) ""
	$w config -relief $tkPriv(relief)
	if {($w == $tkPriv(window))
		&& ([$w cget -state] != "disabled")} {
	    uplevel #0 [list $w invoke]
	}
    }
}

}

if {$tcl_platform(platform) == "macintosh"} {

####################
# Mac implementation
####################

# tkButtonEnter --
# The procedure below is invoked when the mouse pointer enters a
# button widget.  It records the button we're in and changes the
# state of the button to active unless the button is disabled.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonEnter {w} {
    global tkPriv
    if {[$w cget -state] != "disabled"} {
	if {$tkPriv(buttonWindow) == $w} {
	    $w configure -state active
	}
    }
    set tkPriv(window) $w
}

# tkButtonLeave --
# The procedure below is invoked when the mouse pointer leaves a
# button widget.  It changes the state of the button back to
# inactive.  If we're leaving the button window with a mouse button
# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
# button too.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonLeave w {
    global tkPriv
    if {$w == $tkPriv(buttonWindow)} {
	$w configure -state normal
    }
    set tkPriv(window) ""
}

# tkButtonDown --
# The procedure below is invoked when the mouse button is pressed in
# a button widget.  It records the fact that the mouse is in the button,
# saves the button's relief so it can be restored later, and changes
# the relief to sunken.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonDown w {
    global tkPriv
    if {[$w cget -state] != "disabled"} {
	set tkPriv(buttonWindow) $w
	$w config -state active
    }
}

# tkButtonUp --
# The procedure below is invoked when the mouse button is released
# in a button widget.  It restores the button's relief and invokes
# the command as long as the mouse hasn't left the button.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonUp w {
    global tkPriv
    if {$w == $tkPriv(buttonWindow)} {
	$w config -state normal
	set tkPriv(buttonWindow) ""
	if {($w == $tkPriv(window))
		&& ([$w cget -state] != "disabled")} {
	    uplevel #0 [list $w invoke]
	}
    }
}

}

##################
# Shared routines
##################

# tkButtonInvoke --
# The procedure below is called when a button is invoked through
# the keyboard.  It simulate a press of the button via the mouse.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonInvoke w {
    if {[$w cget -state] != "disabled"} {
	set oldRelief [$w cget -relief]
	set oldState [$w cget -state]
	$w configure -state active -relief sunken
	update idletasks
	after 100
	$w configure -state $oldState -relief $oldRelief
	uplevel #0 [list $w invoke]







|















|
|


















|


|
















|
|


















|

















|















|

|
|








|















|

|


















|


|

















|















|


|
|







|















|
|


















|
















|















|


|
|



















|







122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
}

bind Radiobutton <FocusIn> {}
bind Radiobutton <Leave> {
    tkButtonLeave %W
}

if {[string match "windows" $tcl_platform(platform)]} {

#########################
# Windows implementation 
#########################

# tkButtonEnter --
# The procedure below is invoked when the mouse pointer enters a
# button widget.  It records the button we're in and changes the
# state of the button to active unless the button is disabled.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonEnter w {
    global tkPriv
    if {[string compare [$w cget -state] "disabled"]} {
      if {![string compare $tkPriv(buttonWindow) $w]} {
	    $w configure -state active -relief sunken
	}
    }
    set tkPriv(window) $w
}

# tkButtonLeave --
# The procedure below is invoked when the mouse pointer leaves a
# button widget.  It changes the state of the button back to
# inactive.  If we're leaving the button window with a mouse button
# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
# button too.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonLeave w {
    global tkPriv
    if {[string compare [$w cget -state] "disabled"]} {
	$w config -state normal
    }
    if {![string compare $tkPriv(buttonWindow) $w]} {
	$w configure -relief $tkPriv(relief)
    }
    set tkPriv(window) ""
}

# tkCheckRadioEnter --
# The procedure below is invoked when the mouse pointer enters a
# checkbutton or radiobutton widget.  It records the button we're in
# and changes the state of the button to active unless the button is
# disabled.
#
# Arguments:
# w -		The name of the widget.

proc tkCheckRadioEnter w {
    global tkPriv
    if {[string compare [$w cget -state] "disabled"]} {
      if {![string compare $tkPriv(buttonWindow) $w]} {
	    $w configure -state active
	}
    }
    set tkPriv(window) $w
}

# tkButtonDown --
# The procedure below is invoked when the mouse button is pressed in
# a button widget.  It records the fact that the mouse is in the button,
# saves the button's relief so it can be restored later, and changes
# the relief to sunken.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonDown w {
    global tkPriv
    set tkPriv(relief) [lindex [$w conf -relief] 4]
    if {[string compare [$w cget -state] "disabled"]} {
	set tkPriv(buttonWindow) $w
	$w config -relief sunken -state active
    }
}

# tkCheckRadioDown --
# The procedure below is invoked when the mouse button is pressed in
# a button widget.  It records the fact that the mouse is in the button,
# saves the button's relief so it can be restored later, and changes
# the relief to sunken.
#
# Arguments:
# w -		The name of the widget.

proc tkCheckRadioDown w {
    global tkPriv
    set tkPriv(relief) [lindex [$w conf -relief] 4]
    if {[string compare [$w cget -state] "disabled"]} {
	set tkPriv(buttonWindow) $w
	$w config -state active
    }
}

# tkButtonUp --
# The procedure below is invoked when the mouse button is released
# in a button widget.  It restores the button's relief and invokes
# the command as long as the mouse hasn't left the button.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonUp w {
    global tkPriv
    if {![string compare $tkPriv(buttonWindow) $w]} {
	set tkPriv(buttonWindow) ""
      if {![string compare $tkPriv(window) $w]
              && [string compare [$w cget -state] "disabled"]} {
	    $w config -relief $tkPriv(relief) -state normal
	    uplevel #0 [list $w invoke]
	}
    }
}

}

if {[string match "unix" $tcl_platform(platform)]} {

#####################
# Unix implementation
#####################

# tkButtonEnter --
# The procedure below is invoked when the mouse pointer enters a
# button widget.  It records the button we're in and changes the
# state of the button to active unless the button is disabled.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonEnter {w} {
    global tkPriv
    if {[string compare [$w cget -state] "disabled"]} {
	$w config -state active
      if {![string compare $tkPriv(buttonWindow) $w]} {
	    $w configure -state active -relief sunken
	}
    }
    set tkPriv(window) $w
}

# tkButtonLeave --
# The procedure below is invoked when the mouse pointer leaves a
# button widget.  It changes the state of the button back to
# inactive.  If we're leaving the button window with a mouse button
# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
# button too.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonLeave w {
    global tkPriv
    if {[string compare [$w cget -state] "disabled"]} {
	$w config -state normal
    }
    if {![string compare $tkPriv(buttonWindow) $w]} {
	$w configure -relief $tkPriv(relief)
    }
    set tkPriv(window) ""
}

# tkButtonDown --
# The procedure below is invoked when the mouse button is pressed in
# a button widget.  It records the fact that the mouse is in the button,
# saves the button's relief so it can be restored later, and changes
# the relief to sunken.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonDown w {
    global tkPriv
    set tkPriv(relief) [lindex [$w config -relief] 4]
    if {[string compare [$w cget -state] "disabled"]} {
	set tkPriv(buttonWindow) $w
	$w config -relief sunken
    }
}

# tkButtonUp --
# The procedure below is invoked when the mouse button is released
# in a button widget.  It restores the button's relief and invokes
# the command as long as the mouse hasn't left the button.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonUp w {
    global tkPriv
    if {![string compare $w $tkPriv(buttonWindow)]} {
	set tkPriv(buttonWindow) ""
	$w config -relief $tkPriv(relief)
      if {![string compare $w $tkPriv(window)]
              && [string compare [$w cget -state] "disabled"]} {
	    uplevel #0 [list $w invoke]
	}
    }
}

}

if {[string match "macintosh" $tcl_platform(platform)]} {

####################
# Mac implementation
####################

# tkButtonEnter --
# The procedure below is invoked when the mouse pointer enters a
# button widget.  It records the button we're in and changes the
# state of the button to active unless the button is disabled.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonEnter {w} {
    global tkPriv
    if {[string compare [$w cget -state] "disabled"]} {
      if {![string compare $w $tkPriv(buttonWindow)]} {
	    $w configure -state active
	}
    }
    set tkPriv(window) $w
}

# tkButtonLeave --
# The procedure below is invoked when the mouse pointer leaves a
# button widget.  It changes the state of the button back to
# inactive.  If we're leaving the button window with a mouse button
# pressed (tkPriv(buttonWindow) == $w), restore the relief of the
# button too.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonLeave w {
    global tkPriv
    if {![string compare $w $tkPriv(buttonWindow)]} {
	$w configure -state normal
    }
    set tkPriv(window) ""
}

# tkButtonDown --
# The procedure below is invoked when the mouse button is pressed in
# a button widget.  It records the fact that the mouse is in the button,
# saves the button's relief so it can be restored later, and changes
# the relief to sunken.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonDown w {
    global tkPriv
    if {[string compare [$w cget -state] "disabled"]} {
	set tkPriv(buttonWindow) $w
	$w config -state active
    }
}

# tkButtonUp --
# The procedure below is invoked when the mouse button is released
# in a button widget.  It restores the button's relief and invokes
# the command as long as the mouse hasn't left the button.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonUp w {
    global tkPriv
    if {![string compare $w $tkPriv(buttonWindow)]} {
	$w config -state normal
	set tkPriv(buttonWindow) ""
      if {![string compare $w $tkPriv(window)]
              && [string compare [$w cget -state] "disabled"]} {
	    uplevel #0 [list $w invoke]
	}
    }
}

}

##################
# Shared routines
##################

# tkButtonInvoke --
# The procedure below is called when a button is invoked through
# the keyboard.  It simulate a press of the button via the mouse.
#
# Arguments:
# w -		The name of the widget.

proc tkButtonInvoke w {
    if {[string compare [$w cget -state] "disabled"]} {
	set oldRelief [$w cget -relief]
	set oldState [$w cget -state]
	$w configure -state active -relief sunken
	update idletasks
	after 100
	$w configure -state $oldState -relief $oldRelief
	uplevel #0 [list $w invoke]
445
446
447
448
449
450
451
452
453
454
455
456
# isn't disabled.
#
# Arguments:
# w -		The name of the widget.
# cmd -		The subcommand to invoke (one of invoke, select, or deselect).

proc tkCheckRadioInvoke {w {cmd invoke}} {
    if {[$w cget -state] != "disabled"} {
	uplevel #0 [list $w $cmd]
    }
}








|




445
446
447
448
449
450
451
452
453
454
455
456
# isn't disabled.
#
# Arguments:
# w -		The name of the widget.
# cmd -		The subcommand to invoke (one of invoke, select, or deselect).

proc tkCheckRadioInvoke {w {cmd invoke}} {
    if {[string compare [$w cget -state] "disabled"]} {
	uplevel #0 [list $w $cmd]
    }
}

Changes to library/clrpick.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# clrpick.tcl --
#
#	Color selection dialog for platforms that do not support a
#	standard color selection dialog.
#
# SCCS: @(#) clrpick.tcl 1.3 96/09/05 09:59:24
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# ToDo:





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# clrpick.tcl --
#
#	Color selection dialog for platforms that do not support a
#	standard color selection dialog.
#
# RCS: @(#) $Id: clrpick.tcl,v 1.1.4.3 1999/04/06 03:52:51 stanton Exp $
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# ToDo:
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
    # PLGN_HEIGHT is the height of the selection polygon and the height of the 
    # selection rectangle at the bottom of the color bar. No restrictions.
    set data(PLGN_WIDTH) 10

    tkColorDialog_Config $w $args
    tkColorDialog_InitValues $w

    if ![winfo exists $w] {
	toplevel $w -class tkColorDialog
	tkColorDialog_BuildDialog $w
    }
    wm transient $w $data(-parent)


    # 5. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	- [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	- [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w
    wm title $w $data(-title)

    # 6. Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current $w]
    if {$oldGrab != ""} {
	set grabStatus [grab status $oldGrab]
    }
    grab $w
    focus $data(okBtn)

    # 7. Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

    tkwait variable tkPriv(selectColor)
    catch {focus $oldFocus}
    grab release $w
    destroy $w
    unset data
    if {$oldGrab != ""} {
	if {$grabStatus == "global"} {
	    grab -global $oldGrab
	} else {
	    grab $oldGrab
	}
    }
    return $tkPriv(selectColor)
}

# tkColorDialog_InitValues --
#
#	Get called during initialization or when user resets NUM_COLORBARS
#
proc tkColorDialog_InitValues {w} {
    upvar #0 $w data

    # IntensityIncr is the difference in color intensity between a colorbar
    # and its neighbors.
    set data(intensityIncr) [expr 256 / $data(NUM_COLORBARS)]

    # ColorbarWidth is the width of each colorbar
    set data(colorbarWidth) \
	[expr $data(BARS_WIDTH) / $data(NUM_COLORBARS)]

    # Indent is the width of the space at the left and right side of the
    # colorbar. It is always half the selector polygon width, because the
    # polygon extends into the space.
    set data(indent) [expr $data(PLGN_WIDTH) / 2]

    set data(colorPad) 2
    set data(selPad)   [expr $data(PLGN_WIDTH) / 2]

    #
    # minX is the x coordinate of the first colorbar
    #
    set data(minX) $data(indent)

    #
    # maxX is the x coordinate of the last colorbar
    #
    set data(maxX) [expr $data(BARS_WIDTH) + $data(indent)-1]

    #
    # canvasWidth is the width of the entire canvas, including the indents
    #
    set data(canvasWidth) [expr $data(BARS_WIDTH) + \
	$data(PLGN_WIDTH)]

    # Set the initial color, specified by -initialcolor, or the
    # color chosen by the user the last time.
    set data(selection) $data(-initialcolor)
    set data(finalColor)  $data(-initialcolor)
    set rgb [winfo rgb . $data(selection)]

    set data(red,intensity)   [expr [lindex $rgb 0]/0x100]
    set data(green,intensity) [expr [lindex $rgb 1]/0x100]
    set data(blue,intensity)  [expr [lindex $rgb 2]/0x100]
}

# tkColorDialog_Config  --
#
#	Parses the command line arguments to tk_chooseColor
#
proc tkColorDialog_Config {w argList} {







|












|
|
|
|








|
















|
|

















|



|




|


|









|




|
|







|
|
|







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
    # PLGN_HEIGHT is the height of the selection polygon and the height of the 
    # selection rectangle at the bottom of the color bar. No restrictions.
    set data(PLGN_WIDTH) 10

    tkColorDialog_Config $w $args
    tkColorDialog_InitValues $w

    if {![winfo exists $w]} {
	toplevel $w -class tkColorDialog
	tkColorDialog_BuildDialog $w
    }
    wm transient $w $data(-parent)


    # 5. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]}]
    set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]}]
    wm geom $w +$x+$y
    wm deiconify $w
    wm title $w $data(-title)

    # 6. Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current $w]
    if {[string compare $oldGrab ""]} {
	set grabStatus [grab status $oldGrab]
    }
    grab $w
    focus $data(okBtn)

    # 7. Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

    tkwait variable tkPriv(selectColor)
    catch {focus $oldFocus}
    grab release $w
    destroy $w
    unset data
    if {[string compare $oldGrab ""]} {
	if {![string compare $grabStatus "global"]} {
	    grab -global $oldGrab
	} else {
	    grab $oldGrab
	}
    }
    return $tkPriv(selectColor)
}

# tkColorDialog_InitValues --
#
#	Get called during initialization or when user resets NUM_COLORBARS
#
proc tkColorDialog_InitValues {w} {
    upvar #0 $w data

    # IntensityIncr is the difference in color intensity between a colorbar
    # and its neighbors.
    set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}]

    # ColorbarWidth is the width of each colorbar
    set data(colorbarWidth) \
	    [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}]

    # Indent is the width of the space at the left and right side of the
    # colorbar. It is always half the selector polygon width, because the
    # polygon extends into the space.
    set data(indent) [expr {$data(PLGN_WIDTH) / 2}]

    set data(colorPad) 2
    set data(selPad)   [expr {$data(PLGN_WIDTH) / 2}]

    #
    # minX is the x coordinate of the first colorbar
    #
    set data(minX) $data(indent)

    #
    # maxX is the x coordinate of the last colorbar
    #
    set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}]

    #
    # canvasWidth is the width of the entire canvas, including the indents
    #
    set data(canvasWidth) [expr {$data(BARS_WIDTH) + \
	    $data(PLGN_WIDTH)}]

    # Set the initial color, specified by -initialcolor, or the
    # color chosen by the user the last time.
    set data(selection) $data(-initialcolor)
    set data(finalColor)  $data(-initialcolor)
    set rgb [winfo rgb . $data(selection)]

    set data(red,intensity)   [expr {[lindex $rgb 0]/0x100}]
    set data(green,intensity) [expr {[lindex $rgb 1]/0x100}]
    set data(blue,intensity)  [expr {[lindex $rgb 2]/0x100}]
}

# tkColorDialog_Config  --
#
#	Parses the command line arguments to tk_chooseColor
#
proc tkColorDialog_Config {w argList} {
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
	{-title "" "" "Color"}
    }

    # 2: parse the arguments
    #
    tclParseConfigSpec $w $specs "" $argList

    if ![string compare $data(-title) ""] {
	set data(-title) " "
    }
    if ![string compare $data(-initialcolor) ""] {
	if {[info exists tkPriv(selectColor)] && \
		[string compare $tkPriv(selectColor) ""]} {
	    set data(-initialcolor) $tkPriv(selectColor)
	} else {
	    set data(-initialcolor) [. cget -background]
	}
    } else {
	if [catch {winfo rgb . $data(-initialcolor)} err] {
	    error $err
	}
    }

    if ![winfo exists $data(-parent)] {
	error "bad window path name \"$data(-parent)\""
    }
}

# tkColorDialog_BuildDialog --
#
#	Build the dialog.







|


|







|




|







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
	{-title "" "" "Color"}
    }

    # 2: parse the arguments
    #
    tclParseConfigSpec $w $specs "" $argList

    if {![string compare $data(-title) ""]} {
	set data(-title) " "
    }
    if {![string compare $data(-initialcolor) ""]} {
	if {[info exists tkPriv(selectColor)] && \
		[string compare $tkPriv(selectColor) ""]} {
	    set data(-initialcolor) $tkPriv(selectColor)
	} else {
	    set data(-initialcolor) [. cget -background]
	}
    } else {
	if {[catch {winfo rgb . $data(-initialcolor)} err]} {
	    error $err
	}
    }

    if {![winfo exists $data(-parent)]} {
	error "bad window path name \"$data(-parent)\""
    }
}

# tkColorDialog_BuildDialog --
#
#	Build the dialog.
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
	entry $box.entry -textvariable [format %s $w]($color,intensity) \
	    -width 4
	pack $box.label -side left -fill y -padx 2 -pady 3
	pack $box.entry -side left -anchor n -pady 0
	pack $box -side left -fill both

	set height [expr \
	    [winfo reqheight $box.entry] - \
	    2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])]

	canvas $f.color -height $height\
	    -width $data(BARS_WIDTH) -relief sunken -bd 2
	canvas $f.sel -height $data(PLGN_HEIGHT) \
	    -width $data(canvasWidth) -highlightthickness 0
	pack $f.color -expand yes -fill both
	pack $f.sel -expand yes -fill both







|
|







229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
	entry $box.entry -textvariable [format %s $w]($color,intensity) \
	    -width 4
	pack $box.label -side left -fill y -padx 2 -pady 3
	pack $box.entry -side left -anchor n -pady 0
	pack $box -side left -fill both

	set height [expr \
	    {[winfo reqheight $box.entry] - \
	    2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}]

	canvas $f.color -height $height\
	    -width $data(BARS_WIDTH) -relief sunken -bd 2
	canvas $f.sel -height $data(PLGN_HEIGHT) \
	    -width $data(canvasWidth) -highlightthickness 0
	pack $f.color -expand yes -fill both
	pack $f.sel -expand yes -fill both
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
# tkColorDialog_XToRgb --
#
#	Converts a screen coordinate to intensity
#
proc tkColorDialog_XToRgb {w x} {
    upvar #0 $w data
    
    return [expr ($x * $data(intensityIncr))/ $data(colorbarWidth)]
}

# tkColorDialog_RgbToX
#
#	Converts an intensity to screen coordinate.
#
proc tkColorDialog_RgbToX {w color} {
    upvar #0 $w data
    
    return [expr ($color * $data(colorbarWidth)/ $data(intensityIncr))]
}


# tkColorDialog_DrawColorScale --
# 
#	Draw color scale is called whenever the size of one of the color
#	scale canvases is changed.
#
proc tkColorDialog_DrawColorScale {w c {create 0}} {
    global lines
    upvar #0 $w data

    # col: color bar canvas
    # sel: selector canvas
    set col $data($c,col)
    set sel $data($c,sel)

    # First handle the case that we are creating everything for the first time.
    if $create {
	# First remove all the lines that already exist.
	if { $data(lines,$c,last) > $data(lines,$c,start)} {
	    for {set i $data(lines,$c,start)} \
		{$i <= $data(lines,$c,last)} { incr i} {
		$sel delete $i
	    }
	}
	# Delete the selector if it exists
	if [info exists data($c,index)] {
	    $sel delete $data($c,index)
	}
	
	# Draw the selection polygons
	tkColorDialog_CreateSelector $w $sel $c
	$sel bind $data($c,index) <ButtonPress-1> \
	    "tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1"







|









|


















|








|







337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
# tkColorDialog_XToRgb --
#
#	Converts a screen coordinate to intensity
#
proc tkColorDialog_XToRgb {w x} {
    upvar #0 $w data
    
    return [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}]
}

# tkColorDialog_RgbToX
#
#	Converts an intensity to screen coordinate.
#
proc tkColorDialog_RgbToX {w color} {
    upvar #0 $w data
    
    return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]
}


# tkColorDialog_DrawColorScale --
# 
#	Draw color scale is called whenever the size of one of the color
#	scale canvases is changed.
#
proc tkColorDialog_DrawColorScale {w c {create 0}} {
    global lines
    upvar #0 $w data

    # col: color bar canvas
    # sel: selector canvas
    set col $data($c,col)
    set sel $data($c,sel)

    # First handle the case that we are creating everything for the first time.
    if {$create} {
	# First remove all the lines that already exist.
	if { $data(lines,$c,last) > $data(lines,$c,start)} {
	    for {set i $data(lines,$c,start)} \
		{$i <= $data(lines,$c,last)} { incr i} {
		$sel delete $i
	    }
	}
	# Delete the selector if it exists
	if {[info exists data($c,index)]} {
	    $sel delete $data($c,index)
	}
	
	# Draw the selection polygons
	tkColorDialog_CreateSelector $w $sel $c
	$sel bind $data($c,index) <ButtonPress-1> \
	    "tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1"
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
    } else {
	# l is the canvas index of the first colorbar.
	set l $data(lines,$c,start)
    }
    
    # Draw the color bars.
    set highlightW [expr \
	[$col cget -highlightthickness] + [$col cget -bd]]
    for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
	set intensity [expr $i * $data(intensityIncr)]
	set startx [expr $i * $data(colorbarWidth) + $highlightW]
	if { $c == "red" } {
	    set color [format "#%02x%02x%02x" \
			   $intensity \
			   $data(green,intensity) \
			   $data(blue,intensity)]
	} elseif { $c == "green" } {
	    set color [format "#%02x%02x%02x" \
			   $data(red,intensity) \
			   $intensity \
			   $data(blue,intensity)]
	} else {
	    set color [format "#%02x%02x%02x" \
			   $data(red,intensity) \
			   $data(green,intensity) \
			   $intensity]
	}

	if $create {
	    set index [$col create rect $startx $highlightW \
		[expr $startx +$data(colorbarWidth)] \
		[expr [winfo height $col] + $highlightW]\
	        -fill $color -outline $color]
	} else {
	    $col itemconf $l -fill $color -outline $color
	    incr l
	}
    }
    $sel raise $data($c,index)

    if $create {
	set data(lines,$c,last) $index
	set data(lines,$c,start) [expr $index - $data(NUM_COLORBARS) + 1 ]
    }

    tkColorDialog_RedrawFinalColor $w
}

# tkColorDialog_CreateSelector --
#







|

|
|

















|

|
|








|

|







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
    } else {
	# l is the canvas index of the first colorbar.
	set l $data(lines,$c,start)
    }
    
    # Draw the color bars.
    set highlightW [expr \
	    {[$col cget -highlightthickness] + [$col cget -bd]}]
    for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
	set intensity [expr {$i * $data(intensityIncr)}]
	set startx [expr {$i * $data(colorbarWidth) + $highlightW}]
	if { $c == "red" } {
	    set color [format "#%02x%02x%02x" \
			   $intensity \
			   $data(green,intensity) \
			   $data(blue,intensity)]
	} elseif { $c == "green" } {
	    set color [format "#%02x%02x%02x" \
			   $data(red,intensity) \
			   $intensity \
			   $data(blue,intensity)]
	} else {
	    set color [format "#%02x%02x%02x" \
			   $data(red,intensity) \
			   $data(green,intensity) \
			   $intensity]
	}

	if {$create} {
	    set index [$col create rect $startx $highlightW \
		    [expr {$startx +$data(colorbarWidth)}] \
		    [expr {[winfo height $col] + $highlightW}]\
	        -fill $color -outline $color]
	} else {
	    $col itemconf $l -fill $color -outline $color
	    incr l
	}
    }
    $sel raise $data($c,index)

    if {$create} {
	set data(lines,$c,last) $index
	set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]
    }

    tkColorDialog_RedrawFinalColor $w
}

# tkColorDialog_CreateSelector --
#
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
#	pressed.  Sets the binding for the button-release event.
# 
# Params: sel is the selector canvas window, color is the color of the strip.
#
proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} {
    upvar #0 $w data

    if !$dontMove {
	tkColorDialog_MoveSelector $w $sel $color $x $delta
    }
}

# tkColorDialog_MoveSelector --
# 
# Moves the polygon selector so that its middle point has the same







|







535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
#	pressed.  Sets the binding for the button-release event.
# 
# Params: sel is the selector canvas window, color is the color of the strip.
#
proc tkColorDialog_StartMove {w sel color x delta {dontMove 0}} {
    upvar #0 $w data

    if {!$dontMove} {
	tkColorDialog_MoveSelector $w $sel $color $x $delta
    }
}

# tkColorDialog_MoveSelector --
# 
# Moves the polygon selector so that its middle point has the same
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
    upvar #0 $w data

    incr x -$delta

    if { $x < 0 } {
	set x 0
    } elseif { $x >= $data(BARS_WIDTH)} {
	set x [expr $data(BARS_WIDTH) - 1]
    }
    set diff [expr  $x - $data($color,x)]
    $sel move $data($color,index) $diff 0
    set data($color,x) [expr $data($color,x) + $diff]
    
    # Return the x value that it was actually set at
    return $x
}

# tkColorDialog_ReleaseMouse
#







|

|

|







557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
    upvar #0 $w data

    incr x -$delta

    if { $x < 0 } {
	set x 0
    } elseif { $x >= $data(BARS_WIDTH)} {
	set x [expr {$data(BARS_WIDTH) - 1}]
    }
    set diff [expr {$x - $data($color,x)}]
    $sel move $data($color,index) $diff 0
    set data($color,x) [expr {$data($color,x) + $diff}]
    
    # Return the x value that it was actually set at
    return $x
}

# tkColorDialog_ReleaseMouse
#
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
#	Handles the return keypress event in the "Selection:" entry
#
proc tkColorDialog_HandleSelEntry {w} {
    upvar #0 $w data

    set text [string trim $data(selection)]
    # Check to make sure that the color is valid
    if [catch {set color [winfo rgb . $text]} ] {
	set data(selection) $data(finalColor)
	return
    }
    
    set R [expr [lindex $color 0]/0x100]
    set G [expr [lindex $color 1]/0x100]
    set B [expr [lindex $color 2]/0x100]

    tkColorDialog_SetRGBValue $w "$R $G $B"
    set data(selection) $text
}

# tkColorDialog_HandleRGBEntry --
#
#	Handles the return keypress event in the R, G or B entry
#
proc tkColorDialog_HandleRGBEntry {w} {
    upvar #0 $w data

    foreach c {red green blue} {
	if [catch {
	    set data($c,intensity) [expr int($data($c,intensity))]
	}] {
	    set data($c,intensity) 0
	}

	if {$data($c,intensity) < 0} {
	    set data($c,intensity) 0
	}
	if {$data($c,intensity) > 255} {







|




|
|
|













|
|
|







613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
#	Handles the return keypress event in the "Selection:" entry
#
proc tkColorDialog_HandleSelEntry {w} {
    upvar #0 $w data

    set text [string trim $data(selection)]
    # Check to make sure that the color is valid
    if {[catch {set color [winfo rgb . $text]} ]} {
	set data(selection) $data(finalColor)
	return
    }
    
    set R [expr {[lindex $color 0]/0x100}]
    set G [expr {[lindex $color 1]/0x100}]
    set B [expr {[lindex $color 2]/0x100}]

    tkColorDialog_SetRGBValue $w "$R $G $B"
    set data(selection) $text
}

# tkColorDialog_HandleRGBEntry --
#
#	Handles the return keypress event in the R, G or B entry
#
proc tkColorDialog_HandleRGBEntry {w} {
    upvar #0 $w data

    foreach c {red green blue} {
	if {[catch {
	    set data($c,intensity) [expr {int($data($c,intensity))}]
	}]} {
	    set data($c,intensity) 0
	}

	if {$data($c,intensity) < 0} {
	    set data($c,intensity) 0
	}
	if {$data($c,intensity) > 255} {

Changes to library/comdlg.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# comdlg.tcl --
#
#	Some functions needed for the common dialog boxes. Probably need to go
#	in a different file.
#
# SCCS: @(#) comdlg.tcl 1.4 96/09/05 09:07:54
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#






|







1
2
3
4
5
6
7
8
9
10
11
12
13
# comdlg.tcl --
#
#	Some functions needed for the common dialog boxes. Probably need to go
#	in a different file.
#
# RCS: @(#) $Id: comdlg.tcl,v 1.1.4.2 1998/09/30 02:17:31 stanton Exp $
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

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
	set cmd($cmdsw) ""
	set rname($cmdsw)   [lindex $spec 1]
	set rclass($cmdsw)  [lindex $spec 2]
	set def($cmdsw)     [lindex $spec 3]
	set verproc($cmdsw) [lindex $spec 4]
    }

    if {[expr [llength $argList] %2] != 0} {
	foreach {cmdsw value} $argList {
	    if ![info exists cmd($cmdsw)] {
	        error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]"
	    }
	}
	error "value for \"[lindex $argList end]\" missing"
    }

    # 2: set the default values
    #
    foreach cmdsw [array names cmd] {
	set data($cmdsw) $def($cmdsw)
    }

    # 3: parse the argument list
    #
    foreach {cmdsw value} $argList {
	if ![info exists cmd($cmdsw)] {
	    error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]"
	}
	set data($cmdsw) $value
    }

    # Done!
}

proc tclListValidFlags {v} {
    upvar $v cmd

    set len [llength [array names cmd]]
    set i 1
    set separator ""
    set errormsg ""
    foreach cmdsw [lsort [array names cmd]] {
	append errormsg "$separator$cmdsw"
	incr i
	if {$i == $len} {
	    set separator " or "
	} else {
	    set separator ", "
	}
    }
    return $errormsg
}








|
|
|
|
|
<
|











|
|


















|







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
	set cmd($cmdsw) ""
	set rname($cmdsw)   [lindex $spec 1]
	set rclass($cmdsw)  [lindex $spec 2]
	set def($cmdsw)     [lindex $spec 3]
	set verproc($cmdsw) [lindex $spec 4]
    }

    if {[llength $argList] & 1} {
	set cmdsw [lindex $argList end]
	if {![info exists cmd($cmdsw)]} {
	    error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
	}

	error "value for \"$cmdsw\" missing"
    }

    # 2: set the default values
    #
    foreach cmdsw [array names cmd] {
	set data($cmdsw) $def($cmdsw)
    }

    # 3: parse the argument list
    #
    foreach {cmdsw value} $argList {
	if {![info exists cmd($cmdsw)]} {
	    error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
	}
	set data($cmdsw) $value
    }

    # Done!
}

proc tclListValidFlags {v} {
    upvar $v cmd

    set len [llength [array names cmd]]
    set i 1
    set separator ""
    set errormsg ""
    foreach cmdsw [lsort [array names cmd]] {
	append errormsg "$separator$cmdsw"
	incr i
	if {$i == $len} {
	    set separator ", or "
	} else {
	    set separator ", "
	}
    }
    return $errormsg
}

133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
#	Create a focus group. All the widgets in a focus group must be
#	within the same focus toplevel. Each toplevel can have only
#	one focus group, which is identified by the name of the
#	toplevel widget.
#
proc tkFocusGroup_Create {t} {
    global tkPriv
    if [string compare [winfo toplevel $t] $t] {
	error "$t is not a toplevel window"
    }
    if ![info exists tkPriv(fg,$t)] {
	set tkPriv(fg,$t) 1
	set tkPriv(focus,$t) ""
	bind $t <FocusIn>  "tkFocusGroup_In  $t %W %d"
	bind $t <FocusOut> "tkFocusGroup_Out $t %W %d"
	bind $t <Destroy>  "tkFocusGroup_Destroy $t %W"
    }
}

# tkFocusGroup_BindIn --
#
# Add a widget into the "FocusIn" list of the focus group. The $cmd will be
# called when the widget is focused on by the user.
#
proc tkFocusGroup_BindIn {t w cmd} {
    global tkFocusIn tkPriv
    if ![info exists tkPriv(fg,$t)] {
	error "focus group \"$t\" doesn't exist"
    }
    set tkFocusIn($t,$w) $cmd
}


# tkFocusGroup_BindOut --
#
#	Add a widget into the "FocusOut" list of the focus group. The
#	$cmd will be called when the widget loses the focus (User
#	types Tab or click on another widget).
#
proc tkFocusGroup_BindOut {t w cmd} {
    global tkFocusOut tkPriv
    if ![info exists tkPriv(fg,$t)] {
	error "focus group \"$t\" doesn't exist"
    }
    set tkFocusOut($t,$w) $cmd
}

# tkFocusGroup_Destroy --
#
#	Cleans up when members of the focus group is deleted, or when the
#	toplevel itself gets deleted.
#
proc tkFocusGroup_Destroy {t w} {
    global tkPriv tkFocusIn tkFocusOut

    if ![string compare $t $w] {
	unset tkPriv(fg,$t)
	unset tkPriv(focus,$t) 

	foreach name [array names tkFocusIn $t,*] {
	    unset tkFocusIn($name)
	}
	foreach name [array names tkFocusOut $t,*] {
	    unset tkFocusOut($name)
	}
    } else {
	if [info exists tkPriv(focus,$t)] {
	    if ![string compare $tkPriv(focus,$t) $w] {
		set tkPriv(focus,$t) ""
	    }
	}
	catch {
	    unset tkFocusIn($t,$w)
	}
	catch {
	    unset tkFocusOut($t,$w)
	}
    }
}

# tkFocusGroup_In --
#
#	Handles the <FocusIn> event. Calls the FocusIn command for the newly
#	focused widget in the focus group.
#
proc tkFocusGroup_In {t w detail} {
    global tkPriv tkFocusIn

    if ![info exists tkFocusIn($t,$w)] {
	set tkFocusIn($t,$w) ""
	return
    }
    if ![info exists tkPriv(focus,$t)] {
	return
    }
    if ![string compare $tkPriv(focus,$t) $w] {
	# This is already in focus
	#
	return
    } else {
	set tkPriv(focus,$t) $w
	eval $tkFocusIn($t,$w)
    }







|


|















|














|













|










|
|




















|



|


|







132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
#	Create a focus group. All the widgets in a focus group must be
#	within the same focus toplevel. Each toplevel can have only
#	one focus group, which is identified by the name of the
#	toplevel widget.
#
proc tkFocusGroup_Create {t} {
    global tkPriv
    if {[string compare [winfo toplevel $t] $t]} {
	error "$t is not a toplevel window"
    }
    if {![info exists tkPriv(fg,$t)]} {
	set tkPriv(fg,$t) 1
	set tkPriv(focus,$t) ""
	bind $t <FocusIn>  "tkFocusGroup_In  $t %W %d"
	bind $t <FocusOut> "tkFocusGroup_Out $t %W %d"
	bind $t <Destroy>  "tkFocusGroup_Destroy $t %W"
    }
}

# tkFocusGroup_BindIn --
#
# Add a widget into the "FocusIn" list of the focus group. The $cmd will be
# called when the widget is focused on by the user.
#
proc tkFocusGroup_BindIn {t w cmd} {
    global tkFocusIn tkPriv
    if {![info exists tkPriv(fg,$t)]} {
	error "focus group \"$t\" doesn't exist"
    }
    set tkFocusIn($t,$w) $cmd
}


# tkFocusGroup_BindOut --
#
#	Add a widget into the "FocusOut" list of the focus group. The
#	$cmd will be called when the widget loses the focus (User
#	types Tab or click on another widget).
#
proc tkFocusGroup_BindOut {t w cmd} {
    global tkFocusOut tkPriv
    if {![info exists tkPriv(fg,$t)]} {
	error "focus group \"$t\" doesn't exist"
    }
    set tkFocusOut($t,$w) $cmd
}

# tkFocusGroup_Destroy --
#
#	Cleans up when members of the focus group is deleted, or when the
#	toplevel itself gets deleted.
#
proc tkFocusGroup_Destroy {t w} {
    global tkPriv tkFocusIn tkFocusOut

    if {![string compare $t $w]} {
	unset tkPriv(fg,$t)
	unset tkPriv(focus,$t) 

	foreach name [array names tkFocusIn $t,*] {
	    unset tkFocusIn($name)
	}
	foreach name [array names tkFocusOut $t,*] {
	    unset tkFocusOut($name)
	}
    } else {
	if {[info exists tkPriv(focus,$t)]} {
	    if {![string compare $tkPriv(focus,$t) $w]} {
		set tkPriv(focus,$t) ""
	    }
	}
	catch {
	    unset tkFocusIn($t,$w)
	}
	catch {
	    unset tkFocusOut($t,$w)
	}
    }
}

# tkFocusGroup_In --
#
#	Handles the <FocusIn> event. Calls the FocusIn command for the newly
#	focused widget in the focus group.
#
proc tkFocusGroup_In {t w detail} {
    global tkPriv tkFocusIn

    if {![info exists tkFocusIn($t,$w)]} {
	set tkFocusIn($t,$w) ""
	return
    }
    if {![info exists tkPriv(focus,$t)]} {
	return
    }
    if {![string compare $tkPriv(focus,$t) $w]} {
	# This is already in focus
	#
	return
    } else {
	set tkPriv(focus,$t) $w
	eval $tkFocusIn($t,$w)
    }
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
    global tkPriv tkFocusOut

    if {[string compare $detail NotifyNonlinear] &&
	[string compare $detail NotifyNonlinearVirtual]} {
	# This is caused by mouse moving out of the window
	return
    }
    if ![info exists tkPriv(focus,$t)] {
	return
    }
    if ![info exists tkFocusOut($t,$w)] {
	return
    } else {
	eval $tkFocusOut($t,$w)
	set tkPriv(focus,$t) ""
    }
}








|


|







245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
    global tkPriv tkFocusOut

    if {[string compare $detail NotifyNonlinear] &&
	[string compare $detail NotifyNonlinearVirtual]} {
	# This is caused by mouse moving out of the window
	return
    }
    if {![info exists tkPriv(focus,$t)]} {
	return
    }
    if {![info exists tkFocusOut($t,$w)]} {
	return
    } else {
	eval $tkFocusOut($t,$w)
	set tkPriv(focus,$t) ""
    }
}

276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
    }

    set types {}
    foreach t $string {
	set label [lindex $t 0]
	set exts {}

	if [info exists hasDoneType($label)] {
	    continue
	}

	set name "$label ("
	set sep ""
	foreach ext $fileTypes($label) {
	    if ![string compare $ext ""] {
		continue
	    }
	    regsub {^[.]} $ext "*." ext
	    if ![info exists hasGotExt($label,$ext)] {
		append name $sep$ext
		lappend exts $ext
		set hasGotExt($label,$ext) 1
	    }
	    set sep ,
	}
	append name ")"







|






|



|







275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
    }

    set types {}
    foreach t $string {
	set label [lindex $t 0]
	set exts {}

	if {[info exists hasDoneType($label)]} {
	    continue
	}

	set name "$label ("
	set sep ""
	foreach ext $fileTypes($label) {
	    if {![string compare $ext ""]} {
		continue
	    }
	    regsub {^[.]} $ext "*." ext
	    if {![info exists hasGotExt($label,$ext)]} {
		append name $sep$ext
		lappend exts $ext
		set hasGotExt($label,$ext) 1
	    }
	    set sep ,
	}
	append name ")"

Changes to library/console.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
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
# console.tcl --
#
# This code constructs the console window for an application.  It
# can be used by non-unix systems that do not have built-in support
# for shells.
#
# SCCS: @(#) console.tcl 1.45 97/09/17 16:52:40
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# TODO: history - remember partially written command

# tkConsoleInit --
# This procedure constructs and configures the console windows.
#
# Arguments:
# 	None.

proc tkConsoleInit {} {
    global tcl_platform

    if {! [consoleinterp eval {set tcl_interactive}]} {
	wm withdraw .
    }

    if {"$tcl_platform(platform)" == "macintosh"} {
	set mod "Cmd"
    } else {
	set mod "Ctrl"
    }

    menu .menubar
    .menubar add cascade -label File -menu .menubar.file -underline 0
    .menubar add cascade -label Edit -menu .menubar.edit -underline 0

    menu .menubar.file -tearoff 0
    .menubar.file add command -label "Source..." -underline 0 \
	-command tkConsoleSource
    .menubar.file add command -label "Hide Console" -underline 0 \
	-command {wm withdraw .}
    if {"$tcl_platform(platform)" == "macintosh"} {
	.menubar.file add command -label "Quit" -command exit -accel Cmd-Q
    } else {
	.menubar.file add command -label "Exit" -underline 1 -command exit
    }

    menu .menubar.edit -tearoff 0
    .menubar.edit add command -label "Cut" -underline 2 \
	-command { event generate .console <<Cut>> } -accel "$mod+X"
    .menubar.edit add command -label "Copy" -underline 0 \
	-command { event generate .console <<Copy>> } -accel "$mod+C"
    .menubar.edit add command -label "Paste" -underline 1 \
	-command { event generate .console <<Paste>> } -accel "$mod+V"

    if {"$tcl_platform(platform)" == "windows"} {



	.menubar.edit add command -label "Delete" -underline 0 \
	    -command { event generate .console <<Clear>> } -accel "Del"

	.menubar add cascade -label Help -menu .menubar.help -underline 0
	menu .menubar.help -tearoff 0
	.menubar.help add command -label "About..." -underline 0 \
	    -command tkConsoleAbout
    } else {
	.menubar.edit add command -label "Clear" -underline 2 \
	    -command { event generate .console <<Clear>> }
    }

    . conf -menu .menubar

    text .console  -yscrollcommand ".sb set" -setgrid true 
    scrollbar .sb -command ".console yview"
    pack .sb -side right -fill both
    pack .console -fill both -expand 1 -side left
    if {$tcl_platform(platform) == "macintosh"} {
        .console configure -font {Monaco 9 normal} -highlightthickness 0
    }

    tkConsoleBind .console

    .console tag configure stderr -foreground red
    .console tag configure stdin -foreground blue






|


















|



|
|

|











|
|

|










|
>
>
>







<
<
<








|







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
# console.tcl --
#
# This code constructs the console window for an application.  It
# can be used by non-unix systems that do not have built-in support
# for shells.
#
# RCS: @(#) $Id: console.tcl,v 1.1.4.3 1999/04/06 03:52:51 stanton Exp $
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# TODO: history - remember partially written command

# tkConsoleInit --
# This procedure constructs and configures the console windows.
#
# Arguments:
# 	None.

proc tkConsoleInit {} {
    global tcl_platform

    if {![consoleinterp eval {set tcl_interactive}]} {
	wm withdraw .
    }

    if {[string compare $tcl_platform(platform) "macintosh"]} {
	set mod "Ctrl"
    } else {
      set mod "Cmd"
    }

    menu .menubar
    .menubar add cascade -label File -menu .menubar.file -underline 0
    .menubar add cascade -label Edit -menu .menubar.edit -underline 0

    menu .menubar.file -tearoff 0
    .menubar.file add command -label "Source..." -underline 0 \
	-command tkConsoleSource
    .menubar.file add command -label "Hide Console" -underline 0 \
	-command {wm withdraw .}
    if {[string compare $tcl_platform(platform) "macintosh"]} {
	.menubar.file add command -label "Exit" -underline 1 -command exit
    } else {
      .menubar.file add command -label "Quit" -command exit -accel Cmd-Q
    }

    menu .menubar.edit -tearoff 0
    .menubar.edit add command -label "Cut" -underline 2 \
	-command { event generate .console <<Cut>> } -accel "$mod+X"
    .menubar.edit add command -label "Copy" -underline 0 \
	-command { event generate .console <<Copy>> } -accel "$mod+C"
    .menubar.edit add command -label "Paste" -underline 1 \
	-command { event generate .console <<Paste>> } -accel "$mod+V"

    if {[string compare $tcl_platform(platform) "windows"]} {
      .menubar.edit add command -label "Clear" -underline 2 \
          -command { event generate .console <<Clear>> }
    } else {
	.menubar.edit add command -label "Delete" -underline 0 \
	    -command { event generate .console <<Clear>> } -accel "Del"

	.menubar add cascade -label Help -menu .menubar.help -underline 0
	menu .menubar.help -tearoff 0
	.menubar.help add command -label "About..." -underline 0 \
	    -command tkConsoleAbout



    }

    . conf -menu .menubar

    text .console  -yscrollcommand ".sb set" -setgrid true 
    scrollbar .sb -command ".console yview"
    pack .sb -side right -fill both
    pack .console -fill both -expand 1 -side left
    if {![string compare $tcl_platform(platform) "macintosh"]} {
        .console configure -font {Monaco 9 normal} -highlightthickness 0
    }

    tkConsoleBind .console

    .console tag configure stderr -foreground red
    .console tag configure stdin -foreground blue
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
# Arguments:
# None.

proc tkConsoleSource {} {
    set filename [tk_getOpenFile -defaultextension .tcl -parent . \
		      -title "Select a file to source" \
		      -filetypes {{"Tcl Scripts" .tcl} {"All Files" *}}]
    if {"$filename" != ""} {
    	set cmd [list source $filename]
	if [catch {consoleinterp eval $cmd} result] {
	    tkConsoleOutput stderr "$result\n"
	}
    }
}

# tkConsoleInvoke --
# Processes the command line input.  If the command is complete it
# is evaled in the main interpreter.  Otherwise, the continuation
# prompt is added and more input may be added.
#
# Arguments:
# None.

proc tkConsoleInvoke {args} {
    set ranges [.console tag ranges input]
    set cmd ""
    if {$ranges != ""} {
	set pos 0
	while {[lindex $ranges $pos] != ""} {
	    set start [lindex $ranges $pos]
	    set end [lindex $ranges [incr pos]]
	    append cmd [.console get $start $end]
	    incr pos
	}
    }
    if {$cmd == ""} {
	tkConsolePrompt
    } elseif [info complete $cmd] {
	.console mark set output end
	.console tag delete input
	set result [consoleinterp record $cmd]
	if {$result != ""} {
	    .console insert insert "$result\n"
	}
	tkConsoleHistory reset
	tkConsolePrompt
    } else {
	tkConsolePrompt partial
    }
    .console yview -pickplace insert







|

|
















|

|






|

|



|
|







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
# Arguments:
# None.

proc tkConsoleSource {} {
    set filename [tk_getOpenFile -defaultextension .tcl -parent . \
		      -title "Select a file to source" \
		      -filetypes {{"Tcl Scripts" .tcl} {"All Files" *}}]
    if {[string compare $filename ""]} {
    	set cmd [list source $filename]
	if {[catch {consoleinterp eval $cmd} result]} {
	    tkConsoleOutput stderr "$result\n"
	}
    }
}

# tkConsoleInvoke --
# Processes the command line input.  If the command is complete it
# is evaled in the main interpreter.  Otherwise, the continuation
# prompt is added and more input may be added.
#
# Arguments:
# None.

proc tkConsoleInvoke {args} {
    set ranges [.console tag ranges input]
    set cmd ""
    if {[llength $ranges]} {
	set pos 0
      while {[string compare [lindex $ranges $pos] ""]} {
	    set start [lindex $ranges $pos]
	    set end [lindex $ranges [incr pos]]
	    append cmd [.console get $start $end]
	    incr pos
	}
    }
    if {![string compare $cmd ""]} {
	tkConsolePrompt
    } elseif {[info complete $cmd]} {
	.console mark set output end
	.console tag delete input
	set result [consoleinterp record $cmd]
      if {[string compare $result ""]} {
	    puts $result
	}
	tkConsoleHistory reset
	tkConsolePrompt
    } else {
	tkConsolePrompt partial
    }
    .console yview -pickplace insert
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
proc tkConsoleHistory {cmd} {
    global histNum
    
    switch $cmd {
    	prev {
	    incr histNum -1
	    if {$histNum == 0} {
		set cmd {history event [expr [history nextid] -1]}
	    } else {
		set cmd "history event $histNum"
	    }
    	    if {[catch {consoleinterp eval $cmd} cmd]} {
    	    	incr histNum
    	    	return
    	    }
	    .console delete promptEnd end
    	    .console insert promptEnd $cmd {input stdin}
    	}
    	next {
	    incr histNum
	    if {$histNum == 0} {
		set cmd {history event [expr [history nextid] -1]}
	    } elseif {$histNum > 0} {
		set cmd ""
		set histNum 1
	    } else {
		set cmd "history event $histNum"
	    }
	    if {$cmd != ""} {
		catch {consoleinterp eval $cmd} cmd
	    }
	    .console delete promptEnd end
	    .console insert promptEnd $cmd {input stdin}
    	}
    	reset {
    	    set histNum 1
    	}
    }
}

# tkConsolePrompt --
# This procedure draws the prompt.  If tcl_prompt1 or tcl_prompt2
# exists in the main interpreter it will be called to generate the 
# prompt.  Otherwise, a hard coded default prompt is printed.
#
# Arguments:
# partial -	Flag to specify which prompt to print.

proc tkConsolePrompt {{partial normal}} {
    if {$partial == "normal"} {
	set temp [.console index "end - 1 char"]
	.console mark set output end
    	if [consoleinterp eval "info exists tcl_prompt1"] {
    	    consoleinterp eval "eval \[set tcl_prompt1\]"
    	} else {
    	    puts -nonewline "% "
    	}
    } else {
	set temp [.console index output]
	.console mark set output end
    	if [consoleinterp eval "info exists tcl_prompt2"] {
    	    consoleinterp eval "eval \[set tcl_prompt2\]"
    	} else {
	    puts -nonewline "> "
    	}
    }
    flush stdout
    .console mark set output $temp







|













|






|




















|


|







|







164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
proc tkConsoleHistory {cmd} {
    global histNum
    
    switch $cmd {
    	prev {
	    incr histNum -1
	    if {$histNum == 0} {
		set cmd {history event [expr {[history nextid] -1}]}
	    } else {
		set cmd "history event $histNum"
	    }
    	    if {[catch {consoleinterp eval $cmd} cmd]} {
    	    	incr histNum
    	    	return
    	    }
	    .console delete promptEnd end
    	    .console insert promptEnd $cmd {input stdin}
    	}
    	next {
	    incr histNum
	    if {$histNum == 0} {
		set cmd {history event [expr {[history nextid] -1}]}
	    } elseif {$histNum > 0} {
		set cmd ""
		set histNum 1
	    } else {
		set cmd "history event $histNum"
	    }
          if {[string compare $cmd ""]} {
		catch {consoleinterp eval $cmd} cmd
	    }
	    .console delete promptEnd end
	    .console insert promptEnd $cmd {input stdin}
    	}
    	reset {
    	    set histNum 1
    	}
    }
}

# tkConsolePrompt --
# This procedure draws the prompt.  If tcl_prompt1 or tcl_prompt2
# exists in the main interpreter it will be called to generate the 
# prompt.  Otherwise, a hard coded default prompt is printed.
#
# Arguments:
# partial -	Flag to specify which prompt to print.

proc tkConsolePrompt {{partial normal}} {
    if {![string compare $partial "normal"]} {
	set temp [.console index "end - 1 char"]
	.console mark set output end
    	if {[consoleinterp eval "info exists tcl_prompt1"]} {
    	    consoleinterp eval "eval \[set tcl_prompt1\]"
    	} else {
    	    puts -nonewline "% "
    	}
    } else {
	set temp [.console index output]
	.console mark set output end
    	if {[consoleinterp eval "info exists tcl_prompt2"]} {
    	    consoleinterp eval "eval \[set tcl_prompt2\]"
    	} else {
	    puts -nonewline "> "
    	}
    }
    flush stdout
    .console mark set output $temp
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
    bind $win <Return> {
	%W mark set insert {end - 1c}
	tkConsoleInsert %W "\n"
	tkConsoleInvoke
	break
    }
    bind $win <Delete> {
	if {[%W tag nextrange sel 1.0 end] != ""} {
	    %W tag remove sel sel.first promptEnd
	} else {
	    if [%W compare insert < promptEnd] {
		break
	    }
	}
    }
    bind $win <BackSpace> {
	if {[%W tag nextrange sel 1.0 end] != ""} {
	    %W tag remove sel sel.first promptEnd
	} else {
	    if [%W compare insert <= promptEnd] {
		break
	    }
	}
    }
    foreach left {Control-a Home} {
	bind $win <$left> {
	    if [%W compare insert < promptEnd] {
		tkTextSetCursor %W {insert linestart}
	    } else {
		tkTextSetCursor %W promptEnd
            }
	    break
	}
    }
    foreach right {Control-e End} {
	bind $win <$right> {
	    tkTextSetCursor %W {insert lineend}
	    break
	}
    }
    bind $win <Control-d> {
	if [%W compare insert < promptEnd] {
	    break
	}
    }
    bind $win <Control-k> {
	if [%W compare insert < promptEnd] {
	    %W mark set insert promptEnd
	}
    }
    bind $win <Control-t> {
	if [%W compare insert < promptEnd] {
	    break
	}
    }
    bind $win <Meta-d> {
	if [%W compare insert < promptEnd] {
	    break
	}
    }
    bind $win <Meta-BackSpace> {
	if [%W compare insert <= promptEnd] {
	    break
	}
    }
    bind $win <Control-h> {
	if [%W compare insert <= promptEnd] {
	    break
	}
    }
    foreach prev {Control-p Up} {
	bind $win <$prev> {
	    tkConsoleHistory prev
	    break







|


|





|


|






|














|




|




|




|




|




|







264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
    bind $win <Return> {
	%W mark set insert {end - 1c}
	tkConsoleInsert %W "\n"
	tkConsoleInvoke
	break
    }
    bind $win <Delete> {
      if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
	    %W tag remove sel sel.first promptEnd
	} else {
	    if {[%W compare insert < promptEnd]} {
		break
	    }
	}
    }
    bind $win <BackSpace> {
      if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
	    %W tag remove sel sel.first promptEnd
	} else {
	    if {[%W compare insert <= promptEnd]} {
		break
	    }
	}
    }
    foreach left {Control-a Home} {
	bind $win <$left> {
	    if {[%W compare insert < promptEnd]} {
		tkTextSetCursor %W {insert linestart}
	    } else {
		tkTextSetCursor %W promptEnd
            }
	    break
	}
    }
    foreach right {Control-e End} {
	bind $win <$right> {
	    tkTextSetCursor %W {insert lineend}
	    break
	}
    }
    bind $win <Control-d> {
	if {[%W compare insert < promptEnd]} {
	    break
	}
    }
    bind $win <Control-k> {
	if {[%W compare insert < promptEnd]} {
	    %W mark set insert promptEnd
	}
    }
    bind $win <Control-t> {
	if {[%W compare insert < promptEnd]} {
	    break
	}
    }
    bind $win <Meta-d> {
	if {[%W compare insert < promptEnd]} {
	    break
	}
    }
    bind $win <Meta-BackSpace> {
	if {[%W compare insert <= promptEnd]} {
	    break
	}
    }
    bind $win <Control-h> {
	if {[%W compare insert <= promptEnd]} {
	    break
	}
    }
    foreach prev {Control-p Up} {
	bind $win <$prev> {
	    tkConsoleHistory prev
	    break
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
    }
    bind $win <KeyPress> {
	tkConsoleInsert %W %A
	break
    }
    foreach left {Control-b Left} {
	bind $win <$left> {
	    if [%W compare insert == promptEnd] {
		break
	    }
	    tkTextSetCursor %W insert-1c
	    break
	}
    }
    foreach right {Control-f Right} {
	bind $win <$right> {
	    tkTextSetCursor %W insert+1c
	    break
	}
    }
    bind $win <F9> {
	eval destroy [winfo child .]
	if {$tcl_platform(platform) == "macintosh"} {
	    source -rsrc Console
	} else {
	    source [file join $tk_library console.tcl]
	}
    }
    bind $win <<Cut>> {
        # Same as the copy event







|














|







349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
    }
    bind $win <KeyPress> {
	tkConsoleInsert %W %A
	break
    }
    foreach left {Control-b Left} {
	bind $win <$left> {
	    if {[%W compare insert == promptEnd]} {
		break
	    }
	    tkTextSetCursor %W insert-1c
	    break
	}
    }
    foreach right {Control-f Right} {
	bind $win <$right> {
	    tkTextSetCursor %W insert+1c
	    break
	}
    }
    bind $win <F9> {
	eval destroy [winfo child .]
      if {![string compare $tcl_platform(platform) "macintosh"]} {
	    source -rsrc Console
	} else {
	    source [file join $tk_library console.tcl]
	}
    }
    bind $win <<Cut>> {
        # Same as the copy event
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
# is restricted to the prompt area.
#
# Arguments:
# w -		The text window in which to insert the string
# s -		The string to insert (usually just a single character)

proc tkConsoleInsert {w s} {
    if {$s == ""} {
	return
    }
    catch {
	if {[$w compare sel.first <= insert]
		&& [$w compare sel.last >= insert]} {
	    $w tag remove sel sel.first promptEnd
	    $w delete sel.first sel.last







|







412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
# is restricted to the prompt area.
#
# Arguments:
# w -		The text window in which to insert the string
# s -		The string to insert (usually just a single character)

proc tkConsoleInsert {w s} {
    if {![string compare $s ""]} {
	return
    }
    catch {
	if {[$w compare sel.first <= insert]
		&& [$w compare sel.last >= insert]} {
	    $w tag remove sel sel.first promptEnd
	    $w delete sel.first sel.last

Changes to library/demos/README.

39
40
41
42
43
44
45
46
		Control-c and control-q cause it to exit.

browse -	A simple directory browser.  Invoke it with and argument
		giving the name of the directory you'd like to browse.
		Double-click on files or subdirectories to browse them.
		Control-c and control-q cause the program to exit.

sccs id = SCCS: @(#) README 1.3 96/02/16 10:49:14







|
39
40
41
42
43
44
45
46
		Control-c and control-q cause it to exit.

browse -	A simple directory browser.  Invoke it with and argument
		giving the name of the directory you'd like to browse.
		Double-click on files or subdirectories to browse them.
		Control-c and control-q cause the program to exit.

RCS: @(#) $Id: README,v 1.1.4.1 1998/09/30 02:17:40 stanton Exp $

Changes to library/demos/arrow.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# arrow.tcl --
#
# This demonstration script creates a canvas widget that displays a
# large line with an arrowhead whose shape can be edited interactively.
#
# SCCS: @(#) arrow.tcl 1.8 97/03/02 16:18:20

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# arrowSetup --
# This procedure regenerates all the text and graphics in the canvas





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# arrow.tcl --
#
# This demonstration script creates a canvas widget that displays a
# large line with an arrowhead whose shape can be edited interactively.
#
# RCS: @(#) $Id: arrow.tcl,v 1.1.4.1 1998/09/30 02:17:40 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# arrowSetup --
# This procedure regenerates all the text and graphics in the canvas

Changes to library/demos/bind.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# bind.tcl --
#
# This demonstration script creates a text widget with bindings set
# up for hypertext-like effects.
#
# SCCS: @(#) bind.tcl 1.6 97/03/02 16:19:01

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .bind
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# bind.tcl --
#
# This demonstration script creates a text widget with bindings set
# up for hypertext-like effects.
#
# RCS: @(#) $Id: bind.tcl,v 1.1.4.1 1998/09/30 02:17:40 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .bind
catch {destroy $w}

Changes to library/demos/bitmap.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# bitmap.tcl --
#
# This demonstration script creates a toplevel window that displays
# all of Tk's built-in bitmaps.
#
# SCCS: @(#) bitmap.tcl 1.6 97/03/02 16:19:20

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# bitmapRow --
# Create a row of bitmap items in a window.





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# bitmap.tcl --
#
# This demonstration script creates a toplevel window that displays
# all of Tk's built-in bitmaps.
#
# RCS: @(#) $Id: bitmap.tcl,v 1.1.4.1 1998/09/30 02:17:41 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# bitmapRow --
# Create a row of bitmap items in a window.

Changes to library/demos/browse.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# browse --
# This script generates a directory browser, which lists the working
# directory and allows you to open files or subdirectories by
# double-clicking.
#
# SCCS: @(#) browse 1.8 96/02/16 10:49:18

# Create a scrollbar on the right side of the main window and a listbox
# on the left side.

scrollbar .scroll -command ".list yview"
pack .scroll -side right -fill y
listbox .list -yscroll ".scroll set" -relief sunken -width 20 -height 20 \









|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# browse --
# This script generates a directory browser, which lists the working
# directory and allows you to open files or subdirectories by
# double-clicking.
#
# RCS: @(#) $Id: browse,v 1.1.4.1 1998/09/30 02:17:41 stanton Exp $

# Create a scrollbar on the right side of the main window and a listbox
# on the left side.

scrollbar .scroll -command ".list yview"
pack .scroll -side right -fill y
listbox .list -yscroll ".scroll set" -relief sunken -width 20 -height 20 \

Changes to library/demos/button.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# button.tcl --
#
# This demonstration script creates a toplevel window containing
# several button widgets.
#
# SCCS: @(#) button.tcl 1.5 97/03/02 16:19:39

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .button
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# button.tcl --
#
# This demonstration script creates a toplevel window containing
# several button widgets.
#
# RCS: @(#) $Id: button.tcl,v 1.1.4.1 1998/09/30 02:17:42 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .button
catch {destroy $w}

Changes to library/demos/check.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# check.tcl --
#
# This demonstration script creates a toplevel window containing
# several checkbuttons.
#
# SCCS: @(#) check.tcl 1.4 97/03/02 16:19:57

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .check
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# check.tcl --
#
# This demonstration script creates a toplevel window containing
# several checkbuttons.
#
# RCS: @(#) $Id: check.tcl,v 1.1.4.1 1998/09/30 02:17:42 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .check
catch {destroy $w}

Changes to library/demos/clrpick.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# clrpick.tcl --
#
# This demonstration script prompts the user to select a color.
#
# SCCS: @(#) clrpick.tcl 1.3 97/03/02 16:20:12

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .clrpick
catch {destroy $w}




|







1
2
3
4
5
6
7
8
9
10
11
12
# clrpick.tcl --
#
# This demonstration script prompts the user to select a color.
#
# RCS: @(#) $Id: clrpick.tcl,v 1.1.4.1 1998/09/30 02:17:42 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .clrpick
catch {destroy $w}

Changes to library/demos/colors.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# colors.tcl --
#
# This demonstration script creates a listbox widget that displays
# many of the colors from the X color database.  You can click on
# a color to change the application's palette.
#
# SCCS: @(#) colors.tcl 1.4 97/03/02 16:20:29

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .colors
catch {destroy $w}






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# colors.tcl --
#
# This demonstration script creates a listbox widget that displays
# many of the colors from the X color database.  You can click on
# a color to change the application's palette.
#
# RCS: @(#) $Id: colors.tcl,v 1.1.4.1 1998/09/30 02:17:43 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .colors
catch {destroy $w}

Changes to library/demos/cscroll.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# cscroll.tcl --
#
# This demonstration script creates a simple canvas that can be
# scrolled in two dimensions.
#
# SCCS: @(#) cscroll.tcl 1.6 97/03/02 16:20:45

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .cscroll
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# cscroll.tcl --
#
# This demonstration script creates a simple canvas that can be
# scrolled in two dimensions.
#
# RCS: @(#) $Id: cscroll.tcl,v 1.1.4.1 1998/09/30 02:17:43 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .cscroll
catch {destroy $w}

Changes to library/demos/ctext.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# ctext.tcl --
#
# This demonstration script creates a canvas widget with a text
# item that can be edited and reconfigured in various ways.
#
# SCCS: @(#) ctext.tcl 1.6 97/03/02 16:21:02

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .ctext
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# ctext.tcl --
#
# This demonstration script creates a canvas widget with a text
# item that can be edited and reconfigured in various ways.
#
# RCS: @(#) $Id: ctext.tcl,v 1.1.4.1 1998/09/30 02:17:43 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .ctext
catch {destroy $w}

Changes to library/demos/dialog1.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# dialog1.tcl --
#
# This demonstration script creates a dialog box with a local grab.
#
# SCCS: @(#) dialog1.tcl 1.2 96/02/16 10:49:52

after idle {.dialog1.msg configure -wraplength 4i}
set i [tk_dialog .dialog1 "Dialog with local grab" {This is a modal dialog box.  It uses Tk's "grab" command to create a "local grab" on the dialog box.  The grab prevents any pointer-related events from getting to any other windows in the application until you have answered the dialog by invoking one of the buttons below.  However, you can still interact with other applications.} \
info 0 OK Cancel {Show Code}]

switch $i {
    0 {puts "You pressed OK"}




|







1
2
3
4
5
6
7
8
9
10
11
12
# dialog1.tcl --
#
# This demonstration script creates a dialog box with a local grab.
#
# RCS: @(#) $Id: dialog1.tcl,v 1.1.4.1 1998/09/30 02:17:44 stanton Exp $

after idle {.dialog1.msg configure -wraplength 4i}
set i [tk_dialog .dialog1 "Dialog with local grab" {This is a modal dialog box.  It uses Tk's "grab" command to create a "local grab" on the dialog box.  The grab prevents any pointer-related events from getting to any other windows in the application until you have answered the dialog by invoking one of the buttons below.  However, you can still interact with other applications.} \
info 0 OK Cancel {Show Code}]

switch $i {
    0 {puts "You pressed OK"}

Changes to library/demos/dialog2.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# dialog2.tcl --
#
# This demonstration script creates a dialog box with a global grab.
#
# SCCS: @(#) dialog2.tcl 1.2 96/02/16 10:49:53

after idle {
    .dialog2.msg configure -wraplength 4i
}
after 100 {
    grab -global .dialog2
}




|







1
2
3
4
5
6
7
8
9
10
11
12
# dialog2.tcl --
#
# This demonstration script creates a dialog box with a global grab.
#
# RCS: @(#) $Id: dialog2.tcl,v 1.1.4.1 1998/09/30 02:17:44 stanton Exp $

after idle {
    .dialog2.msg configure -wraplength 4i
}
after 100 {
    grab -global .dialog2
}

Changes to library/demos/entry1.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# entry1.tcl --
#
# This demonstration script creates several entry widgets without
# scrollbars.
#
# SCCS: @(#) entry1.tcl 1.5 97/03/02 16:22:10

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .entry1
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# entry1.tcl --
#
# This demonstration script creates several entry widgets without
# scrollbars.
#
# RCS: @(#) $Id: entry1.tcl,v 1.1.4.1 1998/09/30 02:17:44 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .entry1
catch {destroy $w}

Changes to library/demos/entry2.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# entry2.tcl --
#
# This demonstration script is the same as the entry1.tcl script
# except that it creates scrollbars for the entries.
#
# SCCS: @(#) entry2.tcl 1.5 97/03/02 16:22:24

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .entry2
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# entry2.tcl --
#
# This demonstration script is the same as the entry1.tcl script
# except that it creates scrollbars for the entries.
#
# RCS: @(#) $Id: entry2.tcl,v 1.1.4.1 1998/09/30 02:17:45 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .entry2
catch {destroy $w}

Changes to library/demos/filebox.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# filebox.tcl --
#
# This demonstration script prompts the user to select a file.
#
# SCCS: @(#) filebox.tcl 1.3 97/03/02 16:22:36

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .filebox
catch {destroy $w}




|







1
2
3
4
5
6
7
8
9
10
11
12
# filebox.tcl --
#
# This demonstration script prompts the user to select a file.
#
# RCS: @(#) $Id: filebox.tcl,v 1.1.4.1 1998/09/30 02:17:45 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .filebox
catch {destroy $w}

Changes to library/demos/floor.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# floor.tcl --
#
# This demonstration script creates a canvas widet that displays the
# floorplan for DEC's Western Research Laboratory.
#
# SCCS: @(#) floor.tcl 1.6 97/03/02 16:23:32

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# floorDisplay --
# Recreate the floorplan display in the canvas given by "w".  The





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# floor.tcl --
#
# This demonstration script creates a canvas widet that displays the
# floorplan for DEC's Western Research Laboratory.
#
# RCS: @(#) $Id: floor.tcl,v 1.1.4.1 1998/09/30 02:17:45 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# floorDisplay --
# Recreate the floorplan display in the canvas given by "w".  The

Changes to library/demos/form.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# form.tcl --
#
# This demonstration script creates a simple form with a bunch
# of entry widgets.
#
# SCCS: @(#) form.tcl 1.5 97/03/02 16:23:48

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .form
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# form.tcl --
#
# This demonstration script creates a simple form with a bunch
# of entry widgets.
#
# RCS: @(#) $Id: form.tcl,v 1.1.4.1 1998/09/30 02:17:46 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .form
catch {destroy $w}

Changes to library/demos/hello.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# hello --
# Simple Tk script to create a button that prints "Hello, world".
# Click on the button to terminate the program.
#
# SCCS: @(#) hello 1.6 96/02/16 10:49:18
# 
# The first line below creates the button, and the second line
# asks the packer to shrink-wrap the application's main window
# around the button.

button .hello -text "Hello, world" -command {
    puts stdout "Hello, world"; destroy .








|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# hello --
# Simple Tk script to create a button that prints "Hello, world".
# Click on the button to terminate the program.
#
# RCS: @(#) $Id: hello,v 1.1.4.1 1998/09/30 02:17:47 stanton Exp $
# 
# The first line below creates the button, and the second line
# asks the packer to shrink-wrap the application's main window
# around the button.

button .hello -text "Hello, world" -command {
    puts stdout "Hello, world"; destroy .

Changes to library/demos/hscale.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# hscale.tcl --
#
# This demonstration script shows an example with a horizontal scale.
#
# SCCS: @(#) hscale.tcl 1.4 97/03/02 16:24:01

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .hscale
catch {destroy $w}




|







1
2
3
4
5
6
7
8
9
10
11
12
# hscale.tcl --
#
# This demonstration script shows an example with a horizontal scale.
#
# RCS: @(#) $Id: hscale.tcl,v 1.1.4.1 1998/09/30 02:17:47 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .hscale
catch {destroy $w}

Changes to library/demos/icon.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# icon.tcl --
#
# This demonstration script creates a toplevel window containing
# buttons that display bitmaps instead of text.
#
# SCCS: @(#) icon.tcl 1.8 97/03/02 16:24:19

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .icon
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# icon.tcl --
#
# This demonstration script creates a toplevel window containing
# buttons that display bitmaps instead of text.
#
# RCS: @(#) $Id: icon.tcl,v 1.1.4.1 1998/09/30 02:17:48 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .icon
catch {destroy $w}

Changes to library/demos/image1.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# image1.tcl --
#
# This demonstration script displays two image widgets.
#
# SCCS: @(#) image1.tcl 1.6 97/03/02 16:24:35

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .image1
catch {destroy $w}




|







1
2
3
4
5
6
7
8
9
10
11
12
# image1.tcl --
#
# This demonstration script displays two image widgets.
#
# RCS: @(#) $Id: image1.tcl,v 1.1.4.1 1998/09/30 02:17:48 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .image1
catch {destroy $w}

Changes to library/demos/image2.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# image2.tcl --
#
# This demonstration script creates a simple collection of widgets
# that allow you to select and view images in a Tk label.
#
# SCCS: @(#) image2.tcl 1.9 97/03/02 16:24:48

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# loadDir --
# This procedure reloads the directory listbox from the directory





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# image2.tcl --
#
# This demonstration script creates a simple collection of widgets
# that allow you to select and view images in a Tk label.
#
# RCS: @(#) $Id: image2.tcl,v 1.1.4.1 1998/09/30 02:17:48 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# loadDir --
# This procedure reloads the directory listbox from the directory

Deleted library/demos/images/earth.gif.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
GIF87a@�����         ( (( 00(88(88(@80@@0@H0@H8@80H@0HH0H88H@8HH8HP8HX8HH@HP@HX@H`@H80P@0P88P@8PH8PP8P@@PH@PP@PX@P`@PPHPXHP`HPhHP88X@8XH8XP8X@@XH@XP@XX@XHHXPHXXHX`HXhHXXPX`PXhPXpPXhXX@@`H@`P@`HH`PH`XH``H`PP`XP``P`hP`pP``X`hX`pX`xX`p``x``H@hHHhPHhXHh`HhPPhXPh`PhhPhpPhXXh`XhhXhpXhxXhh`hp`hx`h�`hxhh�hh�hhPPpXPp`PpXXp`XphXppXph`pp`px`p�`pphpxhp�hp�hp�hp�pp�pp�pp�pp�xp�xpPPxXXx`XxhXxh`xp`xx`xphxxhx�hx�hxxpx�px�px�px�px�xx�xx�xx�xx��x��x��x��xh`�ph�xh�xp��p��p��x��x��x��x��x�����������������������������x��x��x����������������������������������������������������������������������������������������������������������������������������������Ȩ�Ȱ�������Ȩ����Ȱ�а�и�Ȱ�ȸ�и��������ȸ�ȸ�и���,@��0X@��� 4@��B�:<� � D|HAC�+~l8`cńD"G�Z� �X����/��s�+Z̘�ٯ_�x���S`Uy�괩0H|��3�
�����ηP��6gN�.�0���&�����]�v���]t:F�6m��o�
&lA�e0\H��h�i1D��C�b���5�4`��A���9<	3�J�N�,X���C"	��H�'�$����4�|>����9c�x�#
P��1֫�/�II��J/U��U}�,Ք|��ҋ+�P�$x���E�evYN,�fq���ESc$*�Wc���!v�tمVaT��]T�Ze��ڐ��f�l�m@�k�ep��E)���5g%q9�\K�T�Dx9\�Ids$0���%�vY
$'��i@y�B�0�0#�5�8�+�X�J%���	,�0��3�#��}2��5�\C�}X5�+���d�v�igݨ�`n)�_�l��㉍��@�.��Z��EcZ����4֕��l�XZh�+dZ��k����$٤oR��.	$�x5��DqyQṯTfC+UW����M��$ӹk҄/h�����4�6��5��B�%����'�dB!�d�q,���-�t�	0�D��6�`�L0̼bU~��R/�����aX�Z8���[;KXdg��@�kqX��K�u|l��1�t����Zh�Z��U�A��Җm����o���q
���ed/���Q��o/@�M���J�"��x��$Pax�����3�T�L��L3M4�3i+��L+�\�q#��~�(�|2�,�RL5洓8�h��8�g��3�830���p!^�@�:Q��I4�oU_�MH۔V^��]�E�L�ָR�V��,j�)l�ӆ-Jr+e����0��Kb���l��rg����_�9@��S��I�.�%P��U����F9�A�q���@�5�A�X���`
a	F�Nu8L�'шD|B��0G9�a;qp�w&�3���l<���,z�
^P�<�@O����
/��	���h��U�����5-G
��
���%Z�K͐��3�XlD[�x���7tL��9�J���7�`�����$�5�9��Np�~!�� U�
XP���0�^���X����Axb�H�#Rw�~���,�� n1��7��[����8��f���YZ��fM�3uq^��(� �F�1Z�3�O}�����t�Ϥ��I�.��!�O6ԪMْ������R��"�U��AD<-��� ��ܚ����- �6�JUb��P�0_Ģ��C ��>�a m�2?�Q5y@f�z
d&"�HF:�qi����8�Q n|�������f,��Ђ8p� F-mi�����J|M{˭~�W�F�D�ht����k;��AU�5��F4Y�Ml4�?�Q�Q�K�:���&"u�-�H-ы]
�����9e���r�@ ��"\+��AO���1h�	OX��`�� �G��8EtOq�<�ay`�vW'h8C���.�эj����F9�юr�����5��WZ͏v��t�hgli�;��}��0�gӸ��H`U�q�gX���F��}�oԆ��ą_��w�EQvAD���,�<��t� ^�йʓ��"'xџT��� �+�Q�lHü�&S�+Յ�OmD���j����-Fqc�N��;�Q�f�#����9xW�lbì@��h��TM0nQ�*�Pڥ%�	44W�Ѕ���i"�O�4Z:�@i�f�m�H�c��h?�z�7��ۼ����̍��ߪ��$Ān�DA��)D5fma�	W�"���UV1	L�B׀�5�*�*��ʐ�2`��<<5��T]R��CcH#���d!�Z�ΐ��!fw�C��2���J�,�UUe�ע[-�������[�(3:�@� �4���N�egf�����cl�6�R8\�j��RN���@@������W��#�:��	r*�1fh��F1��eK[��a�Ug k ]�&!QO���}D����=;xP�(Tg�]p��8/4���w�������cTT!��~gd#��L3�ʉ��̢�kUp4Lf�����٣A_�,�f�6��ԛAgE��Ss,�������8I���v������	����@���:�6��p�җ����c�I��ꈭ'ۏ0E�U�����x�1G���OY�����vx���xʧP���B�[Z@9×��1D�)��j���>�q�l�>C�OC2i�5-�H����$lS��z�!�b,g�.�A@��Z��/��0�	��A�p����n���W�U�  ��eK�t�P|�� �f^Fv��q`b`��C��u��l�f�Y� ��֠� 
�3
�0
`����cF�@Y�� dQij�#>�*Op+�B�E*`��x7,�!�o�Os�>���,G"?��iI�?P�-��"��I
�%T,WQncj\rI�q��H�a7�/@�
�`�p
��0�gh��{��]���^7|�DT`Fpa�v��m��C�|��0 �`	<�	� 
�P� g�P���<� �&	7��O�gX���=� �_m�`�f=o�h��,�- �y���$��?q0�Z��H�j����z�Fb���Z)�j��Rc�	� ��t���@��U�(�|Og �W�ˆC7�TcG0G`CB�TUfeNG}K���pTy��0��
��`�@�@�`�0����� 	3�V��g��S#;�gvv�3�t1Gi!���,�B!"?�wH��y5�8��.Q��1c�r��E/vrqA[b�	��
�`H�e����X�� ���?�tӇ�7Ąm@EZ�]v0نtM�Է]���0 �� �H��D�� �� �3���?�)�	�_�Q��4�r�#��"Jsptd�۹*���g�b���{y��pi-�"6�rGH��" �&��b�E7��j�"''e7�Gs/�
������8f��u?X|[e E���Ier�g0LL�TŔ�ְ�@�ζ]Rh W� �P�@D��� � ��&��03�3VT�O�Q5KW�F,Dz}�hw�7��G=U����$-�a��6.fT�a��&b[m��z𲇣/	�r��!�! ��c@���ڡ��{� �`�:}c�����F0EX�u�f �����E	���{�� ��1��
�Ъ�`S�P�27�
��
3�Z�W�!��O�O$b#�`�1�#v����a=;aXr�*�I#�s?j#%^����2��)R�r��#'sj��8��q�3w�
���ӥ]<h|��l���MmɀGP8�P}�`]�`�p|���Ry��ʋI�	`z���|	|Ъ��	�P����
���� 3�@	�6���ohqRF4}�*��h�QX��!h��्��K*yJZ�gYQ��kl�z�z��7ɦ�GR
1c�.�	�^��TJu���m�W��ȯ�e]Rm�0Qp9���p
�`����Kŋ��z`ip���Ъ��
�j	�0��0��
��
'[��(pG��""`}Xt�h�XX�h�J�Wg@�I?uy�G�VH0t��tC����ci��0QX��Qc�3?��^�d��r@L�z�L����u9��	�09``
4�]b�{ć�9���j`�+�}�S�@	�*	�	��
��	��	����J�� Iq�xȏ�ҳsp��`wp��b�2,Zc$��������W�´e%"�$�I�?�r�ë �P�ư�&�ר�5���T�5�H��`�p�h��tu��܆Tm�`�W�jP��	��
��\	}p��k	��	\�	$�J��
�y	e�opeJ�p�_�A>�sx0,����`��>��B-Պ5e�6��a����T��&L%9zފ%�/����)�İ�6�;ʩs]��]�%a�����B���T�؛�FP�TPePg`Tl�z���
�P�ż�[�X�	�`	��	'���[+X�q8a�S�����L��"qƺ�d�u�X[�G���;�N‘��,�b"b�g��Ia���j3w4�d�)4<���Ч��;	�c�Pa`Ѧ���P
y�x�l����lr�]�Cp��d R0U�ePS�����`�^L��\̒𾨀	'�	��J��
n��iA��bT�u��lq�}�!L*Pva��u!��O�fiYS-�;Y�ȈQc�%	ꘉ�I��I!���k7A"�^P� ޖdg;�O��ѩ|��L�m���	�P��� 3L]>�	m`XPFPT`V@S0e@U�˾,f����
}���
�����K��P	�����J��ƪ�c�͓N�l5�ԏ�W���X;[Gƞ��!�s���q��$�� +h�b����!z:'�TR1Q*�#��0��3LÓ�]�{I'�=ʃ������]��:�p���p1X�W�K`�S �}P���m�f��d�W�~��@	��	����k�ƌ���
��	��ۨD	H0!j�rq6b���l!GO�A/k�ϽG��`�a��y	%�Z�Jbܚr8��:����A[8Ű���Ϧ����9��a��=��]�> �;�p�u��:��e�L�B�F��ZE��~�y�ppT`�k�˽|�@	����	����
���}���<	ۈ	�P��AD���L�y�gR�n�h���k�܄�,�g��̂��"�~�������hz]��� �YyA�Y~zJ.������9���]7�����u]�u�cp
��Ђ]���LP����]0Lx�ӵl�P
�����X��7�pS0K`g@~g��P	�|p[�pװ	��
��,>	��`4�
���B���o��gYm�sE'A��Ȳ`��>���F���d�^�aq
Aar/f4!Q���������0�
Ġ�.X�`+�.�a���-�]o�P��.���uN�0��v�����	�����u'��S`W�fPY��o�i0���p	���
��JWlۓ�
�`	�������Ple|W�K�>г#�3�ٙ`8��B@��fP�Q�ǀ`s�`hy�ޗ�b(����Q�	s�izR�
����U���K�a`������]�~�^�>�Pp]R�:����|��H��Po�on�j�jоj�����
U�H��H�*Oʹ�;w�תU�x�2�J�	D^x�A�"M�����(�L��Bʙ%D���fM�x�T��&�"1����i�N3p��!�Lx���a�]0�lX�.(���Y�e�:V-��2`PR�%V���u��aĉ/n�q�<vƄ	��e(L~@�f��.�?4� ���);]�0YM:��<�?2e͚1c�v%
���aj��C��$A���D�O�L���I���&K��H��P�B��(Q�l[9sڮ�����*T�x��>S�5_B�)����Dz�'��`&�XЂFʀ��0�����J����P�����.��+D��+��X�D�0k,��&�dd����˂.���;̘�SF�>#�����2̘`��2��J�4�a�u��טx
GJa���0%�FF���"+R1&��8��?�(�+����?8y�N��7Ԁ�K��C�4���;�bH@��r�ن�s����R�ύ�Ͽ�n�৮`u ��^��U�N��Wa5��� Xʦ�dЩ/TV�4�`��F|ˁ�J,���*�Z��E�,jG�Q�h��`���H#�<��ߚ�,J)E��v��4&��R̉�s�h�-M�FYn1�0a�SLI�����1�*���5�d�7��" 9Ta� ?��"�>��Š4�@�꾋D�����DM��F�q��l��SS1��˯&�X�6��d�	�Q�il[��`l��0¥,lC��j���KķN��E߲��	����p_ꀒ^��melC�7����D"{m�zK��}��a`З��|x�R�1��v�#�<���M>y�LSdi�Y����;VL�(c
)�X�6@Ʉ+F>c�5�PC5�Ï?��Œ4���= გIa��l��a�цR7�(>=Bh�$�V����'&1��ت���?� 	���	Y`K�R�!E�*p���h�-�M-
��\�%��	�.|1�KdD��x@�pF6��8kH�HyH�l*����Aa��`�|���sAa��~�t:]4ц0ĢSz�2���6�B���"�ЈG�b���bLј�������@��F���/h!	Z����7�o |�á �(=�A��D&A�=���0�<��x���xF0�a���>)��}�6 ��
@	J�B6��MW2�OJ�f^�A��zJT�v��h�\����B���ny!a]H��j�(.
�QYH�B�<`n�E3������7���'"#�1�3�����%,`�
V����/��t��-q=�\t!BPf��#�!�4�9��-0��Ɲ�F��1��2a
U�B���&hao��)ꔁj���J���D��J�Bh}�!�! u�#���;��_�DEQ9��k�]�	W5 �e���N~���V�L�`�nR��)EC���������"��"�@�Z]�QW��X�$YHE3�q$~�����l��$;l�2P�����A6x�
N��@t���>C'�� 0`�F��<Xl�SF�
c�[�����'0&$#=.���AhP���E(��p�5� o�%�@�F��~0Cx�@TID�|�� 0�W$�R�G=�1�p���/:�
I�@�k�N�:�Dl�����5��2?kS+wR�
T�*ls�������v9�7E"n��n|�����͹�-H�So(�6����h�yR&3\������@K����ز
a��|������W�@��ޢ����E'j�]�B��F�T�[4�H����#d�Y��������z� �`�l�}�$�JH����#A`4�G�Aw�#�XE*V���(؀B� ���+P,�k hl#��Q
$l%��Ō�ܢ�������=a�����E���\^�Tʐ�˭f!=�E����e�T�O����.0y�x`�#�%��cLbi\�O������.�Q�]��i�;ea p�F�`IGQ
�8��J���p�7�a {P��`h�N�V�C�ڻ�3����"f��A�Bg(���`�XB��o�uh�10*"57x`*v��V֠�l��	쓟Z)(lk����A��e�
���5ͻ��n�Taa\�qɘ�+�! ih�0�`�.~�wdz ��weXSZ(C!x�L�0�:�a��. ��D�"�(�-LQ
B����n��c0��0�(Fz�<�"�YG<�|�[@T7�6�%�p�#$a�k��ܠC���R ����7�AjD ��9�B ���*$Q�3�a���$*�
nH���<��_hV����,����:ɕ��%^�	a��_я�����I��x�H
cI�Ðpa!n	!�����Ċ�1��hё��,XgP�;�5��OX�[��.�6�0P�',��#�}aBЅ]X[(D@��KOȅb�D�MH�d a`��ӄC�0`0�X�cx�OPs�d� :�X3eh.ܐ Z��!�AR#Ђ?��L2)��9P��$�)0��J��7��J�4�;B��K�A�?��H`?�O��n�x��v0�kX���H�?@��[��U�p��H
�a����5a�
J��1s�����0A�8�kA�i����1�I��1B�S8�D�C�H�|0��/�:X�PH�#H�(����iPFp.0D�X�9 �C�j�gQ�O@G��%x<x\����[��n�"���]8��8I��c3j�#�"�9!���Y30*Ȃ0?P�-�o�Z��5Ȃ�	*��TH�*-0�Ѓ>��>*�b4c�Exp�o`a�Ō����K���5�X����0��%�0��a@�a��X��h��H�8�����;2�i¶�&�ˑ�\����Y��:s"�[��JBp�<x�.؂|SC6���Rh�˰'<`�jP�b�d�Y`<hDh�L8�C�G�[�g�Q�O�OXF��3�O(�hp�Px[Xq�/�#:�9�K>�F��@� !h�*��#�8P�3p��j@f���8�+��70�>����1P��4�9��>؃?�M�3spu`Y �kH������5@�T&]s�8;X9�i���	�˝@ƾ4
�+�1�1���Y�p,i;�����jy����x	 ��T��O�d�"1�.p��C�F�]�F�)q�ePs0�n��h��\�O8�E@RB6h�6�O�g��O�[ Q��PX<�CRh1]c�R 7k��n��2E����Q(�D�H� �������+�#��+؂:�>848��I��,��H�7��YZ`��2��@���@ �O`�m�W��ˈ#�A��$H|�V"ѬQ�����ډ��	dT�\ۉA
�������cڊȌ0iql�,L���"E�4sq���gp[H���L`6��8�z�8;0M] �}�(�k�sX�[p����`ȄE0NQ��1��#�MOȄ6h�C�RhMdXyn�pX�䍃�F�3���eHISX�m��I�HO�p*h*��G$� � ��,p"�D�z�&P38��+H8�b�e��b�K83(�K��BЄWh�f��k�]��X�F$����	�%}�-	�� �p�K� `����+�M����s�k�h+Rċ��;����Xa��X �N�L�#��8�6�>�N �X ��F`�NXs�Rh�b��dD�dHM(�tpp��%8�!P0�M F�|��xk@�r���1h�RX��3Bh�D(�upe�u��{��%��/��%$!��1�\03 ��*)�Z#p�؋C<�*�D3���a�a9Іf�y؇{xmX�@�=(5�䐄Ah��W�i؆qp�a��T�UP�U(�8�%��Y"�^�+RƲ�b� X��������l�����Jl��ٛ�HL��;f���TȪV��Z�C���.��`.�G��Z�\�a����8Q���d��h�[pY��Fp�1p4+9P[�X�#�:`�G�{Ȇ|��S�K�=u���]@&)kp�]X�|�?4X��:0:`�+H�$�K�j��(�*0A�'�g�-@:(_�A�/�p�/(:x�7(@�/Єi�}�|�_��q�48��M�VPM`� �.��:���%	����p%�	r];2�W26����06��Ѹ�ײ���
R�,��b,9!�����\�N�K@P/IƃC��8`E@�i�X��XЅj0Ƴ�]xHiЅ�#kM��D�D@�f�i�{HdH�f��e�-�h��|�}�[��Pe>kH�S�s�QX�nX{�Kx�-й-p'����ԄE��PX�z�[8P�b��mJX�f�A��k�ixz��Y�'8�@H�j�އ}("v5�?��U��IPahT����T��A��$ ��Z9�^�5��8��0A�a	Qi��Wdi6����	G��K,�H�D�$�� �5���U�j@��A�@h���6�<ȅv ZG�z�Yh;�jpu�b0b(�]�p��{@�j��a��H�P��qp�y������P� +b��Ƀ�=k(�6R�x�Mȁ/�8��-D�8ȄL�G�C(z�ip,8U�9�r`q�Om�t��w�}Phx��s@m(�D0�x��}��FWh|��9�N�nIO�K؈���km5T�C �7H�_t�㟛X	���j�3.���
�b���1Y�^؋���n�������4 ���0��I�@��[��?�1�o��XE�o��l�%�G8�t����O ,��Rh�嚇{؇y�Pz��x��LPx�1 G�n� ��\��rK<e8���8�[c��Մ<0�E��O*xU#H�G��L@����l�I�,0�:j��{��lh,�w��y�f�}��r��O��}gtF�v�Z ��9�?�3�WSL8L��&0�����[j0����	�Wa����]Y����@x%	3�����od��l�i��¡���T�I؞��:c���p@Kh�Q�M�,�0x��5Yi�68�X�;�zz0x�x�q�{��6`0��<9�SpwH}�|�n�q0�O�8B(Z�!~S�`
��y �#p�+�_�?�d��zx
f�!`�C�{�v�oH_��rhg�Oh!�lĨ��vo_�}��I��.�Mj�����T�6F�$�R�T�Ra:���0<��僘1]Z�)s4mVp0s� ش���ΗG_ּ`4��20`�`��,`��+��p%�k�^�NP[umծ8x� ^�PI�4�O?����V1Y�4с#��:��\��fK(Z��ɓV�X+E������3{��YSϚ8Y���3���,„��<y��؇�\�G�d-[�n�,y��Y�Θ�{����P<��!��'4Fz�ⶮ=w��(�$�V�z��rV.-����4ӈS�A�<��8��Cρ
)4�5�t�N0�2�+��e	&�tXIG��JH�B� ^���R5�ĔL2�AND�T�AL��cL�DAM4�d@UN��AQ��T\��Whqu�Y\�Yd��Y\]�V�U9@/��ŗ$|��x�bL0�x�
'm�B� ���u`-��2M:���&X���#�.��ӎ9�D�M:��sO7���'��!r�L<��@q�X��0�"B��\g�I#7��h!�cܑ�)���N8�a
3��Ҋ%X�A�/h�r�-�l2!��s=��m�|�7�c�<�$$�>��s����%���� 9��r	&�/�L�^!��� u�фI��(�L�$�K1U@�M,%ԑ0�<��KQy3>=�]Y>�@_M`VUau�&�h�e��j�uW!z��|H���RK4�dB�%��׆��!p.��R!�ʂ�#��L0�2�|�	)���i7�TC�<��1�vx�I8눳8���8�8c�)���t�u#O>ݠ!�&��� 5А(��篿��Q�/���g�2�%N�1 ��̼��KE���[��Q����<�C�B���I'��BL0Ŵ�7��+�\��*U�J*�Q�7t@�N1�����D�H-��~�$�F���Ԥ%e�J��,��l�+��W������+� ���B5��xA������V�0��	B��|��Bp"�� �v�mX8Ju�g�#��D��eXC�x�-!�j�c��=��R�"�xDp���n�V���,d�wt��08J7�}�c]�#��8!
�*E7̑����X�M�"�(�1���J�cyw@��`"��
SHB*�`8�A��Pq�ѝ_�!���6��g�C�� &a	Y\���_%藊�bNX	�.���,�H�Y���0',9RN^�@�H	��"���D�Jj��3a)K�D���O1mI�hy�8�H����	b@C�a؇8,"��C�A�E�ጵ��"́Y��à1�:`�ְC�O��٨F<�1c$�?���-v!�j��� N���7i`O�P�:�! �����Q�+4�	q�;��'[�j�G V�9$r�x�/� {���G3�"8O	E0�ΰ�"H�
�p�;��xt��F-BA�N �G9b��?�!�lPT9���=L�x�%N/���L��²� ���Z6@���-�ɍ���
f�.j�UR��}t�V����ݮ�� �/�֗H@��(�6��	8�AlXh�g�� G4�wpG!�HG�:��t|�2�7M|J���g$C����b�b�����*$�p�-�a�9ZC��ۉ��6� �h"Q�[�h8�ġ�}���s�#��ǐ��Y@���ؐ�+L�	W�B�`)�1@9��YmP��(<�ÎK��� ��
_t��ĉ觊K QJ�frkb@�W�,A�Nx\�w&�K��T32W�Y����r $�
 к��j��	3p	���"~.�ޡ [4#H%���:��x=��@p!�Uq�Qx$"�H�=����a�PF3�q�O$��p�2��z��Z�(Ƹ!G�b���M6��qHC�PF<�s��5�ȃ0,1M����
l0���N�AJ��pT>��Qh8Cg�%�p�9��
T���P�XX��x���5�^Ă��F;ށ�a��o�$�a�̠�$T�U���� ����������2I? �6z�8e"�Ŭ&J�ٓ��"��L�a1KY̲/eILn	Z]¤=��aG&!�w��/�$��6��t�9ʡ�$ ���G�����#�xD)��o�X��p�:�q�`�¡�<���C�����=�Qc4���8�-}��X��G:�*�:āM8�)>�1,{
y�"�Gz�#!�x�	1牂1o��*�`*�U@�0�DD�p��5H�'`B�0��;�1�O Ђ+B����]�Y�/��\B%�(Ad���Ϲ�N��q���Sۅ�	�p%TT�S\�[�Et}�W�ɖ0��p@1�U�P@vu�D C�%t�g��6���E����"�%T��x��.�ф@=|����:�8��=ĊT��:�с�BH�=��s�["��-P�p����'��2��;ܑ5�:̞>�Ð}�;hB(���`�!�A8|�5��>��<��&�B5غHC7p�3P�p�T�AL�T\A4�p ��<A"C6d'�P����,8�5|J8�2d-l%D!/�ACeB�`B*T�����Sɤ������`�������S�	EnES�Dd�8�E
��ߕ�mY��ҬPK�/H *P�,�7��9h ������A��A'd��\B �"x�̃3@�:ЃKJ>�C:t|�.���%�<����-D�=��u��>G5܂�!�����.Ș� �(x6����8�pe ���eC.h��1# �<؃9X����<��z$AL���U�"���B8AP� $'�B � �5�«xC���6���m�*ȁ7�*L�+��H@�9�m�����Z��̜`O�]<��MLIV�����?�ZAM�`����\@�j�.�C;�C9`����H^����_N��$&� d,�B,@�/P�OiG҆;�^.�I$�:��2�b7`[7�B2(�90鬃1�Q7��;��-|\=<���s�~h�d,�$���"��"`A�`O4L�1 C� A�A�B0��*Q� �A�A�_���$��6�wZ�|%���APLA��/��=����803��%�B/�%T!��%BJ�@���l�f˜]>
=�c��LM8MWp��uI�$��Lڡ�L���n@DZ2��7��8h�$�&�B%�H��I�A!�B��e{	�H��!�7P�=,�M�;`�1�A�8�0 C5�C<�B)x"�B.��9��1���A)h�)���Aԃ:Ȃ.t��C<h/+��`�"��.8�~��)x��K�$�`�aUA���hd�����h/�������ܙ�� hAJ�� $�!�~�5��ȁ%�AL'l�2�it%Ap����V����]L��	
�����V�����LP�Z�E�ӟ
'�I[	���[0VЅ@�4M�C`C3h��@`&`�`����T&P��^A!h�����\� ��3�Gb�4D�7�.p�.4B)؁$��'8�)܂-C,�'�)<8�C>�B�A��C6T$E�<L<�C��C5(�1H�1tb=�.C-P�f��! �'X�+�g6X��\���A�4���(� ��A����\���dl�zA�����lA",�=�C4d4�!��+��%X�FhB/��%������J��	jL�Lʎ������Ҍ;�N�cL,V���A!@��Щ������Y��j��+xV00C%|�* � �H�֨���&\���Ё!��('0A���0C-�A(,B�JC2��-<
7Л0��.C4�B2����.�-�tC��;�ƒ�B"�.�2�纜�4T���[)dΐ�2��@�6����&�2TB!`�h���r�.�p��QA|�(�%�B5љ�������%d(���H���<Vn�38C0l0�+\BB%\hf�V�$���.ۄʶ���,�t�]�����Z��,�S<�\��Aa	c	��Sv�/4��S�I*��/80��I^�$`B ���]f*��z�@'-��+l�؀`A�@��b�- �5t�4��'<�00#؂.H�-��y�2tC2�;�pt�8�C4t��q)�8�U<(C6�C�t�B7XÐ�K:C)X�;dC:Ȋ3PC4�"Ђ%B/`�X��k�A�b��hA��`����0 #�$����Ah��"HAl�"p�5|�4��2L3�4<��6��d�%\B!H�L���I����b�MPQs=�L�	3��p�V��JWY��������U���I*��jckiNB�TB+BՌV�Z��P���6`�/0�x�
��`�`Q�B�E�-܂(tB#,B2$�3܂WC7C5Xlؔ4�C��N#(U��Gg\e(ʃ2��{�ˆ��=�C5�4�C:��~;�6l�/���.�����v����Al��VA%�A ���)<+�.P��u���/P�+ch�WA`q:��UY8:��0l�ā&\�&pB'HL!L�$�AtLT�&;�D�:����q����q���2��O��Zl�W�?a?���o�^����3T]_@]�P��8�.�HT�`h� �3�B+�B��h��,�A5�8(�-��'��'�5�C#���B4T�. B(��:�4�ސq�,�2��)x�jP[)�CV(�%�1$�2��0���@_<�C�;�t���A�����,�A�L(+�G��̂%�ضmO�l�&`���8�|��C;l8�Q:��v�9h�,���M+��%��lAx�-�f
��Mp>��/�ʺl�$�pT��r����xytu]0�89>���/��/�90CiF��P���9B4�9��`���%��/Ђ(�&��z��n��\ (�7d7�:#$�~�;<+!�2Ȇ)�CTC=X�-!���5�:I�G=�B8��8��.�|c�^�B�,_>�T<�C.8C3XBc��ܯ50 �B������0i���h,{-�h�@($d|�J��A4�4v�!8�b�|0P� \ ��!�&�Z|����D�E�O8vO��q��U�L��Z��ӔgV�P�ry���qTU�Q80Y���*�B/\�8\C3��������'�uD�`h�X�BE�3F���mX+@��l�#�͟8h���Q��X�\��q4F�1s�l5*N�[�����̝8}����Ӟ�D��ɫo8F�n��u�ԮSʬ�g�,���s�FW�X�� �h�:y���cc�%3V���d
�3p�AbE�2I�T	"$�9|z	�鎡Iq�X����5a>sf+�5pݸ=�f.��m��z�+L��YB�Cx�f����޾8x��7o�Ù�>�|�p�+�m�XX������3Xp����#w�9
�O~�B^��1����T6ᅏKe�mz��s�I"	+����(�8��f�LYC�-
��3�c��㖔��iF�ƘDd�1�n�9���)E�]z��|���w�y�y�RGqd�cS�
ḵF�e�Ɂ#��$qx��K�&�<��ǝ|�)�X�X�#� �%��/3�@�"�8#�=����8È4�`�`y%�/�8�+��J���LH�%�`|qF�v�qǜk��CI@�e�A��<Ȁ��k��~�m��C��7a���>b{�@;�0��=�*����k>��5�<��΁��{`�6��?VXQe�Nz��`�D�a��d�5�0�
)�� #�hhgz	Ċΰ�3���#�X�kr�f{�9�qi�ezT�]l�%�]�QǞ}��'�|nn�(c�	�e�2*i��Q�RJ�J	#~�C�v�aC��Y'fs�̧�b	e��*�R�ڕM��E,�↿�(�O���c̊yf4�c�!��ÑX�y� L9��P���d֙u���E�I�dL���D��:�]�9f����\?�����8k-� &Po��.=���v=����8���f�W�JhYE>*�����<@a��)ȘBEz)"E�i@���-��c�-���`"(k22d��F� c�B	<�.x$��,���O�a}���0�'J�	S(C�(F)d�	O��6��<��X�)�!xtCN�
"�pXbb�C���K�dh�A�?�E
�����<U
����0�*Ё�0Dа7����3��ʵ���ޠ���^XB
:�;�M�8��{��:��7�{@���g�.:��E�8�ș@��I�gx�巀G��<@Y�{@�A�_�b��D+z�
>p�� F/�� j�����`,��@5�!��x��1^�:d� E� ��s�C]1��>�<���&3�58��Ig�0�:t��{�����4La eXi���]|"F����.ȁ�(��Ѻ�(��y�B�qd�pg(�І<�"Ip�0 A	�B���!�	J�����#�/V�68�t`.BZ�/�[8Co��7.!	@�����&��V�y�'��:V�^��1��ϲ%#p���>�Q���S� �=�� #�����.p�s\.���%Zt��� G9lv���8� |Q�%p��D(���`�A	x@:�QU�E���!8Q���(d���N�S���H�����O�c'�XG7�aOyجH����F����#����*�j`��)�Ph�h�wdc\8C��Mp�EP�� �8�!5��C*��
SH���E+h!Z���p�/�
� 3h�?�� t(2�_��<�эr�b��&0�@�a >Ё6`
<��Y�p�0`7�鎲
;-�5'��� ��L�:��(��rqK�P>Β����l���ƼRQ�IT��;�Q��f����0�+�A Ӹ+���Z0�g�C5��f��4�1�8<B4��>��G�h�x��n19ßF��͠{��H���+h�n�*�x�-ja�D �]x�4V[.��1>�1�B-�:t�	>xa�`94(�	o�PM��'$�PV��B�0�"DQjP�_��G�Y 0|�	��Ar� �	����F.J��"�|`YYʽ���֪��rX�
ְ���h9;�@�ʣ;��<X`��5�u�'��yϑI� r�@E��`�l���Ȇ1��@����ԠKX�
jh���E��h��F,��X�5Fэm��L�'�6
F(�F�h�Pf
](��؉v�k��(�P���4Q�*b��q#A;���P�eiJa���eTCN���A�mhco��݄?�!�.���u*$�1B��4���2��<�������@�a��D`�u3��4� �#lD|����X沏����Gy|#�$8T8��:d�;� r�<*`��#\��̄�[ʣ8ZG����`�xP�X!�����PP�����g
� 	@��@B�`
l`��`6��d
4���`d���€�ʫ�G!��J�j�ft�����J����Mj!ڀ�`aސO�@	j����	�`JA�A��� �@��!�&� �@��� 
��/����
���� ���� �����`��A v��� ���h���������� 䙞�<`��c��#Z��>������T)X^(�+�Zn'\���=��=��E��C<	��.���RAR�j)s��|����@|�`aPz�{@�>qO��`�a�!hA�n ��`��$����PF�� �I���!��Jf�H��l���!%��F!�@r������hJ��`#�n!��� h"$���V��l��Aj��vJ
h�bJ �@���
���t	�\���A�ZA����@ ��d1G�A,-���~�W�Y�������v#;��w��˺C˰��.)�k=���q���lX�72 �zA�R�A^�؁Πf�
�@���@0!t�����
@a���ʡ:� h�| Ut�d�� tDd�G� Fa>a�Ka���JJҟ�"&�A&oF�B�M��FA�`	��g	���4fOd���������@1���,���� ���x������@!��S�fQ��	�@@A��0&� $d��
�`TB�q�A�Pc�a
���6a��B��尒�7FS���\R�v���v�v��#���(����<�KC	x�QLEiLQ��:`ʁx!X�RT��!2 �@��Ё�������!��@��0Aj����h�p@�`��d&�@*�@nu$��B*��vd*R2%k�f�i�ԁ���>���F���	�@��`	�����|��*�	v`��a��
�`:D!lA��`O� .q�
��}�s
� ���
��
� }��� �� v�(L8��a2��A�!��0���F���� `4���´O{�u�jZ>s��:�9�1;()�.�]��*� ��[���4�̃7��?@��TAh�2��(�������a�a�Al�!���!&�:���h�	��!����*wrw�mWO��n�o��d"%�D��(dL��=w@*�m���`��	�`ؠ@��d@| \�Ba�Р� p�C!��`
�`���B��	L����@y���O
�`.��zؕ�`��2¬@ ��ڵ >a�����!�h��:As��dϭ:�m6YT�Xh��L�(`�^g8fn�*ɒ��=:i��=�#�|ni?	ZH���VA��z�$�,~���a�衶2�b�� �aܸA��
ޠ2h`�������P�|uWW׈�"?yd�����e�$K�uW� *� ٖ�V���� �8���8o@7�*�l!��l���Apa��l4�	���
���!�`� � 	�`� 	����
���0�S ��
��` �� ���!r�A�!������{��Č�B��c�����<��YJ�ˬ�������-@7pg�Vvw�LՑ�����h����`PG"aS!X�x���3����!������ ���W
�>�t��8נ{dW�8%[��NA1�qw��
���
T�Z��� �ԧ��8�����~����p��An���� ����� 	�������a��O�"� $	f�/���@
	"�� Jl�`��@߸���3n!naMf���Ra2G r�J��#Y�.vV�9��{C�*�9��;0�4�,8)��#��{�{��c\zcDp# �*A�(��R���4������A`�j��`H��w����Dh ����eڠ۠z��B|{W��p�
��	�`$�s��b!��Ϊ�@|�pIrp�`Ңap Q���@X�@�!�j�a��	8��`/1�Ǵ� t���� n@�@��8a� |��~� ���ja~a:��B���*�@��z@J@�����7.3]�*:𑐅vy���0�㮁O@�����tǏ. ,��32�bam���2��a�Aʡ��� QC
� |�<�y@�h@��X2��o���۠�!-��Vfwp��U�$*Aڀ N�!Dv�#7�=d!b`� Br��@z���&A � ��	a�4F�Ɇ�i�UuT�$����"2<��f �� <!����� �.6!��@t�,��X�#]G��jf=�t��uP	�*I���x��q=
@�8I�+�6 6؛!!je8����A:�a�|A*!U,�
���}����#� P �@z�	t��{�$�@*���_�h�a��%�ѻ����J!*Ǡ��	�3�;�`o���y^������ f`n�l��e1� �7	�͡��e�
Aޭԛ@ ����
�@� #�¬;�`�,�y(� @����H�Z�`	D��%�I8T�j8*@�Ef�3�Ò�c�ȅ7��x��;��7����e�k|.{�3;��<b�:���2�,a�.$Q���:®����j@c�H�@D����Na$Oa@�@��\X��p�^�=*KA�n��~���`t��.A���d y���à�Z�:BJ� D�h�Rf
5�$yC�J�$e�X!��#c	�iR7e�)2QM*e�X1Ye�3f�Hiʕ3g�����5~���$ɏ O���"�G��Z}���U(\��@�UUɊ���+تZ#<�p���e��nU��]�7/_�\Tu �.�P9�	RǨ0e��
P'`�ʵ{�ϫJ�L�"������"�H�+N�,
U��8�vYKt�*���c�?e̚5�a�8g����P�3v���u�q� ,��8�� PŒ	��ǘ<E�,8c��Ј�_ EhA�{(AF%a�lLQ�F1�d�P T ���T|1�/p����\R�$~�����%�H�M&vp��
|E�^[ ��Z`- �U���[d \5%`8_�0X_V�L`��0��I�d�U��������� 9ﴃ�!�d�	FLADC[��ńZ�A�E~�q�0���R7��bG)�tcL���Ǎ*]<�?��,�|��P�!_��[8�DFLHC
4�
�sbtQ� 4�4�pR�AF44�@ q�rP�V$�~�D H�q�ST��gA�MV�Q�iX��0��e���~DB���L�J0�`F�>�e��ZfY��b�Y��K>`X_��^Y ��}�e_���(/9�`b��X$B#%�$l��/��RI0��cN6�,����A�>D
�n�d�'�� ��"1�Pc 8�S�.�X#�qő��)�B��t���^"P01�^��\h�[P�DD��P�A�� E�A�lS�g;�[��G-�̑�D�C��ZA��ǀ$�AF�g�aZe��(��AFO{D�$,I�"�%���JJ���UYV�_��c�W^K�	$�U�,�WOօ��(�U�]6�5��y�/�����rPFh�����
f�"��6��K�
lx����o����І6�Xd"�pF3`Ak�C�G7��6qC�P�p�𞼍*>?`���8�G<��qN���A�Q�l\sfрoa��p0 �G��]��9��Y78	B�^H�lx�&��F�`#	b)b!�w�_;����Bpbz �Ԡ�4�
\%(Q	҂�����x �ߔ�r�T��L��KXv�$�P�Y�b3�$�f��^���X ��*&aL���̸+�!g�����Q�8,C�#���;F8b�����'`��v����8��x�#��rNq7!2�X�k�s~�E;Tnx�C��6(X��|��"�9����1?���ސ���@�E�GM�, �	SD!
��& g�#bB�)$�
bp���`�7�ZU���	@Lo�� ��6X{@��	U`Bq�B
Fi�i}�����$Ā�|Wڙ����1Z���h���(�{]����b����$�`	_X����4�q #�����;��t�Û͘�3q%
Ԁ;�Q s���XG<�a{�Ç�"u.w
���;(b�F�a�����+\�W�V j =�`=@�� �N�Bgh������Q�D�O~v�1pB ���� �-@	e(���IP�ʂ�����d �L�Ґ���!�k��%���Q�� �p� ���$�^�D>���;;Y��DʎqE���K�fF/&Kj�*�
8��0�$$�H,2�`�$��t��d�I�r!w���p�02!�A|�
g��rP������Qz��������˽']�1�
�@!!�:�q��`*L��+�@�K�dݠ!ϊ.��6`��D�p-�(~�x�"��	��ĿxqH+4� d���6�������`<��! ��Sɰ���D jxC �]	�a�U|Y?�qcw1�S�Jg{/���[^ɯ�XĽ�a�"���̖x�`Q�
^��2B.� q�B��
�(9|�!"2`"�H�6�A�gt�%g��ЉR����F;ꁏ{���#��S��SB��8^>�uX����|��0ԁ�� �,\G�����,
A��pF�L�"���0�3�n	u�D��_�+�80B��0K�A E؉J� '�!d@� ���(�hX���+8;\41���-���r�X H[Y�]�V.����X�@��
��sAL��2�.�UK�G}ɮB�:\C����*��Ș���"Rq�@$��~W-�� Lb4��/R%���&Qn��R�Є4A;4�8aЧ8�y�6���Fs�U� q�1:(�qT���tWF�JP5�R7`EF�r8�Fג-\@����	����,?��]H�/P�w�
g@J�e�	$Ql����U���0��Ir�
��h�=g�[P(��syEB"�ze��'#$S�><� ��b�.�b���K`�zp�D��
��`��I4Q	��lT 	!aR���e1�g�.QRB05���		N�mp9�ϵ�'�p*�7�`�Q�~���P��ap*]�Lds���lgPS�+	8���Vp��G�EE�RH��E%U@}qp�|A�9?�ؐ.bp�15��	J�p���"�vw��;��w^�	�`B�@#z@4�}={�Cw%�n�ne�>��axq%A��G@��U�?3.#?HB��K�!2�o	o��brt���!	��TW|@(20���f�e\vH�1B@��&hЋ)P8iC�?p
���q���` ���p
�`��9�ҡL�_ ��`c�t���\��t;"8��U�BEp�14�V�o Q�Sեh�t@��@��Q��c:=
�`X�
��	%Qp�_o�g�f�s�
�0�s��`�yX{�f�Wp(�I�?  �.�3j�y~Q&\�A�X��!KZ�2j�gb\A�Xa�9c%�n}aT$r� ������0M��Ӓ�#"3�.�Vkf��19z��̂D`7�6�5�9�P` �`��r�1*�` �`�� ��	4w���:�\�`�� �t�PW�o�Ip80.��gЋ¨/��ZW����Z�H�M~ 9ҢGzt1�� !w �@҈:c���0h�{ �b<D��FN�s�	�0 ���_X��f�I��op��yɩb�J����2y��iz|!$�JW(?�mt�c��K^�_R�b��SWZapp ��
B���oj�t�
�`��BXkv/��!%<S`�59mt-Е,@�:P����� �  ��g ���!�  y y��OphKPI�
� Ӡ	[���U`_�T��%J�I��z�w�7�G`�4g��"�R�,Ĉ.�9��p��H ��"��@
��nPg�.!Mu]����-ik���~0		#� T0�Wn�C&6��%�W_��Mh^A�F28v�3�1�u�W4#�n�ӄ0�BQ�m�B	��g�
�@�0B�%@m@U�%�S��_�&99y-@,I�K�Jp5��POQ�
����� )y��p�+K�M�d3� ڠ	\02B�FZ0o@dG���,2 FAp��,3(0�H^�a3�$�-1`
�`f��z�.�˰ ����PS6q�TT��~�b�
[q&�o��r5ÓT0p>ja�fc�Z���C�>`qJ�� &�q@33@X��>�zWB�I�[XI���aX�P	�� ������V�X�Z���Ғ��2Q�])pG`F�G�y�.�g�a ����J9�3�	��x���]�8C�\�s�	�JF ZE0ג[op�`�,��-�3) �uR�"-�B8@c�I�0�p�
�P
���_d���h��	�wu��@�f�
�	�o�b`�og�}aj`)`�Jh�b?ge3J?���_x%ds�V�*�|�tc9��K�G�h�;�
��&�d��
��
��
�@�l�=�hxp��
�"Fp�@h0�'a��xH-gd&p>iJ� ��=�C.��(gO����gv�	���M�+l�`�_ D��d�A`"(Dl#%��3�,M�-R��b4R��9�-CpMP�,`
�@�p� ��3pt��	��
[���c[�	�0	fP
��
iPwŻrp	���{��y����$p%��>��np�qVwj@]A�C�sun�Cb�n*�*���KBb���ц��{�
�ap�	j@��0t����	{�	�	�`��@�`�0����2`!`)�#=�G�]P����e 藠ñʰ�pgy�b0u��K���r�ښ��f�’EEP��R�R ���H`�A�����.�5R��9p	�]u�Ԑ $� ���'���~�}]z7Hjp	�PX3	;Q@.}���wf�̦���I2�V�˧���%�����V�g�9KV�Ө��%�&cQͽ�q>��dm���ֻ����p��p���	���@؜�	�`�%(�����������2�;�<N��pH�r�Pf�I)y��`�pm�aq �(
�>��(�X`U[9����8PALҢ�o�Y �I�,^	�#�b�u��,%P9%�P@�?��@�p ��ׂ\_
נ
R|���;H��V;���3<[`%���>��K�ԅ�C��o|��Ph���Ԅ�2S�[�8�V��y)��"`�e��	f�z�ٮ�@	q@t���
� �0������
��9��[@��l'�F�B`�!,+p/�:�� *Jɫ����%l� �`
S�c@
��\�L`��O�J0�S�@\(E�H@o}^�M��:���B@��E�)���#�.�"(УA`�9�70����Ҷ�u�	��
��bx	�/��f�Y���k��n��C����V�A�=�V���YBԖ72��9[�XA&�F�Y���f���V�����3�֖��LsK�`Z	�0�p�����p��I�V�:�BPW�&A�)� @Yc��s7��r�p
�~���~���Pa�P���� ����F�	���9�o�
j��k����-�A�c^�)�9�XIl:�IA‚�� �@���W�`
5��3R�d)3�a�*R,R�RF�?o��q���7g�$�"�\2`��̄�`A��<�`g?LX�`g�
B{�4���R��,��fNEt��3��
>���I�/^��F�I.�5{ⲉ�*f�:��Qt�Y0Kk���W�[�w���)�Ep`��%H��!I�)R#E�5��	EK	(�N'o��u��������H�J$�'b�di“MV:��P�ɗ�5�'�!��*Vz4�AC
"E�!��"Sf̈���  3pA$�"��(� ^x#�2�C�u�y�f�(�1p��@�@"�4��
-Ԙ��Ȩb�*�أ�,���E8�XC�+p!���B릖�2-�n��
�i'��*�Ǚ��������&�I)�t�J*'��%(��
���	rҀ��V�E�T$уT&��H��ÏE��d?���fZ9$d�1g�{���|�r����a�A&�<6��%tX�0�8�98�D�tv�b�S�ul�u}��ǝO�D�0�8�O�pF[�&����x��V�A%r�A;����V�"�p�@/=�o��	$P("	"������������h0�t�a���{�V� ��@��H
,I���0���4.��#8�Ը�"<��')�j�,�(�JG�(���d���|*��0[��������
(���������
Kt�K���j�	̜ W~i��I��#�?(�88$�L��I�Pc�?,����שǞ���zࡧ�o{�x�A�gq�m�ahj�&s���5q��E{��G�|n�Ge�YƑR�1$�P�iE(BɃ�E�	F(��cN(ˆ�zH!���rx�읡��P�� �@��hx�-�a��p�!�18�D��dp���CD+��C"%�H��@�B�
)C�*��c	T��0	A�a J�AR��=@z�Ԋ� �%J�
�p3��E,V�O�Ҕ2= U�!`&��H+Y����Ā��GD�@R��%��pE%P��X����0���V��I��@#t����=ⱏ}�Qp��:��gd�G9��-С��ơ�AjP��P�=�Hk(�Ҩ�h{�f����5�@g0�K��1B�Fx�P�D���,A	wpDzP8�22�JP��l�A�A��D� 8��{Rp3h B�h@� M��|�`>DvP��	 HAD���9E4J�A"YC*�`�@P�gp���@�@�AF�A�vĬ��jf	�S��§%�K9Y�S΂�&A%e�ʘ\2��t�KAK�H���ăoXEJ��k���/�1�q���`�$0��WP�W�����AX0�h�;��{��(,��d���h)a�� X�����6`��4�Q:u�#p�$�a+INrt��#t�D��XF:�A8x�B��A(��Oآ���FqQ��9( M���2	U��"�PjV3B&2Uнj�F>��&&Q�"�����C��bRX0 ��,�j��*��5h���jP���)Q�IH!jĂ��H:�QO�B��'P)S�*��}�i8�J�r�����hcz��g@C���8���r�4͸+��=�!#��+X��!� vH�;��1x,��@G,�aD�b��@�'����@4�V���?8�\�v�z�C�Em�j:\5j�X�ꔱ�щ����2��RP���<�a�P ��H�0� ���)H�hЂ(8a&H�Z����Q�A�@�&(�s�CxPu�@]D�A��@Dh=��;������>H���0�=\D�d�B��3\� }4&(����9DK��$���']zJ������);��OlĴ�hG\�
�p=D���* ���!�k��� �8�Qr����@qAFK�B��+����7ܱ8�����%�`�Ll"��DDc��@'0�Gc�Ct��[=�p(�H������t����&�|�����>��d�B�(�;��	� -B�s�$��:8����Eh�	���!�>�!	bȄ!HA�>ڡ�.��ڢ��9�0 ����P%�[)h�^������!p�
<����(+$Lᕲ;�)�>2�j���/�G���ʂl,�)B	����>�"`�5�I<���c9ڡ f����� T�<e�|���4}��m�{��H��A f�"�(B�	4�(Q�p�Ѩ�*X���	ipC�G<��0J�@]p:�����G�o�n�!Q 4х/,b[���i�؂6h�0�<h�/�4�\P(�:�,إ�� ��u;$�1����"h�2����Mp�����*����>68���X�%�#�����+q��0)���^Ú`�������3�:<�ࠪ9�b��Xf�r��^��s`_��w0�whf�Lf8�) $Ђ���$��u�&��t`�q[؆qh�A�"C�:X1%00�$�@h���ȁX(H�D��j����K�|���;��Ӈ����K?\i#{�1�����C�+1�@���]�����%P@�h�p�-0X������@�g�,�R��"�er��+�$P���,(I�ߚ�4H���4x�?���讖óX��&ԑ̳	�ᙫ���¨x<�����"̳���(���
���Y�k��_@`�Tp�v���*V��`�!����7��X�4XE0<HatX�Z�P`Z\��и�P�Ϊ(8S�1 �R8�s�Ch��Fh�8�nX��۱�z���\��IJ�{�1S@�R0�0��<ЄCX/<p�%(��  �YF0��/؂6��(�?h�(xo�B����Q��إ�u Yx$���r�EP=@��!������F��@؃+��@��r��B�’��"y�*�!�l�$b���X�3ɵ���"���9��(��	�:`�nU�L�f�j��w�t��f�*��H<x�*�L`O�o@`� ��i��v�f��PȄ1x�fЂ0�!�����5�DXY�m�Ap�%P�x0�%�Y�s@�{��{�E[�����$9^�����x�x]��E<��� (��m#�'��Gxm��\@.�L@�ь�q��"`�i��Dxvx�s�� �Ј�#��+0.)5i�x���3x��"Z��+��/]B-!/��B��H*�
I�8!Su��P%"��	����_�OH�� �v���r`4��(��^X%��Nȅk�Lp�:��+����0�@jZ�_@m����#�P��#P%й'��-�؁#���h%P(�[`i�xp�|@R��?���[�ŒCR|#�+G��PxY���P�&h��<0opE�@�O�p�G�g�+�������]��0XI��rD�,�q)�$�50H���Ђ7p5� 8�@���W�!���B�2��	��$�&�����������(��O�š$���,��a��$�`�T�\І�L�I�o`t��?0�3HC�K�.XN�b�l�c8�Uh�����b��V`XP�W�U��#(�#�3�T�p�8��A�`��'H�P�:�'����GH�Z�� ۠�x����8I� \aX#��F��\��\�b�'h�S���/BX<�.�8��!���1�O`<��@�H��ȼ�G@�{Іxt�B���`1XHX�"�)�-��K���9@� 0��x/��L!"��
�[�����(��
6�����H��//�J���u�����Hd��ȄaW���0r8�c�!���.؂1�Kp�tX�w(m�8Ё6Єs`M�8��P�J؂5���1�Y���.�3:��0�_(`��[0Ёp���<0�ӱ #��GY$ұ��IґsRJ
t�<(�7�G�0��OC��%8'�:��/As0��/�F@f�B@��*�/�Mf��e�v`/�U�@�p� ��M�����1b4@5L��S[7���
�)�H�0�� ��r	�ɚ|����/`;)�()b�Y�)�H��ڊ��`��Ćk��f@�qhw�v��k#+ ��g�MH�@J�*}l8t�C,`�x=W�E�5��i�BY��Ё8`;<@F ��Dȃj�a`�  �R0m&Yd�Q�����E�}?$Ek����c �6`Y0�:X`(YP�&�.���;��8���%8�pHr0:���S
ā�4Ҡ�v�m`�3�2 � ��"�3�-XJ�N����A��ԑ�� ��z(��g�-��-[k�� C*���Ȧ!���!�"����B��g�@�gx�cȆr�9�C�{�#� ��A�<hj�7L�`�vhv�h�~�kp�.@�,��M��f�@$B�EX�N^I6.�a�(��S�؁C c�'�z���K[����XP���|P�Dz�Z��h�(H����w�<pXb�GxC��3`YRpq`V�!d��p:����< k�M؂)�s*sq����)��B(HT�5P�����R�d���=7�L6�vn�r������P�"ڑ�ʼ[�
�p/��
������l`�s{�v(l u^H�)0�:0�9��r�Ȁ�f�l�rͮeKy�0e��L�p�S��eF8F�Q`u0�[ Q��.�&�x'�� �Fk82���uPw���˵z��n#5��O�.��'p@�/Ё1�dXa@d��r`�P�t��mF@�κ���@0!�@�]�0����-� ��"�--�$�+x@�M�A�������	��M���
"�	����™��	�K��°��x<#.C!�.�C���Z��/ pm�*lІm����zpv`�s��)p+��;�EP!(�Ё-��DPX�P���\�B�Rx:`p�����w��8Kx�`��G0]ȅRX�C`�G0,FhD��<%��l�R��d�٘ y��!�EU�wc�[p�\E��g���(���G�GPjXQ0�\�d wЅ�f8x��eZ�PP'�%��<�rxȆ=�� H���+ �2�:���	S�=U���a�6\``ŊTd�qAD�0x�����r\p����<�y�A(Xx@A'̗#�!R�H�Ey��Ԩ��cFX&f��ѻwo^;s�m��H�gԞ�J2�F
3h�(�C�w��F,
RȠiƒ�&B����B�:���훬:\��y�,�.]��@��ȎD�رK��o�ԩ�w/�>�n׾�o��|���S��"D����D�"T���"ʘ(bb�c*Y-X�B=.�;i�إkS��r?�9��F	.���Ʈ�_4pHU!E�R�AFUl���2	E�`�4�RJRd��D90TF*5�G�F��!�/5cL8�S�HAO��H"r�PJ"ŴS=�4���
3쐓�$����V�t%�t�D'����%>��I%аb�!�t�0�-�h��#�Ps(�V	��A��#�.�sH'�T��2���2���"�x"�.� ���"�:�X��<��*o�裪o��cM#c8��2�P�O�0�}x,2�7�T�K��a�6�|"�(x�RL5�|��2��+���1��&)��	Z���:�aC�~�QDAh�STa�f|A�$~�A  |p�FA����L4Jet���h�QF�XT�M]�dN7�G�<b�@qdr�E)�@=ePȓ�\�
-���[=���^��qè�C�H��L8頇�6y��]��(�d� ;�tPv�u�G�M5�x†a�!�3Ĕ��2�.��'y�Q��u����N>��s�>��f�n�ݖ<�HS�1�lM1�HS)\�`x�:�|� !��2�.����)�Dz�y�)p8!
.�@�\�%��E���N3��PI�QDh��S�a�jX�t��%l���@GtD%QL�{��D? $C:Q�B"��A &9i@�4Ң��h#��O&裞�$&>z�| �q\뚇��tX�W8����mȃ���w��7ĊV�A <�A�P#hQr��O�!"������ �0�b�(G:��d,C�r�1tj.x�#|c�7����\�XժT���F:���jPC� E1��`CЁ� d���pD)� �R���F#B�R,X��E�p�����2����t�E5�q(� N8C�P� �i���=TA	n��h\�C�¦��(�H5+R���h&XXH^t"�(&!���`$@�(��ﻦ�$X����E��6�!�L���ȊV��_�Z��`�"����<�1t`c܀�:xG|���`B,���`l�|*���Ё��i�	V�G$#�8D{����@0��8XŪ{��g��j�R4p#���D,d�;�����KI���`؜3€�G����Wb<�R�P��P�- ��1|a�!Q 5�� t���P��7��@*��`�,\�Ad
:`����b�Q�:�!���
�_Q"�0�%?� Sz�%= �0��P�1�
�#"q�m)x1�8@���5P�
h��X�Y=�q ^Z��A(���q�r\��C'jas���l���{�	��$.� %��P��/< ���0�2��z�C�x�=6aj�?P�)�X�L5rTU��3p(C��hF���)�z�V�d�����2�q0<�܈�#m
O�!/��������@�9�����4���L�ad�A�`�j�B�̠-4s؀� ��`E
@���a �6�����c>Q�m]��%I�Б�!w#1���&�h��8P�2�6���U��GA�1�q��P�tL��p�x�,��X���9����M��1Б�-�l.X�A	������i$����:��{��U=��8:�Ʃw|\�����ypD8�A h��*e�i\���c`D'�A n� ���p�#�G9�ѹ\�"
x�p`!<�`uRP#���4^��KLbAjP�Є=�A
f���@5�y����H�Zv�~��k5b�?���arz8�j�F��
Tʎ"H�;&�}_�dr�\���X zA ��+ِ"XQ	+���@C�a��+hJ��"@�0!�=�m�'��x�	>P6�d�[`�>�G���j�.P4w�{��h�)W��׾��(�1�!*p��Z�0�2`�(�a.p�T���@	O�6(�A RB"�����u�cԠF(V<������3�%����0���k�����Є>���A�TA��̀҅��HD��O���X֥@���HG��q�J8�N\�M���;M�7��X�4UPO$�KI>�\/�$��/��-��V�C9��"`C�
��3`,�l|�́�A���^l�=[�-�(|�;�Ai�@���,�!�U���-$C,$�܃:(Ϋ���Fo�F�m��:��5�B.�K;�C:��;�K�"���hR��&�|A.|�6�@<B,��.@k�C98�(¾ ��!D��#l�6�X��*�B) �4<�0,X��D��e��  Z� ���F|��P L�H�@�dE�����El�I�����L4qM@s	�8��D�ڎ<��uA�$L�$t�1�W=Ѓ9HC,`38�5`�p ���������Du B1�Cn��;D�#�9,��|�8A�<�74�8��3\.��oȃT�����FU��=��P#t:�=��<�G+����xA�@i@�,A:u؂7� �7P���9Ȃ#�A��s䁰8C(0�(X�%24C.�1@�50�,���X%@���H�h��Y��`6�c�E���YD<9LK�F��֎����	R�oZ����!��Smg9�L�t@*X*H$2��C�q98�/��@
���(�!����@� ����-XC=PHU���C;�����X�lG6�BO�iC<��7�CW��}�؄R�>�<��@�<tC4��4|B"��08C.D5��d�,�����,��@�ƑU���;tC8��y�C'ȁ��p_:�;x�4h�#�/�
22<�3�-��!�&H��gHxI�<S���Y�؏��Eh ���|���D��DDI�H��j�]��=j�Kh�� �qiP��O�S�WXW*�$��4��@e�<�C9C+�A����!�A&��A�h����� C:�C~�8�~�C������8��C�ņlp�%%}��JUY�Ճ<�8��V���a.�#,#�8�.�K(���	؀��@l,�2t����5�C9��Vfh:D)���;�C9l1�B3�"�"��.L4�140+��*�BAhA��A�@d�4)�R���H��G�)7�)9m�GtD��VL�<i��`��;m��E���C4@�\-�8�D�ZjL|�uI*�$�D9�<lh;8C%�A D� <�0�(�&��&�A(�(k$'Ń=��V�<��;���&B8��9�4��9蔷�F=���	9�ƑV��V�W�Pa�!D�A2�Q�~(A�7��&$B��
��	��(M,x-��@����v��b8��Į� �"6 �7x�/�A'�)D�4�.�00�+p�&lB ��t�����/Y��PT(��N���O��L����7u���ڙ�8�r6�N���2E@��j펜D���A@rf@$D'$D'DV��;��;�C3�A#�'x� B�A�� d"d���&h�܁P2�A,�m�C=��5��40��&P�9\�5����C:��C��X�1TkOU��W��9��68�-h�(|B������D�0t�)q��,_�@|P�4C.L6�,_sp_�ʗ˱I,z@�#hC9x6����8�2Y1�ݶ'pB*H������A�@�o`�qA�
�����O(@���)6ALK��k�����6��oV�\��` �qYP9Y���H�U*�Q
��*�`*�6����8�B&x)�d���"B|� (�_����#����' .m��.��6���A5h����J:��:�C���#X�8��T�88)<|C5T�4|�9��2�B\�4��s���"�A"0�@84 ����@���0�#�� 0�@�Ё�@C4lC;p%VH�;�C98�7pC3̉6�"u�-�h2��20P�*��DB����A\̙��Y�V�D0?h �婞>F��v g3LF0LDhЇ,	<�#�X�p�R�/���V��#sUZJ�#�@©��/T;��DqE6�B+�A.����'�'�/�"t�-D�0�����pd��6�|�C6�T�7pKg���4�9T�!�[}σ:��5�B"_"h�($�]�9�8.�u"DAZ�@hB0��G�����- 	�@�:���4-8BX��)��D����T�D��C3�B,��'0"Љ7h�6��5<�6�(5410�0��10�/�+�B!�3hAA
���5�7R6g�Dmr�GԦ�T35�F$�mÅ8�l�D�H���ԣ�:CH*	��m��D��(���L�8=k�*�7D,p��8xgxB)��6�'(BF��ƆB+x0�B��"�p��@� �}�C�� 8A28�.�C1��k��9t�k��΃<�C<����z��C:��2 ʭ$�(1�7�(�	�A.0BXR#���)��h���
��
(��@!�#�@�x�h�3�!�Q�6�.t�~�1�B(�����x.�8�o5xC5LC10����+��!8y�@�����k�����.Xv$�x����)�-�ʫ|��ȫ6p�i��������� �̑8�7Ʉ�*��5��7w��9`�&�����8�C�b�'��+C'��&t04Q�8�,�.PM��7C'c�:��d�47ش2(C<�:<��:|�:��s8l����:d�fĜ1�2؂&()�0�B(�	�� (�(���@���	(�!�B�T��B�����^{9x�_TC8x�(<�1���U"�6��8p�6lC9h7xC.bl��--�B�n�!���'A��`�O�D��x��ΩϚ�/6!;�8��2��(�ڡDQD�W��L:�+@<`�`A��T���@	2�P`CP��v�X�w��e+�n3AF�+GN%K�Ԋ�	2N�)Ҵ��;�5��(Ͻ}��-Z0,c�գ�l׷p֠�Qf�;w���S�.;pƌ� �n�:q�ŭ-n�[r@���iQ�\��,��V�0�lA���QXx�Q����(�"
-'��A�Ʈ2dԼ]���14!:��
Kr�p���m۴k�Z�q�+X�M�6a�$HM�5J|�����\'P�����o/�|�	�7o� ��/ϯ�d����p��
(x�� �H ���� �Z��`o��\`��8�0�4x��l�)�g�)g�fZy��oV"'�j�c_�A�C�;lx��N���:>Y�|��'k�q��<���v��&en!�z��d��k���<��f�t�1�-q��F�]��%�G��R�1ƖZ<q$�\�!%������!�(<x�&:X!Xh��1Ba"�V^�D&���gLx���%�P�H���`���mx�F�_���.� �:Ĩ�C0�"L�`� (��?҃/>�3m�@,7<�
R =��/>����:�:�(�@ 
8t���+Ⱥ	�k�ځ�n���P ���@PI�k��f�m���q�&jV���L袓h��ƕ:��ŽCꀣ9���]���y�z�)�Z8Śr҉fhL�%�e���j��&s�I��P:��_!��\���m�iD�b����Z���gB��Ed����[B1D�.�@c\xB���ÃD�Dh�Lz8�PT�<i&>�ph��RB��i~�F�hf��_&\���(���"QPA�8�� �Ɠ/=r(�yu�����+O��3��v x`<�c/?����{%�Xb�*2�?��w�����!���x��UC��0��1v8���F��
�@��5��Z�	t� Q�Mġy�5�ay����aX��J�(F-tac$C��E:�as�E�(F)rQ�jP#��!Q
S��Ԉ2��op���I9��	C����K"�<�)�A
х�"!��@��`X���!bl!/���#�Q^��@ R�"��4` ]c;�Cr���1a�� R��t�^y|��-X@|�Oxp	~��y�޻����#���geh8P��W0u�AҏC�)��C�@�x��q@c�`6�!h���B
J@�R��`����Zb�(5l��z�C*/�G;�!�e�#c��(DA
A
�bX�a�md���)d�X�B�ϐQ
O�B��7x�X�BQ�B�@�D��\x���� 
xh�"�(
<��$���p|�t�+���!��W?�U������� d�l��� ��-�@S&@A�����@Z�C�ŀ\�]�z�ŏ]�g<@��g���y�y���מ�d��Z&�0"J�D�����a�<D� �!A��H3�!�`��D�(�+�a�rxC�8	�
�����-^�.b(�(�0v�z���s�!�E$�@7x� b�!w8��b��XCt�F1rh
[|��h#~]@��K�F3p��:��P0"�@(�	uX$	R,�$�(�a�!@��%�@��r�8;~��!�>��&����1hA�Z�w����,�9`�8,�l`@lxp�s�G����0�,��X疼t�y��c������c��@�	�"�AP5����WBr!�:AȀ$R�q`��&�,�	b�Hv̈����l��������p:,B�hF,�ᎁ�C*�HG;�1Dx��P7�э-΢��M)N�e�ps�5Z#�j,�x��#J1�c [�hF.ZQWt��)��&��	b��Q�Q�a	��:��B���<Pq�h�M�A	*��"G�ȥ�xL!<,���+0�$8A	���)��@:�l^|�3�ُ�r��*dI��[�*s���1wKB��_�*����:��O–�Z��y"���C �څ4$�HE/���h���C.V2m0C!P��T��w�C�#����E*,��<�Q�`0"�0�3�� i40`��;�R(���E��M���8�2�Ѧ�va$��1r� a�Wy`����!
w�#V�Y�E,��w�#h��D0�%_&V$�#ސ����,xx����H�Dt�hp�F���"�9���`�R�?��7�J�y	��A������(����3���� ֫ϻ��E,���%����|���iA�_0$C&`a(pa �.  �N�!���:�霶�؀J��!d�2�Da�@��^M�ꁹ��DJrA<!�$c��A:� �a�a�a����A�����������.�����D!z �!���@��ha���
t���� x 
D��R@�`P�Ƥ��Z@q�xx�@���	�`
fP�9��ޔ�T��,`y�)��C[�C]@��ˮ�<�o{�y��:����?�g��(@b��:6$A��A�����@0��c��e�b*�aD��2!�СX�~� bR�d�A��A��!��0��J�ԡ��ڡi��.�L!ҁ,��A��ƀv!�A�h��^��+NȄ�@t����H����`�Ё~�^�D��� ��!�`�`	����ɘ����@:���B��
n:h�)_��`���@!*A ��
f`� h@k��R�j$�����o;�'[���,�;�%[���e��e;���=�'���1I˚��~�b<XK!�(p��g?�"_R�bT�����A����!d`Ā*�J\�̉��z �a����������ڡt!v�ڡ�����
��tA�p��-��ց����\�t�^a2��	���� 
``v�<��@.h�!��	>���� ����d�>�R��
�x
.�|`����� 
����P�,��P h�� bLk���[�#0�g�^	<�[���'�䏗j?�1J��Z�� �@��^k;�A����E�ia�^.�"��`x!(�Z��`,a؁�!�a'}`2A���A�����Ava`��a��I̡�@��)���!�a/��L�����AL!�a4���&���������`Z��`�jA��*T�	D=�@��AXH 	�`T�� �>T�R 	��8!�@�
`@� �� ��d4n	LqZ@:��!��H`y��\�v������]�#����f;�/��}$fDK��4�F"��`�Cf�@��N4ɔ~@��xA0�zA��D����cZ!�2r!���`!��<�ࡻ�A��Ad��j!��D��~���na�l�Al��:����F!� �3� �!�A�v�� <�\*���a�!���`��!�Al�(��@����*�*	\ 	��	��E�� ��H` � p 	��,�`���@H@*1y
��,+\��! I�˺l`��.�E�;��K���J�?8�1%�8S���e��e�L���!`+��>@hV-��
�w6f�)�������S�aZ� H�JF��!�����l�f
U��$�nA���a�!���r�pa5� 
�`PB���a'�	��E@H�@W��w�u@�@a|p�v`� �<���Z�r�	����4�8�`��
�@ � uyb`w�2� 	T�HI�2� ��<��/��,���g�r�>~�`��������c 0�> �1 �@�e�Da�":����� �*�\K��V�V��@���8��h3F�N�a��4�	>`p�"�#����n���ӔaF�� � J��ai��.���@�a!r��!� �!o��B�������Y9�'[�����@!�`��������`-;���C��!@a^���
�� 	�� p�f@R`���
�`qX�����/]βv�p��T���\"Y?�/zl1;l��}�l�B��G3���$�^�}(�_����'	h���&�����h:�p��!���!�!cd'ߠ���`>Ah�:��D�N�����t<��*��J�A��X8��'BAs���4t���a`���pFС�a�PE�a�5A���`Y��QG�-�?,�g�B:1��f,{���.��`h��g����@�c�ZsB�C/�'y�#�˨�Ҳ�T�$��L�$��	�Za��c�gC@���A�Ec	�Z���e��d�@fi����@
� �|���8�:OɈ7��V�T@�@p Y��1n�:�A%�a��l!��
�N�a&Ӂ��k;aR��	xf�A)��.��n�� ���#!����9�Y�zR��&�t�	�8A@�:�������I|\�D�.��s�P�`�`
�@N�`Cy�ˌ>
`�${q0�Ga ��pi0�r��l�%dan�}�F�}b��$�|���1d5V`��”L; ����@
���8�0�
x�!;ف������J�D�j@��j��3�s�4��-���p���<9-�����Z!a�|D��!ȋ��W����a��A�5��D.��
�`�@E�@(����	�	��`���8h���9�fAs����� 	��jव;� 腠B`�E�{>~�y�Cbۛ�g0����\�cy�e`�����)| J#��~�׹q� ������> P���T��9ņ{��r'��!
��4�h!�����Z ��t!j�T��!آ`�=��������`~��A
�?�F����h���u�h�'Q�~���7bA�H�������@.�Σk���i���I�a�����	�m:� 	��j 	����n\���sI[�O����ާ 
 (���$8��aC:p���.X���+<h����|X�J.K�|P��I�/M�<�R�˓!�@��׵k�Ҕ�"�P�B�l��r����h�D�Z��G&p���C
5j�t#f,]:uv�}Cg7:t��Q�uȆ�?M� Z�hۼq#�-[dhмEӦm��p�g�%GQ.r�:k�F��P�pK'��BN��m�,ZÀ��t�P�|u���B�	
�VK"8�dѓ��$8@l��p�ӧ_`���'��|��F$P��{��@�K8t@y
@��i��FA��X��79�R�,Yt�K0A��E9-@J7��aD
	*���%~X�+�XQ�	M(��"ޔ��6���3�,�/��,v������-�hb
8��M9~��7촓�;��N9ڄ��!�`8��(ހ�1Ԑc�9��6�sΡ�T�2�É-�@sN3�0�"x��
^Ђ�4�\�
\҉"��B-������r�o���%�`2] o��M���uIT�4�z�5�z��W�y ���AM�P�$�z�U�-ᚇ�1�Q�%A0aL@��������"D"���J9}����d�K���)D�
3G]��/�`��/��C	%��7�a�	��
,�CG��2j�L���"K5�m� 7v����;��f9�3 4�K.Wi�`�X`��s(;�=�.��H'�  3�~�B=���:�B 4΄R�(ǁ2-���ݡ���n��"����
+�l��*��~h�~k�F���K-����z��~�%8���‡޳�nހ	����]��IZ����n��$~�F	,b��h� �SI/�$�@|����0�`F5��L4W�����0��R�.� �M���5�i3M5o�7�Qs��/� ����i,����_�v5CI��H�64�;"a!P�:b��B8��i`��,rѽ`t/���0�!�Kl"w�C!�	V\�������8��Wz���@d9�uв��H�#va����.�Z�Pz�u(&p���@`#	�&��턎؆6���&��I�rr�E�D"��R��1Ò�F3�U��|���A�N�°E,�!�\$#��H�6�� th&2�2_�$�r�M��%��� v\͘�T`Eo���1�A�g���0�D�P8���"�Q�g��8F0�a2�٪�h'�0�:(�H+0��@��}p�Ґ+xY�;�Fw֑n@k$�|�.�D��Dlg.��� b����u��+�P�6�y)� �	1�.D�$y2-�Ctw!u����R�J2�b�h�0��f�����[�� dԂ��ޠ�4r��H�H;���spdG9�� i)j��F2�� b-PQ��_�� �232���6���pC�g��
N�b�y-^щP���B�\
�͢��V�A"w��%0�	�]"���$��&z!S(�
>0������S�0t��:]F�K�%$���vB-�$x�L6�/��D%9��R �E"���\B%�%**(�
^�B^	��f�Ac5ɀ�6��l��x�,�Q׿�+�@�8
; jJ��p�4�oD��G-LA�<3�>�3{?g��{5�3���
E��F+��Y`4���&�V��e�R��E,�t�C�S�KP"��h��7h�
R8�8�9�y��	`-�}���"~��9o9 1AQCt7�:V��ˣyo:���$A.�I�X��H&4Xx�����b���9��_o�`2���RG�8G6�q��H���(T��aa��i��ȅ�L1םQ�D�;��U��8�aJ�6�A`h\#�W#�Ԍ�Mf(B�(0x��Z��E%���Y�,�+έ��B�a�0%.��>�o����+����� �g�o�Ez~T�]��VDؕnq�
@�Cd?b�]�(�R�6�E&b)#7S���D-:�E�'S�\��L�"��&0.�Z���L�Fg�A(r��h!.R�ʑ�ff����6���bC�`L5�1�p0S��jf�����:���2���t�C�iǦ6�fE��7(4���4��6�4-:�Y�m"��%�@�7x��VBR�d]�]xz*j�����j�hrDž����<btH���7�*���5�ԑ�j9�AJ"��T���9�śS�C �H�+z�^|�������t�x��$ ڿ!��u����4����2�@�3��`rpf� ,]1\�P�5S3m~�w�d��w1Ϡ	��	��pJuI���i�P1��t@_�ok�^�g�� ղl�ڢYt�-��Ee:	�E�#\	"-��9 �q�10rG��Gbѳh�g<:S�w!��<�9q|$�'1?!F %���]�o�
��
����i�V�P`ڐ �0�`$�� ��W�� N�~���Pa:��B��hw(J7M��tΤL��vwwl&�b*�U�t�p �Pup���06���i6�i��
�P��8ps�Z�V-Pd��Ւ:�p�E�CF�R���.p�-��.�-R{ �<%q��J�;�uH)a�%��S"��"�f0�H"(�i@����
��T��cа�ڀX���`k�v���l�� � �@L�h
��cJgu��ې�P �Tb�X��&i(��M�w ������t h�
��i�����Z��2�o�[`P5�3�*(p����E�3z�zʥE-S�z8wF�-��Q��
��" r#�h|4��^��"ɣ^@�!�B-�;�g0‚1�,�I@?�	H Ԁ��'�0LX1u�`�D~z�����?Ā�� �P� ��0��Pb$)(�Hb�Bm��dL��Uؔw�� .�x����/i��P+��
Svs�^�j���+Y�S�H��Hb��Ky��p��Et� ��eh�f3�F�{��G�rpG"�����6��<T|&si/�h��A-$�;$�O�ՄI�}�!O�K�(�E@�t�AV�P
���0߷��Lwgl� V�(T�X�L{K�Q$�x�J1G����������	�p	o�J�=��i�b�V`U@D���F��-Yp��ʅ�r�aT�•:�3��8-�  q�b��u�%E!��!KH�=�"��iY�e*S��"%S
�P̒/������0IŨ��tO&f�(�t��}R�p9*��AІ��f(�jW�*k|����b#������l�0��p���il���
�@	X@4�J$	~�{�Z�W�DP�y��E����EQ�	2����p\�ov�Q�A���%�,:!F�/pPRGx�3����6��rqD��H:�r4{1��x� ^�8�
���P����B� �d$��t��AJ����UWSl���&clg�%y�p�fu�;�/d�0�=l�i�ƣ����<�V�o 	Y�Dk�Y�E0��1���a-
�����V�e�pq:���+��U��s0;w��R��0��h9a�4��)� �5�3Uq�.�5p�u(����<��0��B�����3`��K'�� Z���U��W�$iAv��1�L��L��A2����l/�аI�@�X���<�}���ᰁ`���Dj`�U&`Ec4Yzf瑔���4�-��Eؒz7\[�-Y);�����p{c9��*uɣ��b/��H�F"��H&B-�ւ=q@.z��X_�+��	>V�ӔL� � � ����p���pw'�L,{l&Z�<��4:X�au��/�B�`��p�?���7����
?�
[��jPU�!�0�Q��ŭR�^�QT����s�ϫE���Y�-A^ b��g�yG"<J��2�1�/r��s]��^,{�G��a"�v9@_��i�`kp��T� ��UG�@����
 �@��К�z���AĶlg$}�A��/X�v �j�W���T̀��������V}��
� 	j�ƪj�f�DzW�U����f��p�G��-_�	�W����!;C8;�sܢh֕��;s�h8�hט0�^�&�	b0#U�Ɵ�q��z�\-���𳭐
PW0}�x��0� �0 �X�#��k�y�M~�L�� �@L頉~��1Xj�.Y�φ�i)�3�����i��	�|e��O~��G ����x���� ���W|ԫg�ck�U:�l����:� �@/*g�z)^{k{-��>a0�5�x)����4�/�n�	��
�`f���
ٷN>F��Q؜A~�D��_L7�*�������L)��� �}ҝA��0������੬�7��xĐN��i��
��	V[��k�N{U�,S�Q9�^ꥢc���p�p �Q��F�\����'d|�ly������;x[�;H��2i*A0�e�!���3F�" ��(�g沰5��	�ГW���i�=��G�Ȗ�tؐ��p������u$[X�  �v�B��?�#�J7 ���� M��x��p����
�P	�E��VB��њ�H��<ͬ�W:�yQϼ��1�og��u���,���"�=a;�0!I8�6ў�c�31���]�rn�Є�'Fs���8A�����Rp�0_Y�g`	��i�C�L���l�Ê ����I�L7�����1���ʘ�X�mN�iM?FN6<�ۻ��	��B��e��D[4�K|�Om��ԣܣ�I)�D.��̵N̓ی���r�i�uTR��G�S"=e����c�/�!1R5��''��#�RB�r&��W6P��݃�L�T�"�� ɐ�a� ����A�m���@K���$��y4��sAN�DN�����0շ���ZK���Jͻ`z�#�V��\:�����P\
Q�[�A��){ԓ|�30�pK/0��HK���<s�Y�])R�"žQՈ��s	0;f�9���T�D}P	G��t�4L`�� Ju]�¯Y���l�>`��B��~�9�s�_o�v��@��T���€8�;�㫰�ek�Q��y?��T	��1�#�Li�U�p��/\�U��"��c��[-5E�K�r�`�*U��=�� �0c�G��Ɏ'�S�Nեqt���,�q 0n 	��	��=0�c��T��ps��l�zF`m� o�j^��`�����/M���=)�C딏�p���	��
��gO�4TTx�p��$N��@"?�'b$�/"�\��b�\)1�H�1F���&�Y����>X�Q d�`��8�����X�>�:��+W��L� ��������p��nQ��0���Y�:�����2j���+0f�%3&���fÆC���4l؜=���3m��E�6�Z4h�J��m�X�f̈+FLX�f�|k&>�1-Z�^�bʼnU�N�0U�Ǐ+f�с�Ļ;��H`�ƞ�Pv䇱}G�5R�i�#�13�(��M�$2�!����{`�����(���#4�����0��BK���
jA�P/@���@���)�� I(���� �4(IE�^~��h �`���aT{&�)�i�4$M��ff˒Kb"&�a�	F�(��2k	�XzqE�T��d�M8��J�@�$��!�8� ��$R@��Z≢��#��+���ƻ��<ZT���ˉ��"¨ʼn��Q��(�\/2x�r}��:�ʬ���uWC,�����d�U���z5X�h\�����.��	�6(��=&�d^�<��'�|�`pk��%�$ƴ,O�2Ҧ<����e�Z��tS�ۆɥ`Z~Qn�U�DL0��8�8#	h��h証�4e���Ы�=���轚F�O<�0:`f%*'��g��źb|�Vl��2˂V=l ٩�l�`�6X����n���(c�q�u�kg�j�����VZ��H_�|�Xx���zռ��g��(w�L�2k�����^~anVRI��K.�J(��6�0�:ؠ���FPaɽ��kofM߻H��>�/��M"�'��og�- �bd`�����K�\���]�R
j����[���Ś����y��BQ�����[��0������LB !���(R���#��8�Y���d�'��]D �|A�e�I��+x�V`��D*B7	�!P3��UZŸ*@>��y^6�G�=���Z��h ��OP� �H�!	�ٷ懽�D�)Py��R!�\qY(˂2Խ�+F@Q��R��шF��C��2�l(Gi��@26@���܆�.W�B���0x�` �]� �r�q�v!�arJ-�Q�a����+V�	ͥ��@�$L��?��F8�6p�%�TO�R�h�N#+IYG0�P�l����.i6���&As�\�<���{�O�b��X i��fӮx�a=�Y�ڲ:DN}�Y�J������Y\!����h�j�fˑ�f�6��A���P1W|�M(!Y@�Q&�3�$9)�_�����,\�шu�s�4H�`����fs٣�)hҒA��D�c���cQ��tI)L��.�KH�d����gF62���X�ZbJ�,�L(+p�ա�}(�����,�u���c��&�[n�B׺f�TG��o0��+��� ��g�)1�9�A��U,/Z�D
�O:����
��B� %%P�=�Ag(CՁTMG2I�l�2a�h$�S��`���~��ȌI4_���xD'��ΐ����DC@�yΪF%*���[v���OX��BŮ(+�d��<d�om�]�W��ogu)�L�iF�@�+ ��L� 2�����(G��+�9���r>��R� �	K)�=��e B<�:!h0
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




























































































































































































































































































































































































































































































































































































































































































































Deleted library/demos/images/earthris.gif.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
GIF87a@ȧ�I$��I����mI۶m۶�m$�ے���ےm��m�۶I�������m$���������$�mIIm�$m��ے�m$�����mI$$mےI$I���mI$��mmI�II�$$�۶���mm�����I$�$$����Im$$�II��ے�۶�I��I۶I��۶mm��m��۶���mm$$m����$���m����m���������ے�m$mm�ے��II$ImI��I��m�ے���$I������۶�۶���$��I��m$�mII�I��mm�mm�m�����$����I$������III$$m$$�$I�m��m��m��m��m������m�������mIے$��m���Imm�$$$I$$$$I$$m$II$mm$m�$�m$��I$I$II$�I$�IIIIIIm$ImII��I��mm$mmImm�m�Im۶��Im�Iےm��mے�I��m۶�m�۶�m�ے�ے�۶��$I�I�I$�����$��I���,@�@�H����*\Ȱ�Ç#J�H��ŋ3j�ȱ�Ǐ C�I��ɓ(S�\ɲ�˗0cʜI��͛8s��ɳ�ϟ@�
J��ѣH�*]ʴ��&H@��W�J���ׯ1P��`��PL�t��� \���A�"��;�_*��Kx���Sl�WG�޸���VE�j7� �&t8ܣ���o8�`��	�/��;'�YŸs�A���@\pPE��2;,N<���Te�N��A����ν�������O�����ӫ_Ͼ�����k�A���	P��@��v����	0��P ߄8y��&`x@$@/T@+�	B��
���(cԨ�6��C��`C�'��� ���0`�� ��S����'�Q��2��UdZ��� �64�&RHԛn�i'�遛xp@������4@��h"�#�Xi�
�(c��)�i�@@�BF�$�=�������
��,�_��>���d��2�����N6�	4���.K��2,{�TJI%�0Pm�~[��Z��9�a`��RpR@h��&n�ۀ�Zh������ �H ��(b�2LC�f���6ڢ�d,�14i��P)
À��j�}��l�}1l�c�6.\#Ĭ�8�}5�,��C���2��<*�x���	 ��G:yu�"����P��Ժ��d�-t� Mcv���b��e7�`���N٠�D[U�$ڀ��'���7���G.��Wn��g���w��q_�dM����(PAX]Wa%;�Wu�y�P�*\��f����Yg A
)�Dy5Add�uV�}a�m��r{�-\��M@!��i�FDc��5j�����]/��[��m�۾�� 8���� P(p�!H��1��G��Y��̠7��z�� �G�F�� q*��`R����@�.61�(&@°����������*f�.M�z�B7.i��Cv��a�yY�O�@�.V���إ&F!�(B��^*�	�B��$t	�F90��3�:��X���5��?h�ګ0��?���
��)!`�b2�U�8�pr�K��F�tY�
�z��š�m��e�Zt�jP�*��(z��_%He	��3�C/f,G�a�C�4	д��R��&��5��Hִ�~TfM��l\@��fv	�H;�ٺy5T�I�К��ɫvj�n	0ղ�e,�`L	8���PpE�YaC�	��~�h8��Ё2���
�p�`QHi�NB�i_��.�K�"D�~��P~�%��A�N6�P>t1F�i?˘�&�)nbj@g�.fC����APU� ��I5O�'�M6" Zs�?�#�4#�@1��F0XN��F&"�٢�MK�l��:u%�IVm@�8��!�>vQ�D�ٗuM@���>�����d�����-*����ͭnw������� �p�K�����M�r����:��Ѝ�t�K��0X�
��w�''y���ƻ��L�֭N���R������8�3u��&��,���$���.�ci��'P��H@8�n�:�L�{>��xQ� �0 �Y�p�x(��f(*�O )��Bp�����]��� ��ћ�B0�\08qQ���(a�R�BdB����)��@:����49VBg��Lx�������D&S�����{�a�]:ЂX �џhҁѨ����"�w� 9����Rc���X@��=Œ��x�u�-�z:�o���`4�q��b�Q��ָε�w��^�������M�b���N���}P^�A
:^&Y)%�d0��M ��D����X�rHt @}�C,<4#���Rn�$�8�}��!h�b[���Fׂ�R?�,R�D��J��c��U�1H����� E�a�BQ��LJ�e~t7G���n0�$ϬT�ɓ(@����s$ͪIv3"��eDi]�5������OK�g�5�F[���x��>TG��U����@��O�2A�����7
B5�A~> #�z\��0�����=��h7�5+K�g\Pt��.��F�H]�YOb��d�0 �z��g�$��JYTy: �f�Ѝ��S߶{0��7�)P��סXKQ�P�4Q�j0� �c��.��8F���PQ>�V�l�z˴�y4��eSՏl��ۊ?�&��֦�b+��jz�~�O����rR>��sd��Y��P�-iR7��Q�G+w�wA�-����u<Su2of�R�`S�b1��"��T�BC�20�(a|-�.��,�K,�(�({(4�C�|����@�#@X��3��<3}	�C-'��*��X��M.cP�)�'V�*`}�zȒ$�G%ݢD�7�Gyj(6@y�p�#b#G��ZbS�%�8e7��I�
X!���'�{b/��qn2S0ES�F)1"5�1X�UrKEFP8@1��"��!�2�$�Xr6���W#CZ"�)WNs)6C#"�)�M3".�Y�Ep5���V��V޴��rv6�7$��F�n-��}��%,Gm\%�vVd�Y>�M��G����F��%Q"��X.�r�6Y��h`��J�(}�&�&_��(K�'�5�EV�E0p�2�5%p�1oD#�8�2 ��G� *�3M�U5W��%0"/9�1�%�M9S1��VXU"#W)%"#M$2$1% ��X$���X��V����M����WD4(�2u�) S���M#�1�y;N�Q)F���bZ;`;p5��4���|ٗ~�����9��Y��y��������٘������9��Y��y��������ٙ������9��Y��y�'�P��)��P	p����]	�;�1^30#;uADE��Ub�:@;@��w1da�E`ĩ�^
��6Sp	�����_�`���)b1`�6cv�eP�gi`f=��46牞T�e��c1`��e��;��S�;��}�<�9���:�a�iO�(�fQ�	d�s<��B�}�a�C<�9A0�-�A6��j�I@�Ek�sN���sd��I�I�I����-�D�PR` �1c!�0a�vH@�h!d?00��p��k���Uc>�>���a~V>p>p1�ߕq!Z g�cy��:�֙�3��O�pewA[a	$�}f?��L����<�C�L<?���jH���l0��A��vc
?ya;���0��?��@��o�z�����f=�����`<f�:㺞�Z~�@ p}�[��~vg[=�媡�*
efϩ@7:?���	p�@ԨPk�J@�6���}�B�j�0c���[0�t���q�0��.��0�2;�4[�6{�8��:��<۳>��@�B;�D[�F{�H��J��L۴�I2�X�y�P�PT׳��2�F��G
P� �2[`"8��v�2��� sU����; rP ���,`V�f%�|��I�x�sp$��,z㇡�s.�.���92$#C��L2)15be)�]�FЇ�J(q�P09p�{W�c,������\���4
�1�1�����U=Hw6Ifu#�H���p�k-�Dy�2�bDh�-H�D�z�s��)[GF)�"`1�U"B�#��4�Y�2}tt+�+t�+HgyO�I�5�h ����Խ��y臮8@��ES]�u�!��B)��f$X�rw�dy��Nr+*g	*;s��X+q�r��$�$x��$Tb7��r�(�]S�x�r%��PW�����%�9E��uC�'5�'��L���L`l1%�M�(*��3��%pQ�+p�r��$GR*\�%�t;�&Â,�P�N�HM2JA(6��t�4j�&T�p������ȟDEG.G���J+�8��AeKA�JB���E 0�rv��'��&YK+2ׄ�uN@H�rn4����1,QB�.�. �?8,�%C2G��*��H�rIHr,���Hr�O�7~c�L�peOE'��� WQ4X'����[�'��{5H('X'�'w{e\�#YC��|(c+�p�@IM6„ī�4�PHC�4�%���.+�Q�Ԧs��"I[�+J\��,I��$�R�P�tx�<,���M�z�$� �q�&���@S|-��+�,R(}r{���/�'��J	�1�D:dV�R�k��c}�)�6 �d�Cl�ei}�*B,�$�6^�No͆j3IrGCg͗�$m�+e��Or[Ǫ'%���fx�U��J�,�7-�m�t�SB��|88~-b�	É���/"P0��|)800�L��q�tL0.��0Kh9)��(����L(�5@����\�G�,�s���o���$�T��Zn�G=�*�f�F~x �4ާ���}%�$q�t�R���&xX�Y�n5�[R6vsPV���P����p
�0
��uB�/G�� 0(}�$�u3�I�o��g����!$���KCB#Y�)��!�TK�)�(�T2ǝ�NCwe��<�n,�7���)c��Ď��4f*k��2J>���HnG�*����<�R$3�W�OE�� E8�B�F�Fu츼�M�}����Q5$�wP	�@}x|�z��D�J�'�,��W�/�h'�J�=���45P���P��$N��$� 2|�D2�4� �(�(��4hW:4�)�A����ّgÓ�ׂuN�}<SC���L���M�4��bZw86bz�;Y0����5�����~�Է���E���q���WS�@�Nz�=�2�|�z�\a/�R/S���>��lT�R�9%-�E�SmGL1Љ�;12��m��"�	����L�8���l���nh��C�X�)+^�M#�MkE"���!���Dcy%6*c`��M�hW��#k6+g�F�`W�N��}+��L 3�AZ�5N
`�cY��q%A7�M�Id"ի�Ϗ���r���E�W��UeGՆ���!��!�F0o[˄7�F`$c3&¯�(/�1է�#rke0q�TSr�0�+|ͤ"ʤ�y��R�)��V���S�{0�2��Y)<�r�o�C|�5�C��s�F���<yn/cn�r�*)�����F�n�����,x���h�@��(��PC��"�901�v|��^r2��E��'3��Er��F�.32b���oo�X���29r�()���^ W%�}M�Fw �����@@���,P@���**P�@� |\���
%3@`(��Ȉ,<s�K������
��@@�'�T�S���%B���c6��a�KTX��J�D
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
















































Deleted library/demos/images/tcllogo.gif.

1
2
3
4
5
6
7
8
GIF89aDd�������������f��3���������̙��f��3�������������f��3���f��f��f��ff�f3�f�3��3��3��3f�33�3�������f�3������������f��3���������̙��f��3��̙�̙�̙�̙f̙3̙�f��f��f��ff�f3�f�3��3��3��3f�33�3����̙�f�3̙����̙����f��3�������̙̙��f��3�̙����̙����f��3���f��f̙f��ff�f3�f�3��3̙3��3f�33�3���̙��f�3�f��f��f��f�ff�3f�f��f��f̙f�ff�3f�f��f��f��f�ff�3f�ff�ff�ff�fffff3fff3�f3�f3�f3ff33f3f�f�f�fff3f3��3��3��3�f3�33�3��3��3̙3�f3�33�3��3��3��3�f3�33�3f�3f�3f�3ff3f33f33�33�33�33f333333�3�3�3f333�������f�3�����̙�f�3̙��̙��f�3�f�f�f�fff3f3�3�3�3f333�̙f3�ݻ��wUD"�ݻ��wUD"�ݻ��wUD"�����ݻ��������wwwUUUDDD""",Dd�H����*\Ȱ��z�Ht@Q��92�p���z�$@@сE�uY�2�˗0c�q�cB,[��ɳ�� �1qbM2~*]��Ƌs��S�@L�jݺ�#�\Ê����سh����֣��]
D(��m����@�Z��ܱ�oO�3=�c��G"(��pL�q]��%��
[���#���+���X�h���^������~�r��K#Gp]���z���:���{�԰�s�F���z�\)t��W�r�= ٷn�ݧ��;r�?���zO��s��-A��g�� T�8���mU9p�e�QW=�(�!2]�e�@n��n1Yx�=	j�!g�EP���������ΐ�M����c��8:��!;”\�=a�bX@*YZ�E������N� 4���t@E*��N5@݀k�VPR�5Vb�������g2�ԥ@p�N�Y�*�)w����VC�;17[�a隅(��cN���k5��UA�Gإ��!��`������z_�x*LP��*� �kFW[;=X+Z@�p�����m����E_̪�E��m��_��j���ף��d�g���̮�zA�.L��XX��k�!�)S��;����9F=2�ukVNt^�9$\f��+`Vʆ����
I���1w��HJ��@�X����*�O�V<P�O17��*+Zr�cъ�X��!ت�O�[�e�bI�>
�"��V�e�@T�U�=T2ø������u�
++�����AFȮ�d�O��H�=��HD�"�cԪ��������A�kU���g��=��S���u��׵,)����Ԟ;`���Է, �}�J	����й��N��>�
"���*Z��X��̯�IF*�(��b�>2�98���s�u�b��9> >�@ �;S������9��Y�ߖњ9X��?����C��ʷ�Cz�S�䧹�,Y�^�T�����gwIK�F'���~J!����rӳ��⛂��`:D�g% �#�h9Y��$�U	c	Z�HqC��`9�!���z�n�ay��0s@8��˪BϢE��!E@ ��V`��DlRS�+&��)!̨���)(:k�b- �#A���dpG<�K���4@d�-��d!�A���������#�a9PV��Ҽ��%��8�\����"0qٽ���qZ=B���_�8��-w��8}��VL�"�`1Ej	�m�Ť�|�3���r�rqJ',�6M������7���<�.�*W�P�˗Ъ=ܼ�_"��<8�̱nS�h�'�,Q@uc��t�3���<�q���Wϼ9/��GQۜ��~9N�~%���DPMX53�J��4u��rB�4X�I =�$��W8���@�zx��
�f��v�'&#�I9�_,�V_���$�Y�Lu*�V.9����O�����u�-��W�,�}%_�I���\�B�!826-�9�c����d*gm���G��D#2��Dd���D$%)�IP�f6�	�F<�
<
<
<
<
<
<
<
<
















Deleted library/demos/images/teapot.ppm.

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
P6
256 256
255
\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�
j5
h4
g3
5$D,K/b; h>"wM1tK.e="a<#cA,U8&E-<(9&.!a0	b1	c1				

+3#@)46G<:HMCIXHK\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�U*�vT�~X�{Y�k+�W&�N$|>u:p8k5
f3
a0	_/	].	[-	�I�\*�_(�LkRMmSMmSMnSMnSMD,R3W5mA"|O0|P1j?"c<!a=%Y7"N1F,;'NCJNCJNDJODJODJODJh>!a: X/K%&4$+2F=;HPEJL&\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\��lR�xT�sT�d)�O$w;m6
g3
a0	Z-	\/T*Q(�H�m8kRMmSMnTMoTMpTMpUM15G15G05G04G04GpUMpTM5^9 d<!yF#�O+�N,rC#qB"pB#k?"a: Z7 6ODJPDJPEJQEJQEJREJREJREJRFJSFJSFJSFJSFJe<!X/- '0F�qS�gQ\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\��fP�tS�mR�R%�Bf3
^/	V+Q(L&I$r9�TlRMnSM46G47G47G46G46G46G46G46G36G36G25G25G15G04G/4F.3FoA"�N$�O%�S)�R)�T&�T%�R%�O$�J#xE#PDJQEJREJRFJSFJTFJTFJTGJUGJUGJUGJUGJVGJVGJVGJVGJVGJVGJY6N't;�O$�dP�oR�dP\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\��pS�kQ�S%x=[-	R)I$E"@ �M�]'pTM68G78G78G78G78G78G78G78G78G68G67G67G57G57G47G36G36G25Gp98eOLpUMtVMn7�f+�i,�i*�i*�h*�B �`O~[NqUM[-	�HUGJUGJVGJVGJVHJWHJWHJWHKWHKXHKXHKXHKXHKXHKXIKXIKXIKXIKXIKh>!Y0W+].	s=�M$�dP�lR\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�oTM�oR�dPvE"V+K%A 99�F�['qUMtVM99H:9H:9H:9H:9H:9H:9H:9H:9H:9H99H99H99H99H99H99H:9H;:H>;HB=HPDJ\JKmSMwXN|ZN�y[ᦆ֘u�{W�yU��]��b�tU�nR�hQ�aO{ZNvWNtVMvXNwXNyYNzYN{ZN|ZN}[N}[N~[N~[N~[N~[N~[N~[N~[N}[N}[N{ZNzYNxXN�L$f3
I$L&P(U*\.	�J#\O�jQ\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\��kR�aOo9 L&C!:4f3
�X&pUMuWMwXNxXN<:H<:H<:H<:H<;H<;H<;H<;H=;H=;H=;H=;H>;H>;H?<H@<HA=HC>HG@ILBIREJ[JKcNLjQL�pR�uT�zU�~VȁW˂X֎c�sҎe�{V�vT�pS�kR�gQ�bP�_O�^O�]O�\O�\O�\O�\O�]O�]O�]O�]O�]O�]O�]O�]O�]O�]O�]O�\O�\O~\N}[N|ZNxXN�T%H$G#K%Q(W+zG#nTM�iQ\�\�\�\�\�\�\�\�\�\�\�\�dOLrUMuWNwXNyYN{ZN}[N{ZNwXNsVM\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\��`O�cPnA"M&@ 8F#m6
�W&rVMvWNyYNzYN|ZN}[N}[N><H?<H?<H?<H?<H?<H@<H@<H@<HA=HA=HB=HC>HE?IG@IIAIKBIODJSFJWHK�hQ�lR�pR�b(�i*�n+�|7�|6�r,�q+�p-�l+�g)�b(�sS�pS�lR�iQ�gQ�eP�cP�aP�aO�`O�`O�_O�_O�_O�_O�_O�_O�_O�_O�_O�_O�^O�^O�^O�^O�]O�]O�\O~[N{ZN�T%F#B!Y,L&U*~I#�^O�`O\�\�\�\�cNLrUMzYN\O�^O�`O�bP�cP�dP�eP�fP�fP�fQ�fQ�fQ�eP�cP�aP~[N\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\��fPsVM^/	C!7 �Q%tVMwXNzYN|ZN}[N\N\O�\O�]O�]O�]O�]OA=HB=HB=HB>HC>HC>ID?IE?IF@IG@IIAIKBI�cP�dP�eP�gQ�iQ�lR�nR�\'�d)�i*�m+�s/�s/�o+�n+�l*�i*�g)�c(�_(�qS�oR�mR�kQ�iQ�gQ�fP�eP�dP�cP�bP�bP�bP�aP�aP�aO�aO�aO�`O�`O�`O�`O�`O�`O�_O�_O�^O�^O�]O\O}[N�QD"?D"K%_/	kRL�fPODJSFJ�_O�bP�cP�eP�fQ�gQ�iQ�jQ�kR�lR�mR�nR�nR�oR�oR�oR�nR�mR�lR�iQ�eP�_O\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�B+�ePI#L&90y<�PxXN{ZN}[N\N�\O�]O�]O�^O�^O�^O�_O�_O�_O�_O�`O�`O�`O�`O�aO�aP�bP�bP�cP�dP�eP�fP�gQ�hQ�iQ�kR�mR�Z'�_(�e)�h)�k*�n,�n,�m*�l*�j*�f)�e)�c(�_(�]'�pR�nR�mR�kR�jQ�iQ�gQ�gQ�fP�eP�dP�dP�dP�cP�cP�cP�bP�bP�bP�bP�bP�aP�aP�aO�aO�`O�`O�_O�_O�^O�]O�_(�@B!I$B!N'w=�eP`LKbNLeOL�kR�mR�nR�oR�pS�qS�rS�sS�tS�tS�tS�uS�uS�tS�tS�sS�rS�pS�mR�jQ�bPjQL\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\��bPpTME"5�M$tVM{ZN}[N\O�]O�^O�^O�_O�_O�_O�`O�`O�`O�`O�aO�aP�aP�bP�bP�bP�cP�cP�dP�dP�eP�fP�gQ�hQ�iQ�jQ�kR�lR�mR�Z'�`(�d)�g)�g�j*�j*�i*�i*�g)�d)�c(�a(�_(�\'�pR�oR�nR�mR�kR�jQ�iQ�iQ�hQ�gQ�gQ�fP�eP�eP�eP�dP�dP�dP�cP�cP�cP�cP�cP�bP�bP�bP�bP�aP�aO�`O�_O�^O\N�Q@ <G#_LK�cPlSMnTMpUMsVM�tS�uT�vT�wT�wT�xT�xT�wT�wT�vT�uT�tS�sS�qS�pS�oR�nR�kR�hQ�bPeOL\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�wXN\NJ%01�JvWN}[N\O�]O�^O�_O�_O�`O�`O�`O�aO�aP�aP�bP�bP�bP�bP�cP�cP�dP�dP�dP�eP�eP�fQ�gQ�gQ�hQ�iQ�jQ�kQ�lR�mR�Y&�]'�`(�c(�e)�c�\�\�\�]�]�^�a(�`(�^'�['�['�oR�nR�mR�lR�kR�kQ�jQ�iQ�iQ�hQ�gQ�gQ�gQ�fQ�fP�eP�eP�eP�eP�dP�dP�dP�dP�dP�cP�cP�cP�bP�bP�aP�aO�`O�]O�OG#7F#uWM�^OwXNxXNzYN{ZN|ZN�yT�yT�xT�wT�uT�sS�pS�mR�jQ�gQ�dP�bP�aP�aP�bP�cP�eP�cP|ZN\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�[JK�bP^/	101|>wXN}[N�]O�^O�_O�`O�`O�aO�aP�aP�bP�bP�bP�cP�cP�cP�cP�dP�dP�dP�eP�eP�fP�fQ�gQ�gQ�hQ�hQ�iQ�jQ�kQ�kR�lR�mR�Y&�]'�`(�b(�[�g�i�h�f�d�e�c�U�_(�]'�['�Z'�nR�nR�mR�mR�lR�kR�kQ�jQ�jQ�iQ�iQ�hQ�hQ�gQ�gQ�gQ�fQ�fQ�fP�fP�eP�eP�e

	
@%<-$G?@�pfdNLuWM\NdNL\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�TFJvWN�aP./01�E}[N�]O�_O�`O�aP�bP�bP�cP�cP�cP�dP�dP�dP�eP�eP�eP�eP�fP�fQ�fQ�gQ�gQ�gQ�hQ�hQ�hQ�iQ�iQ�jQ�jQ�kQ�kR�lR�lR�Y&�\'�^'�^�b�c�e�i �g�c�b�a�`�^�]�X�['�Z'�Y&�mR�mR�mR�lR�lR�lR�kR�kQ�kQ�jQ�jQ�jQ�iQ�iQ�iQ�iQ�hQ�hQ�hQ�hQ�gQ�gQ�gQ�gQ�gQ�fQ�fQ�fQ�fP�eP�eP�dP�cP�aP�O�`O�`OoTMQEJC>IeZY638* B\�\�\�\�\�,4	.G1!\TU��rsVM{ZN`MK\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�[JKyYN�bP/0�N$�]O�_O�`O�bP�bP�cP�cP�dP�dP�dP�eP�eP�eP�fP�fP�fQ�fQ�gQ�gQ�gQ�gQ�hQ�hQ�hQ�iQ�iQ�iQ�jQ�jQ�kQ�kR�kR�lR�O�Z'�\'�^'�V�a�b�e�i!�f�b�a�`�_�]�\�Z�['�Z'�Y&�Q�mR�mR�mR�lR�lR�lR�kR�kR�kQ�kQ�jQ�jQ�jQ�jQ�iQ�iQ�iQ�iQ�iQ�hQ�hQ�hQ�hQ�hQ�hQ�gQ�gQ�gQ�gQ�fQ�fP�dP�cP�W&�dP�aPrUM
 B\�\�\�\�\�\�\�\�\�\�%7!!C*F#P){dY�ze��p�\OgPL\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�SFJ`LKvWN�aPm6
X,uWM�]O�`O�bP�cP�dP�dP�dP�eP�eP�fP�fP�fQ�fQ�gQ�gQ�gQ�gQ�gQ�hQ�hQ�hQ�iQ�iQ�iQ�iQ�jQ�jQ�jQ�kQ�kQ�kR�lR�lR�Z'�\'�]'�_�`�a�b�e�i"�e�a�`�_�_�]�\�\�Y�Z'�Z'�Z'�mR�mR�mR�lR�lR�lR�lR�lR�kR�kR�kR�kQ�kQ�jQ�jQ�jQ�jQ�jQ�jQ�iQ�iQ�iQ�iQ�iQ�iQ�iQ�hQ�hQ�hQ�gQ�gQ�fQ�dP�_Oq8�gQ�`OuWM�T%\�\�\�\�\�\�\�\�\�\� B B!!T,c5�F�T3ț~Ɠq�^OfOL\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�XHK_LKsVM�`O�cP	�S%�]O�bP�cP�dP�eP�eP�fP�fQ�fQ�gQ�gQ�gQ�gQ�gQ�hQ�hQ�hQ�hQ�iQ�iQ�iQ�iQ�iQ�jQ�jQ�jQ�jQ�kQ�kR�kR�lR�lR�lR�\'�]'�^'�V�`�a�b�f�i"�e�a�`�_�_�]�\�\�R�Z'�Z'�['�mR�mR�mR�mR�mR�lR�lR�lR�lR�lR�lR�kR�kR�kR�kR�kQ�kQ�jQ�jQ�jQ�jQ�jQ�jQ�jQ�jQ�jQ�jQ�iQ�iQ�iQ�hQ�gQ�eP�Sq8�aO�gQ�`OtVM�X&\�\�\�\�\�\�\�\�\�\� B B Bl@!{A�L$�Y'��a�fP�aO]KK\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�ODJ[JKaMKqUM\O�cP�^OvE"�]O�aP�dP�eP�fP�fQ�gQ�gQ�gQ�hQ�hQ�hQ�hQ�hQ�iQ�iQ�iQ�iQ�iQ�jQ�jQ�jQ�jQ�jQ�kQ�kQ�kR�kR�kR�lR�lR�lR�lR�^'�^'�_(�W�a�a�c�g �i"�e�a�`�_�_�^�\�\�R�['�['�]'�mR�mR�mR�mR�mR�mR�mR�lR�lR�lR�lR�lR�lR�lR�lR�lR�lR�kR�kR�kR�kR�kR�kR�kR�kR�kQ�kQ�kQ�jQ�jQ�iQ�hQ�eP�W&M&oTM�iQ�eP�_OtVMmSMdOL\�\�\�\�\�\�\�\�\� B B B�J�Z'�_(�kQ�iQ�`OSFJ\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�TFJ\JKcNLlRMzYN�`O�ePzZN	\N�`O�dP�fQ�gQ�gQ�hQ�hQ�hQ�iQ�iQ�iQ�iQ�iQ�iQ�jQ�jQ�jQ�jQ�jQ�jQ�kQ�kQ�kR�kR�kR�lR�lR�lR�lR�lR�lR�mR�a(�`(�`(�[�a�b�d�h!�i"�d�a�`�_�_�^�]�]�S�\'�]'�_(�nR�mR�mR�mR�mR�mR�mR�mR�mR�mR�mR�mR�mR�mR�mR�mR�lR�lR�lR�lR�lR�lR�lR�lR�lR�lR�lR�lR�lR�kR�kQ�iQ�ePt:�kQ�hQ�cP�]OtVMlSMa2 \�\�\�\�\�\�\�\�\� B B
$5 �`(�e)�nR�jQ�^OJAI\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�XIK^KKdNLhPLuWM�]O�bP�fQ�eP m6
�`O�cP�fQ�hQ�hQ�iQ�iQ�jQ�jQ�jQ�jQ�jQ�jQ�jQ�kQ�kQ�kQ�kR�kR�kR�kR�lR�lR�lR�lR�lR�lR�lR�mR�mR�mR�mR�g)�c(�c(�b(�V�c�e�i!�i!�d�b�`�`�_�_�^�Q�]'�_(�`(�f)�nR�nR�nR�nR�nR�nR�nR�nR�nR�nR�nR�nR�nR�mR�mR�mR�mR�mR�mR�mR�mR�mR�nR�mR�mR�nR�mR�mR�mR�mR�kR�hQ�Ga0	�bP�mR�jQ�fQ�aP}[NrUMmSM�L$\�\�\�\�\�\�\�\� B B #C, 8&H.Z7 �pR�jQ{ZN\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�QEJ[JK`LKdNLhQLqUM{ZN�_O�cP�gQ�hQ
�bP�eP�hQ�iQ�jQ�jQ�kQ�kQ�kR�kR�kR�lR�lR�lR�lR�lR�lR�lR�lR�lR�lR�mR�mR�mR�mR�mR�mR�mR�mR�mR�nR�nR�j*�g)�e)�d)�d�X�g�h�e�c�b�b�b�U�`(�a(�a(�c(�i*�oR�oR�nR�nR�nR�nR�nR�nR�nR�nR�nR�nR�nR�nR�nR�nR�nR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�nR�mR�jQ�Q%Z-	�jQ�nR�lR�hQ�dP�_OuWMpTMnSMkRLa: \�\�\�\�\�\�\� B B&D2 @*S6#G@IPDJ�hQmSM\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�VGJ]KKbMLeOLiQLlRMvWN\O�aO�eP�hQ�jQ�gQoTM�gQ�iQ�kQ�lR�lR�lR�mR�mR�mR�mR�mR�mR�mR�mR�mR�mR�mR�mR�mR�mR�nR�nR�nR�nR�nR�nR�nR�nR�nR�nR�nR�nR�l*�l+�j+�g)�f)�e)�d)�e)�e)�e)�e)�f)�i*�s0�s.�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�pR�pR�pR�pR�pR�pS�pS�pS�qS�qS�qS�qS�pS�qS�pS�nR�lR�I�hQ�pR�oR�mR�iQ�eP�aP�\OsVMpTMnTMlRM�X)\�\�\�\�\�\�\� B%C)D$;J/[8"LBITGJYIKWHK\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�NCJYIK_LKcNLgPLjQLlRMpUMzYN�^O�bP�eP�hQ�kQ�lR�fQ- �hQ�jQ�lR�mR�nR�nR�nR�nR�nR�nR�nR�nR�nR�nR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�oR�pR�pR�pR�p�y-�w-�w-�y.�{-�u�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�qS�qS�qS�qS�qS�qS�qS�qS�qS�rS�rS�rS�rS�rS�rS�rS�sS�rS�qS�oR�iQ�iQ�qS�qS�pR�mR�jQ�gQ�cP�_O{ZNtVMpUMoTMmSMjQL_9 \�\�\�\�\� B"C(D#*A$[<)d<!QEJWHKXHKD>I\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�SFJ[JKaMKeOLhPLkRLmSMoTMuWM}[N�_O�bP�eP�hQ�kR�mR�nR�kR!-E�kR�mR�nR�oR�pR�pR�pS�pS�pS�pS�pS�pS�pS�pR�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�pS�qS�qS�qS�qS�qS�qS�qS�qS�qS�qS�qS�qS�qS�qS�qS�qS�qS�qS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�sS�sS�sS�sS�tS�tS�tS�tS�tS�uS�tS�sS�rS�nR�oR�sS�sS�rS�pR�mR�jQ�gQ�dP�aO\OyYNuWMqUMoTMnSMkRLo8 \�\�\�\�\� B'D+E$(1J/jH1NCJUGJYIKUGJ\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�XHK]KKbNLfOLiQLkRMmSMoTMqUMxXN\N�_O�bP�fP�hQ�kQ�mR�oR�pS�pR�hQ�mR�oR�pS�qS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�rS�sS�sS�sS�sS�sS�sS�sS�sS�sS�sS�sS�sS�tS�tS�tS�uS�uS�uT�uT�uT�uT�uT�vT�wT�vT�vT�uT�tS�mR�tS�uT�uS�tS�rS�pR�mR�kQ�hQ�eP�aP�^O\N{ZNvXNqUMpTMnSMlRM�P%\�\�\�\� B#C*E$.E- .!G$Y:%d<"SFJYIKZIKNCJ\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�PDJZIK_LKdNLgPLjQLlRMnSMpTMqUMuWMyYN�\O�`O�cP�fP�hQ�jQ�mR�oR�qS�rS�rS�rS�mR�rS�sS�tS�tS�tS�tS�tS�tS�tS�tS�tS�tS�tS�tS�tS�tS�tS�sS�sS�sS�sS�sS�sS�sS�sS�sS�tS�tS�tS�tS�tS�tS�tS�tS�tS�tS�tS�tS�tS�tS�tS�tS�uS
!C+E'0F.4F7%8%U/lG.SFJZIK]KKZIKB=H\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�REJZJK`LKdNLgPLjQLlRMnSMpTMqUMtWMxXN{ZN~[N�]O�^O�`O�aO�bP�dP�gQ�iQ�kQ�lR�nR�pS�rS�sS�tT�uT�vT�wT�xT�yT�yT�yT�yT�yT�xT�vT�rS�nR�hQ�|U�|U�|U�|U�|U�|U�|U�|U�|U�|U�|U�|U�|U�|U�}U�}U�}U�}U�}U�}U�}U�~U�~U�~V�~V�VŀWƁX�a(�lR�rS�vT�yT�zU�|U�~V�XƂ[Ɇ_΋dӑjԓmԓnБlʌhĆd��_�{[�vW�sU�pS�nR�kR�iQ�hQ�gQ�fQ�eP�dP�bP�aO�_O�^O�\O|ZNxXNsVMpTMnTMmSMjQL�C B)D&/F-3F47G6%>"Y7 kA$YIK]KK^KKSFJ\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�VGJ\KKbMLeOLhPLkRLmSMnTMpTMrUMuWNyYN|ZN\N�]O�_O�`O�aP�bP�cP�eP�fP�hQ�jQ�lR�nR�oS�qT�sT�uU�vU�wV�xV�yV�yU�zU�zU�{U�{U�{U�|U�|U�|U�|U�|U�{U�{U�{U�zU�zT�yT�yT�xT�wT�vT�vT�vT�vT�wT�wT�wT�xT�yT�zT�zU�{U�{U�|U�|U�}U�VŀWǂYɄ\͈_ьdٔl�u�|쩂ſt명榁ޟ{՗sˎl†d�^�yZ�uW�qU�oS�lR�kR�jQ�iQ�hQ�gQ�fQ�eP�dP�cP�aP�`O�^O�]O}[NyYNuWMpTMoTMmSMkRLgPL&D#.E,3F46G;'<(D"iB(VGJ]KK`LK[JKB>H\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�NCJYIK^LKcNLfOLiQLkRMmSMoTMqUMsVMvXNzYN}[N�\O�^O�_O�`O�aP�cP�dP�eP�fQ�gQ�hQ�iQ�kR�mS�oT�rU�tW�wY�zZ�}\�]��^��^��^‚^\��Z�Y�X�~W�~W�~V�~V�~V�~V�~U�~U�~U�~U�U�U�V�V�V�V�VƀVƀVǀWǁWȂXɃZ˅[͇^ЊaӍdؒiܗn�t�z�����������������驅�~֘vˏmÇf��`�z[�vX�rU�pT�oS�nS�lR�kR�kR�jQ�iQ�hQ�fQ�eP�dP�cP�bP�`O�_O�]O~[NzYNvWNpTMoTMnSMkRMhQLo7,2F36G99HC+@ ]8 nA"\JK`ML_LKSFJ\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�SFJ[JK`LKdNLgPLjQLlRMnSMpTMqUMtVMwXNzZN}[N�]O�^O�_O�aO�bP�cP�dP�eP�fQ�gQ�hQ�iQ�jR�lR�mS�oU�rW�vZ�{]��a��fŊjˏnГqӕsՖsՖrՖqՔoӒmяjύg͊cˈaɆ^Ȅ\ǂ[ƁYŀXŀW�W�W�V�V�WŀWƀWǁXȂYɃ[ʅ\͇_ϊaҍeՑhٕmݙq�v�z�}꧀멃몄騃奀ߠ|ٛwӕȑmƉh��c�~^�yZ�vX�tW�sV�qU�pT�oS�nS�mR�lR�kR�jQ�iQ�hQ�gQ�fP�eP�cP�bP�aO�_O�^O\N{ZNwXNsVMoTMnSMlRMiQL~I#26G99G?<HA*E$	i@$ZIKaMLbML[JK;:H\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�WHJ]KKbMLeOLhPLjRLlSMnTMpTMrUMuWMxXN{ZN~\N�]O�^O�`O�aO�bP�cP�dP�eP�fQ�gQ�hQ�iQ�kR�lS�mT�oU�rW�uZ�y]�~a��fŠl˒sԚzܡ�㧆諉뮋������묈訄�~ߞyڙt֕oҐjΌfˈbȅ_ƃ\ŁZĀY�X�W�~W�~W�~W�XÀXĀYŁZƃ\Dž^Ɇ`ˈb̊d͋f΍gΎiΎjΎj͎jˌiljgÆd��a�^�}]�|\�{[�yZ�xY�vX�tW�sV�qU�pT�oS�nS�mR�lR�kR�jQ�iQ�hQ�gQ�fP�eP�dP�bP�aO�_O�^O�\O|ZNxXNtVMpTMnSMmSMjQLgPL99G?<HG-E&b;!YIK`MLdOM`LKNCJ\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\
S)?*%.�hQ�hQ�eP�`OuWM\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�SFJ[JK`LKdNLgPLjQLlRMnSMoTMqUMsVMwXNzYN}[N�\O�^O�_O�`O�aP�bP�dP�eP�fP�gQ�hQ�iQ�jR�kR�lS�nT�pV�sX�vZ�z^�b��gËmʒsјz؟�ޤ�㩊譍ꯏ및ꯎ謋娇ं۞|֙wѓq̎lljgÅb��_�\�}Z�{X�zW�yV�yU�xU�xU�xT�xT�xU�xU�xU�yV�yV�yW�zW�{X�{Y�|Z�}[�}[�}\�~\�~]�~]�}]�|\�{\�z[�yZ�wY�vX�tW�sV�rU�pT�oS�nS�mR�lR�kR�jQ�iQ�hQ�gQ�fQ�eP�dP�cP�bP�`O�_O�]O~[NzZNvWNrUMoTMmSMlRMiQLeOLJAIJ(h>!]KKfQOgQN_LKD>I\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\��iQ�tS�yT�{U�YΌeרּ���՗u�|\�Z'�L�D |>�eP�oR�qS�oR�mR�jQ�eP�^OhPL\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�WHJ\KKaMLeOLhPLjQLlRMnSMpTMqUMtVMwXNzZN}[N�]O�^O�_O�`O�bP�cP�dP�eP�fQ�gQ�hQ�iQ�jR�kR�mS�nT�qV�sX�w[�{_��c��hČn˒tҙz؟�ޥ�㩉筍ꯎꯎꮍ竊䧆ߣ�۞|՘vГpˎkljfÅb��_�\�}Y�{X�zW�yV�xU�xU�xT�xT�xT�xU�xU�xU�xU�yV�yV�zW�zX�{Y�|Y�|Z�}[�}[�}\�}\�}\�}\�|\�{[�zZ�yZ�wY�vX�tW�sV�rU�pT�oS�nS�mR�lR�kR�jQ�iQ�hQ�gQ�fQ�eP�dP�cP�bP�`O�_O�^O\N{ZNwXNsVMoTMnSMlRMiQLfOLJ(V.]KKePNkUQcNLQEJ\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\��]O�mR�qS�rS�tS�vT�wT�xU�{WĆbғqךxʏo
�K�rS�vT�wT�vT�uT�sS�qS�nR�kQ�gQ�`OuWNY,\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�NCJYIK^KKbNLfOLhQLkRLmSMoTMpUMrUMuWMxXN{ZN~[N�]O�^O�_O�aO�bP�cP�dP�eP�fQ�gQ�hQ�iQ�jR�kR�mS�oT�qV�tX�w[�|_��d��iČn˓tҙz؟�ޥ�㩉笌鮎ꮎ魌檉㧅ߢ�ڝ{՗uϒpˍjƈf…b��^�\�|Y�{X�zV�yV�xU�xU�xT�xT�xT�xU�xU�xU�xU�yV�yV�yW�zW�{X�{Y�|Z�|Z�|[�}[�}\�}\�|\�|[�{[�zZ�xY�wX�vX�tW�sV�rU�pT�oS�nS�mR�lR�kR�jQ�jQ�iQ�hQ�gQ�fP�dP�cP�bP�aO�_O�^O�\O|ZNxXNtVMoTMnSMlRMjQLgPLzG#\JKcOMoXUgPMZIK\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\��fP�gQ�gQ�hQ�iQ�kQ�lR�nR�pR�qS�sS�tS:"r<zYN�sS�yT�|U�~WƄ^ˊeˋgƈe��a�z[�tV�pS�mR�kQ�gQ�bPzYNkRL\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�RFJZJK`LKcNLfPLiQLkRMmSMoTMqUMrVMvWNyYN|ZN\N�]O�^O�`O�aO�bP�cP�dP�eP�fQ�gQ�hQ�iQ�jR�lR�mS�oU�qV�tY�x\�|`��d��iōo˓uҙ{ٟ�ޥ�㩉笌鮍鮍謋婈⦄ޡٜzԗtϑoʌjƈe„a��^�~[�|Y�{X�zV�yV�xU�xU�xT�xT�xT�xT�xU�xU�xU�xV�yV�yW�zW�zX�{Y�{Y�|Z�|Z�|[�|[�|[�|[�{[�z[�yZ�xY�wX�vW�tW�sV�rU�pT�oS�nS�mR�lR�kR�kR�jQ�iQ�hQ�gQ�fP�eP�dP�bP�aP�`O�^O�]O}[NyYNuWNqUMnSMlSMkRLhPLcNLbNLpYVlUP`LK>;H\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\��jQ�`O{ZN�^'�^'�`(�e)�h)�k*�o+�b(�nR�yT�~UǁXҍd�w��詅ݟ}Ԙvȍm��e�}_�x[�y\�x[�tW�qT�mR�jQ�gQ�bP}[NlRM\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�VGJ\JKaMKdNLgPLjQLlRMnSMpTMqUMsVMvXNzYN|[N\O�]O�_O�`O�aP�bP�cP�dP�eP�fQ�gQ�hQ�iQ�jR�lS�mS�oU�rW�uY�x\�|`��d��jōo̓uҚ{٠�ޥ�㩉欋譍譌竊婇᥃ݠ~؛yӖtΑoʌjňe„a��^�~[�|Y�{W�zV�yV�xU�xU�xT�xT�xT�xT�xU�xU�xU�xU�xV�yV�yW�zX�zX�{Y�{Z�{Z�|Z�|[�|[�{[�{[�zZ�yZ�xY�wX�uW�tV�sV�rU�pT�oS�nS�mR�lR�kR�kR�jQ�iQ�hQ�gQ�fQ�eP�dP�cP�aP�`O�^O�]O~[NzYNvWNrUMnSMmSMkRLiQLeOLoXUu]XdOLKBI\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�:9H\N�hQ�}\�uU�sT�tT�tS�qS�nR�nR�nR�lR�jQ�iQ�hQ�hQ�gQ�fQ�eP�eP�hQ�kR�mS�pU�tX�uY�sW�qU�mS�jQ�gQ�B�S%jQL\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�LBIXHK^KKbMLeOLhPLjRLlSMnSMpTMqUMtVMwXNzYN}[N�\O�^O�_O�`O�aP�bP�cP�eP�fP�fQ�gQ�hQ�iR�kR�lS�nT�pU�rW�uY�y]�}`��e��jŎp̔vӚ{٠�ޤ�⨉櫋笌笋櫊䨆ंܟ~ךxҕsΐnɌiŇe��a��^�~[�|Y�{W�yV�yV�xU�xU�xT�wT�wT�wT�xT�xU�xU�xU�xV�yV�yW�zW�zX�zY�{Y�{Z�{Z�{Z�{Z�{Z�zZ�yZ�yY�xY�vX�uW�tV�sU�rU�pT�oS�nS�mR�lR�lR�kR�jQ�iQ�hQ�gQ�fQ�eP�dP�cP�aP�`O�_O�]O\N{ZNwXNsVMnSMmSMkRMiQLfOL_LKhQMUGJ\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\� (6BFP>=DKHMqjk�trwf`~kc�nd�qe�se�te��{�w`�v[\N�_O�cP�fP�iQ�jR�lS�oT�qV�qV�oT�lR�iQ�^�`O�Q%hPL\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�QEJZIK_LKcNLfOLiQLkRLmSMoTMpUMrUMuWMxXN{ZN~[N�]O�^O�_O�`O�aP�cP�dP�eP�fP�gQ�hQ�iQ�jR�kR�lS�nT�pU�rW�uZ�y]�}a��e��kƎp̔vӚ{ٟ�ޤ�⨈媊櫋櫊婈⦅ߣ�۞}֚xѕr͐mȋićd��a��]�~[�|Y�zW�yV�yU�xU�xU�wT�wT�wT�wT�wT�xU�xU�xU�xU�xV�yV�yW�zX�zX�zY�zY�{Y�{Z�{Z�zZ�zZ�yY�xY�wX�vX�uW�tV�sU�rU�pT�oS�nS�mS�mR�lR�kR�jQ�iQ�hQ�gQ�fQ�eP�dP�cP�bP�`O�_O�]O\O|ZNxXNtVMoTMmSMlRMjQLgPLbML[JK\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�%5 (6$/79CEEKjgkrc_��{�uf��{�w_��q�]O�`O�cP�fQ�hQ�jR�lR�nT�oT�nT�kR�hQ�dP�]'�Q%\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�\�UGJ[JK`MKdNLgPLiQLkRMmSMoTMqUMrUMuWNxXN{ZN~[N�]O
 &3#.$-% .% .& /&!,#,#@70A71XNHXNHWNHWNHZRLYQLYQLXQLWQLWPLUOLSNLQMKOLJMJJ0//.-.,,-&(+"(!'			15;6CT37=MMMKMP^ad_enY`hNZlNZlU\dV\e���������������������������������DQbDQbDQbDQbDQbMUc����yl��|�oiKo���ኯኯኯኯኯኯዯዯዯዯዯዯዯዯዯ�Ko�Ko�Ko�Ko�Ko�Ko�Ko�Kp�Kp�Kp�Kp�Kp�Kp�Kp�Kp�Kp�Kp�Kp�Kp�Kp�Kp�Kp�Kp���⋯⋯⋯�Lp�Lp�Lp�Lp�Lp�Lp�Lp�Lp�Lp�Lp�Lp�Lp�Lp�Lp�Lp�Lp�Lp�Lp�Lp�Lp�Lp���ڄ�ڄ�ڄ�ڄ�ڄ�ۄ�ۄ�ۄ�ۄ�ۄ�ۄ�ۄ�ۄ�ۄ�ۅ�ۅ�ۅ�ۅ�ۅ�ۅ��Gk�Gk�Gk�Gk�Gk�Gk�Gk�Gk�Gk���ۅ�܅�܅�܅�܅�܅�܅�܅�܅�܅�܅�܅�܆�܆�܆�܆�܆��Hl�Hl�Hl�Hl�Hl�Hl�Hl�Hl�Hl�Hl�Hl�Hl�Hl�'K}'K}'K}'K}'K}'K}'K}'K}'K}HO\=J[=J[=J[ -> ,> ,>(.7#)2#)2(.7(.7(.7#)2(.7(.7(/7(/7)/8/28114H7,[email protected]&,5$&)$$$######"""(((8888888888888884"nO9�gX�jZE/ (-" 
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




























































Changes to library/demos/items.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# items.tcl --
#
# This demonstration script creates a canvas that displays the
# canvas item types.
#
# SCCS: @(#) items.tcl 1.16 97/03/02 16:25:05

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .items
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# items.tcl --
#
# This demonstration script creates a canvas that displays the
# canvas item types.
#
# RCS: @(#) $Id: items.tcl,v 1.1.4.1 1998/09/30 02:17:49 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .items
catch {destroy $w}

Changes to library/demos/ixset.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# ixset --
# A nice interface to "xset" to change X server settings
#
# History :
#   91/11/23 : [email protected], [email protected] : design
#   92/08/01 : [email protected] : cleaning
#
# SCCS: @(#) ixset 1.7 96/02/16 10:49:19

#
# Button actions
#

proc quit {} {
    destroy .











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# ixset --
# A nice interface to "xset" to change X server settings
#
# History :
#   91/11/23 : [email protected], [email protected] : design
#   92/08/01 : [email protected] : cleaning
#
# RCS: @(#) $Id: ixset,v 1.1.4.1 1998/09/30 02:17:49 stanton Exp $

#
# Button actions
#

proc quit {} {
    destroy .

Changes to library/demos/label.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# label.tcl --
#
# This demonstration script creates a toplevel window containing
# several label widgets.
#
# SCCS: @(#) label.tcl 1.7 97/03/02 16:25:27

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .label
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# label.tcl --
#
# This demonstration script creates a toplevel window containing
# several label widgets.
#
# RCS: @(#) $Id: label.tcl,v 1.1.4.1 1998/09/30 02:17:49 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .label
catch {destroy $w}

Changes to library/demos/menu.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# menu.tcl --
#
# This demonstration script creates a window with a bunch of menus
# and cascaded menus using menubars.
#
# SCCS: @(#) menu.tcl 1.17 97/06/26 15:45:04

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .menu
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# menu.tcl --
#
# This demonstration script creates a window with a bunch of menus
# and cascaded menus using menubars.
#
# RCS: @(#) $Id: menu.tcl,v 1.1.4.1 1998/09/30 02:17:50 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .menu
catch {destroy $w}

Changes to library/demos/menubu.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# menubutton.tcl --
#
# This demonstration script creates a window with a bunch of menus
# and cascaded menus using menubuttons.
#
# # SCCS: @(#) menubu.tcl 1.9 97/06/19 18:11:06

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .menubutton
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# menubutton.tcl --
#
# This demonstration script creates a window with a bunch of menus
# and cascaded menus using menubuttons.
#
# # RCS: @(#) $Id: menubu.tcl,v 1.1.4.1 1998/09/30 02:17:50 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .menubutton
catch {destroy $w}

Changes to library/demos/msgbox.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# msgbox.tcl --
#
# This demonstration script creates message boxes of various type
#
# SCCS: @(#) msgbox.tcl 1.3 97/03/02 16:26:07

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .msgbox
catch {destroy $w}




|







1
2
3
4
5
6
7
8
9
10
11
12
# msgbox.tcl --
#
# This demonstration script creates message boxes of various type
#
# RCS: @(#) $Id: msgbox.tcl,v 1.1.4.1 1998/09/30 02:17:50 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .msgbox
catch {destroy $w}

Changes to library/demos/plot.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# plot.tcl --
#
# This demonstration script creates a canvas widget showing a 2-D
# plot with data points that can be dragged with the mouse.
#
# SCCS: @(#) plot.tcl 1.5 97/03/02 16:26:19

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .plot
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# plot.tcl --
#
# This demonstration script creates a canvas widget showing a 2-D
# plot with data points that can be dragged with the mouse.
#
# RCS: @(#) $Id: plot.tcl,v 1.1.4.1 1998/09/30 02:17:51 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .plot
catch {destroy $w}

Changes to library/demos/puzzle.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# puzzle.tcl --
#
# This demonstration script creates a 15-puzzle game using a collection
# of buttons.
#
# SCCS: @(#) puzzle.tcl 1.5 97/03/02 16:26:32

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# puzzleSwitch --
# This procedure is invoked when the user clicks on a particular button;





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# puzzle.tcl --
#
# This demonstration script creates a 15-puzzle game using a collection
# of buttons.
#
# RCS: @(#) $Id: puzzle.tcl,v 1.1.4.1 1998/09/30 02:17:51 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# puzzleSwitch --
# This procedure is invoked when the user clicks on a particular button;

Changes to library/demos/radio.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# radio.tcl --
#
# This demonstration script creates a toplevel window containing
# several radiobutton widgets.
#
# SCCS: @(#) radio.tcl 1.5 97/03/02 16:26:57

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .radio
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# radio.tcl --
#
# This demonstration script creates a toplevel window containing
# several radiobutton widgets.
#
# RCS: @(#) $Id: radio.tcl,v 1.1.4.1 1998/09/30 02:17:51 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .radio
catch {destroy $w}

Changes to library/demos/rmt.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# rmt --
# This script implements a simple remote-control mechanism for
# Tk applications.  It allows you to select an application and
# then type commands to that application.
#
# SCCS: @(#) rmt 1.10 96/06/24 16:42:38

wm title . "Tk Remote Controller"
wm iconname . "Tk Remote"
wm minsize . 1 1

# The global variable below keeps track of the remote application
# that we're sending to.  If it's an empty string then we execute









|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# rmt --
# This script implements a simple remote-control mechanism for
# Tk applications.  It allows you to select an application and
# then type commands to that application.
#
# RCS: @(#) $Id: rmt,v 1.1.4.1 1998/09/30 02:17:52 stanton Exp $

wm title . "Tk Remote Controller"
wm iconname . "Tk Remote"
wm minsize . 1 1

# The global variable below keeps track of the remote application
# that we're sending to.  If it's an empty string then we execute

Changes to library/demos/rolodex.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# rolodex --
# This script was written as an entry in Tom LaStrange's rolodex
# benchmark.  It creates something that has some of the look and
# feel of a rolodex program, although it's lifeless and doesn't
# actually do the rolodex application.
#
# SCCS: @(#) rolodex 1.7 96/02/16 10:49:23

foreach i [winfo child .] {
    catch {destroy $i}
}

#------------------------------------------
# Phase 0: create the front end.










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# rolodex --
# This script was written as an entry in Tom LaStrange's rolodex
# benchmark.  It creates something that has some of the look and
# feel of a rolodex program, although it's lifeless and doesn't
# actually do the rolodex application.
#
# RCS: @(#) $Id: rolodex,v 1.1.4.1 1998/09/30 02:17:52 stanton Exp $

foreach i [winfo child .] {
    catch {destroy $i}
}

#------------------------------------------
# Phase 0: create the front end.

Changes to library/demos/ruler.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# ruler.tcl --
#
# This demonstration script creates a canvas widget that displays a ruler
# with tab stops that can be set, moved, and deleted.
#
# SCCS: @(#) ruler.tcl 1.9 97/03/02 16:17:33

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# rulerMkTab --
# This procedure creates a new triangular polygon in a canvas to





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# ruler.tcl --
#
# This demonstration script creates a canvas widget that displays a ruler
# with tab stops that can be set, moved, and deleted.
#
# RCS: @(#) $Id: ruler.tcl,v 1.1.4.1 1998/09/30 02:17:53 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# rulerMkTab --
# This procedure creates a new triangular polygon in a canvas to

Changes to library/demos/sayings.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# sayings.tcl --
#
# This demonstration script creates a listbox that can be scrolled
# both horizontally and vertically.  It displays a collection of
# well-known sayings.
#
# SCCS: @(#) sayings.tcl 1.7 97/03/02 16:27:10

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .sayings
catch {destroy $w}






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# sayings.tcl --
#
# This demonstration script creates a listbox that can be scrolled
# both horizontally and vertically.  It displays a collection of
# well-known sayings.
#
# RCS: @(#) $Id: sayings.tcl,v 1.1.4.1 1998/09/30 02:17:53 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .sayings
catch {destroy $w}

Changes to library/demos/search.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# search.tcl --
#
# This demonstration script creates a collection of widgets that
# allow you to load a file into a text widget, then perform searches
# on that file.
#
# SCCS: @(#) search.tcl 1.5 97/03/02 16:27:25

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# textLoadFile --
# This procedure below loads a file into a text widget, discarding






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# search.tcl --
#
# This demonstration script creates a collection of widgets that
# allow you to load a file into a text widget, then perform searches
# on that file.
#
# RCS: @(#) $Id: search.tcl,v 1.1.4.1 1998/09/30 02:17:53 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

# textLoadFile --
# This procedure below loads a file into a text widget, discarding

Changes to library/demos/square.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# square --
# This script generates a demo application containing only a "square"
# widget.  It's only usable in the "tktest" application or if Tk has
# been compiled with tkSquare.c. This demo arranges the following
# bindings for the widget:
# 
# Button-1 press/drag:		moves square to mouse
# "a":				toggle size animation on/off
#
# SCCS: @(#) square 1.7 97/02/24 16:42:31

square .s
pack .s -expand yes -fill both
wm minsize . 1 1

bind .s <1> {center %x %y}
bind .s <B1-Motion> {center %x %y}













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# square --
# This script generates a demo application containing only a "square"
# widget.  It's only usable in the "tktest" application or if Tk has
# been compiled with tkSquare.c. This demo arranges the following
# bindings for the widget:
# 
# Button-1 press/drag:		moves square to mouse
# "a":				toggle size animation on/off
#
# RCS: @(#) $Id: square,v 1.1.4.1 1998/09/30 02:17:54 stanton Exp $

square .s
pack .s -expand yes -fill both
wm minsize . 1 1

bind .s <1> {center %x %y}
bind .s <B1-Motion> {center %x %y}

Changes to library/demos/states.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# states.tcl --
#
# This demonstration script creates a listbox widget that displays
# the names of the 50 states in the United States of America.
#
# SCCS: @(#) states.tcl 1.4 97/03/02 16:27:37

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .states
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# states.tcl --
#
# This demonstration script creates a listbox widget that displays
# the names of the 50 states in the United States of America.
#
# RCS: @(#) $Id: states.tcl,v 1.1.4.1 1998/09/30 02:17:54 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .states
catch {destroy $w}

Changes to library/demos/style.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# style.tcl --
#
# This demonstration script creates a text widget that illustrates the
# various display styles that may be set for tags.
#
# SCCS: @(#) style.tcl 1.8 97/04/18 11:41:47

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .style
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# style.tcl --
#
# This demonstration script creates a text widget that illustrates the
# various display styles that may be set for tags.
#
# RCS: @(#) $Id: style.tcl,v 1.1.4.2 1998/09/30 02:17:54 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .style
catch {destroy $w}

Changes to library/demos/tcolor.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# tcolor --
# This script implements a simple color editor, where you can
# create colors using either the RGB, HSB, or CYM color spaces
# and apply the color to existing applications.
#
# SCCS: @(#) tcolor 1.11 96/06/24 16:43:11

wm title . "Color Editor"

# Global variables that control the program:
#
# colorSpace -			Color space currently being used for
#				editing.  Must be "rgb", "cmy", or "hsb".









|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# tcolor --
# This script implements a simple color editor, where you can
# create colors using either the RGB, HSB, or CYM color spaces
# and apply the color to existing applications.
#
# RCS: @(#) $Id: tcolor,v 1.1.4.1 1998/09/30 02:17:55 stanton Exp $

wm title . "Color Editor"

# Global variables that control the program:
#
# colorSpace -			Color space currently being used for
#				editing.  Must be "rgb", "cmy", or "hsb".

Changes to library/demos/text.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# text.tcl --
#
# This demonstration script creates a text widget that describes
# the basic editing functions.
#
# SCCS: @(#) text.tcl 1.6 97/03/02 16:28:12

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .text
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# text.tcl --
#
# This demonstration script creates a text widget that describes
# the basic editing functions.
#
# RCS: @(#) $Id: text.tcl,v 1.1.4.1 1998/09/30 02:17:55 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .text
catch {destroy $w}

Changes to library/demos/timer.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# timer --
# This script generates a counter with start and stop buttons.
#
# SCCS: @(#) timer 1.6 96/02/16 10:49:20

label .counter -text 0.00 -relief raised -width 10
button .start -text Start -command {
    if $stopped {
	set stopped 0
	tick
    }







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# timer --
# This script generates a counter with start and stop buttons.
#
# RCS: @(#) $Id: timer,v 1.1.4.1 1998/09/30 02:17:56 stanton Exp $

label .counter -text 0.00 -relief raised -width 10
button .start -text Start -command {
    if $stopped {
	set stopped 0
	tick
    }

Changes to library/demos/twind.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# twind.tcl --
#
# This demonstration script creates a text widget with a bunch of
# embedded windows.
#
# SCCS: @(#) twind.tcl 1.7 97/03/02 16:28:22

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .twind
catch {destroy $w}





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# twind.tcl --
#
# This demonstration script creates a text widget with a bunch of
# embedded windows.
#
# RCS: @(#) $Id: twind.tcl,v 1.1.4.1 1998/09/30 02:17:56 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .twind
catch {destroy $w}

Changes to library/demos/vscale.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# vscale.tcl --
#
# This demonstration script shows an example with a vertical scale.
#
# SCCS: @(#) vscale.tcl 1.4 97/03/02 16:28:34

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .vscale
catch {destroy $w}




|







1
2
3
4
5
6
7
8
9
10
11
12
# vscale.tcl --
#
# This demonstration script shows an example with a vertical scale.
#
# RCS: @(#) $Id: vscale.tcl,v 1.1.4.1 1998/09/30 02:17:56 stanton Exp $

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

set w .vscale
catch {destroy $w}

Changes to library/demos/widget.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# widget --
# This script demonstrates the various widgets provided by Tk,
# along with many of the features of the Tk toolkit.  This file
# only contains code to generate the main window for the
# application, which invokes individual demonstrations.  The
# code for the actual demonstrations is contained in separate
# ".tcl" files is this directory, which are sourced by this script
# as needed.
#
# SCCS: @(#) widget 1.35 97/07/19 15:42:22

eval destroy [winfo child .]
wm title . "Widget Demonstration"
set widgetDemo 1

#----------------------------------------------------------------
# The code below create the main window, consisting of a menu bar













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# widget --
# This script demonstrates the various widgets provided by Tk,
# along with many of the features of the Tk toolkit.  This file
# only contains code to generate the main window for the
# application, which invokes individual demonstrations.  The
# code for the actual demonstrations is contained in separate
# ".tcl" files is this directory, which are sourced by this script
# as needed.
#
# RCS: @(#) $Id: widget,v 1.1.4.1 1998/09/30 02:17:57 stanton Exp $

eval destroy [winfo child .]
wm title . "Widget Demonstration"
set widgetDemo 1

#----------------------------------------------------------------
# The code below create the main window, consisting of a menu bar

Changes to library/dialog.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# dialog.tcl --
#
# This file defines the procedure tk_dialog, which creates a dialog
# box containing a bitmap, a message, and one or more buttons.
#
# SCCS: @(#) dialog.tcl 1.33 97/06/06 11:20:04
#
# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# dialog.tcl --
#
# This file defines the procedure tk_dialog, which creates a dialog
# box containing a bitmap, a message, and one or more buttons.
#
# RCS: @(#) $Id: dialog.tcl,v 1.1.4.3 1999/04/06 03:52:52 stanton Exp $
#
# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
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

    # The following command means that the dialog won't be posted if
    # [winfo parent $w] is iconified, but it's really needed;  otherwise
    # the dialog can become obscured by other windows in the application,
    # even though its grab keeps the rest of the application from being used.

    wm transient $w [winfo toplevel [winfo parent $w]]
    if {$tcl_platform(platform) == "macintosh"} {
	unsupported1 style $w dBoxProc
    }

    frame $w.bot
    frame $w.top
    if {$tcl_platform(platform) == "unix"} {
	$w.bot configure -relief raised -bd 1
	$w.top configure -relief raised -bd 1
    }
    pack $w.bot -side bottom -fill both
    pack $w.top -side top -fill both -expand 1

    # 2. Fill the top part with bitmap and message (use the option
    # database for -wraplength so that it can be overridden by
    # the caller).

    option add *Dialog.msg.wrapLength 3i widgetDefault
    label $w.msg -justify left -text $text
    if {$tcl_platform(platform) == "macintosh"} {
	$w.msg configure -font system
    } else {
	$w.msg configure -font {Times 18}
    }


    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
    if {$bitmap != ""} {
	if {($tcl_platform(platform) == "macintosh") && ($bitmap == "error")} {
	    set bitmap "stop"
	}
	label $w.bitmap -bitmap $bitmap
	pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
    }

    # 3. Create a row of buttons at the bottom of the dialog.

    set i 0
    foreach but $args {
	button $w.button$i -text $but -command "set tkPriv(button) $i"
	if {$i == $default} {
	    $w.button$i configure -default active
	} else {
	    $w.button$i configure -default normal
	}
	grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew -padx 10
	grid columnconfigure $w.bot $i
	# We boost the size of some Mac buttons for l&f
	if {$tcl_platform(platform) == "macintosh"} {
	    set tmp [string tolower $but]
	    if {($tmp == "ok") || ($tmp == "cancel")} {
		grid columnconfigure $w.bot $i -minsize [expr 59 + 20]
	    }
	}
	incr i
    }

    # 4. Create a binding for <Return> on the dialog if there is a
    # default button.

    if {$default >= 0} {
	bind $w <Return> "
	    $w.button$default configure -state active -relief sunken
	    update idletasks
	    after 100
	    set tkPriv(button) $default
	"
    }

    # 5. Create a <Destroy> binding for the window that sets the
    # button variable to -1;  this is needed in case something happens
    # that destroys the window, such as its parent window being destroyed.

    bind $w <Destroy> {set tkPriv(button) -1}

    # 6. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w

    # 7. Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current $w]
    if {$oldGrab != ""} {
	set grabStatus [grab status $oldGrab]
    }
    grab $w
    if {$default >= 0} {
	focus $w.button$default
    } else {
	focus $w







|





|







|
|


<
|
|

|

>
>

|
|



















|

|











|


















|
|
|
|







|







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

    # The following command means that the dialog won't be posted if
    # [winfo parent $w] is iconified, but it's really needed;  otherwise
    # the dialog can become obscured by other windows in the application,
    # even though its grab keeps the rest of the application from being used.

    wm transient $w [winfo toplevel [winfo parent $w]]
    if {![string compare $tcl_platform(platform) "macintosh"]} {
	unsupported1 style $w dBoxProc
    }

    frame $w.bot
    frame $w.top
    if {![string compare $tcl_platform(platform) "unix"]} {
	$w.bot configure -relief raised -bd 1
	$w.top configure -relief raised -bd 1
    }
    pack $w.bot -side bottom -fill both
    pack $w.top -side top -fill both -expand 1

    # 2. Fill the top part with bitmap and message (use the option
    # database for -wraplength and -font so that they can be
    # overridden by the caller).

    option add *Dialog.msg.wrapLength 3i widgetDefault

    if {![string compare $tcl_platform(platform) "macintosh"]} {
	option add *Dialog.msg.font system widgetDefault
    } else {
	option add *Dialog.msg.font {Times 18} widgetDefault
    }

    label $w.msg -justify left -text $text
    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
    if {[string compare $bitmap ""]} {
      if {![string compare $tcl_platform(platform) "macintosh"] && ![string compare $bitmap "error"]} {
	    set bitmap "stop"
	}
	label $w.bitmap -bitmap $bitmap
	pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
    }

    # 3. Create a row of buttons at the bottom of the dialog.

    set i 0
    foreach but $args {
	button $w.button$i -text $but -command "set tkPriv(button) $i"
	if {$i == $default} {
	    $w.button$i configure -default active
	} else {
	    $w.button$i configure -default normal
	}
	grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew -padx 10
	grid columnconfigure $w.bot $i
	# We boost the size of some Mac buttons for l&f
      if {![string compare $tcl_platform(platform) "macintosh"]} {
	    set tmp [string tolower $but]
          if {![string compare $tmp "ok"] || ![string compare $tmp "cancel"]} {
		grid columnconfigure $w.bot $i -minsize [expr 59 + 20]
	    }
	}
	incr i
    }

    # 4. Create a binding for <Return> on the dialog if there is a
    # default button.

    if {$default >= 0} {
	bind $w <Return> "
          [list $w.button$default] configure -state active -relief sunken
	    update idletasks
	    after 100
	    set tkPriv(button) $default
	"
    }

    # 5. Create a <Destroy> binding for the window that sets the
    # button variable to -1;  this is needed in case something happens
    # that destroys the window, such as its parent window being destroyed.

    bind $w <Destroy> {set tkPriv(button) -1}

    # 6. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]}]
    set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]}]
    wm geom $w +$x+$y
    wm deiconify $w

    # 7. Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current $w]
    if {[string compare $oldGrab ""]} {
	set grabStatus [grab status $oldGrab]
    }
    grab $w
    if {$default >= 0} {
	focus $w.button$default
    } else {
	focus $w
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
	# It's possible that the window has already been destroyed,
	# hence this "catch".  Delete the Destroy handler so that
	# tkPriv(button) doesn't get reset by it.

	bind $w <Destroy> {}
	destroy $w
    }
    if {$oldGrab != ""} {
	if {$grabStatus == "global"} {
	    grab -global $oldGrab
	} else {
	    grab $oldGrab
	}
    }
    return $tkPriv(button)
}







|
|
|
|
|




160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
	# It's possible that the window has already been destroyed,
	# hence this "catch".  Delete the Destroy handler so that
	# tkPriv(button) doesn't get reset by it.

	bind $w <Destroy> {}
	destroy $w
    }
    if {[string compare $oldGrab ""]} {
      if {[string compare $grabStatus "global"]} {
	    grab $oldGrab
      } else {
          grab -global $oldGrab
	}
    }
    return $tkPriv(button)
}

Changes to library/entry.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# entry.tcl --
#
# This file defines the default bindings for Tk entry widgets and provides
# procedures that help in implementing those bindings.
#
# SCCS: @(#) entry.tcl 1.49 97/09/17 19:08:48
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# entry.tcl --
#
# This file defines the default bindings for Tk entry widgets and provides
# procedures that help in implementing those bindings.
#
# RCS: @(#) $Id: entry.tcl,v 1.1.4.4 1999/04/06 03:52:53 stanton Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
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
# x, y -		Last known mouse coordinates for scanning
#			and auto-scanning.
#-------------------------------------------------------------------------

#-------------------------------------------------------------------------
# The code below creates the default class bindings for entries.
#-------------------------------------------------------------------------

bind Entry <<Cut>> {
    if {![catch {set data [string range [%W get] [%W index sel.first]\
		 [expr [%W index sel.last] - 1]]}]} {
	clipboard clear -displayof %W
	clipboard append -displayof %W $data
	%W delete sel.first sel.last
    }
}
bind Entry <<Copy>> {
    if {![catch {set data [string range [%W get] [%W index sel.first]\
		 [expr [%W index sel.last] - 1]]}]} {
	clipboard clear -displayof %W
	clipboard append -displayof %W $data
    }
}
bind Entry <<Paste>> {
    global tcl_platform
    catch {
	if {"$tcl_platform(platform)" != "unix"} {
	    catch {
		%W delete sel.first sel.last
	    }
	}
	%W insert insert [selection get -displayof %W -selection CLIPBOARD]
	tkEntrySeeInsert %W
    }
}
bind Entry <<Clear>> {
    %W delete sel.first sel.last





}

# Standard Motif bindings:

bind Entry <1> {
    tkEntryButton1 %W %x
    %W selection clear







<

|
<






|
<







|










>
>
>
>
>







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
# x, y -		Last known mouse coordinates for scanning
#			and auto-scanning.
#-------------------------------------------------------------------------

#-------------------------------------------------------------------------
# The code below creates the default class bindings for entries.
#-------------------------------------------------------------------------

bind Entry <<Cut>> {
    if {![catch {set data [tkEntryGetSelection %W]}]} {

	clipboard clear -displayof %W
	clipboard append -displayof %W $data
	%W delete sel.first sel.last
    }
}
bind Entry <<Copy>> {
    if {![catch {set data [tkEntryGetSelection %W]}]} {

	clipboard clear -displayof %W
	clipboard append -displayof %W $data
    }
}
bind Entry <<Paste>> {
    global tcl_platform
    catch {
      if {[string compare $tcl_platform(platform) "unix"]} {
	    catch {
		%W delete sel.first sel.last
	    }
	}
	%W insert insert [selection get -displayof %W -selection CLIPBOARD]
	tkEntrySeeInsert %W
    }
}
bind Entry <<Clear>> {
    %W delete sel.first sel.last
}
bind Entry <<PasteSelection>> {
    if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
	tkEntryPaste %W %x
    }
}

# Standard Motif bindings:

bind Entry <1> {
    tkEntryButton1 %W %x
    %W selection clear
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
}
bind Entry <ButtonRelease-1> {
    tkCancelRepeat
}
bind Entry <Control-1> {
    %W icursor @%x
}
bind Entry <ButtonRelease-2> {
    if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
	tkEntryPaste %W %x
    }
}

bind Entry <Left> {
    tkEntrySetCursor %W [expr [%W index insert] - 1]
}
bind Entry <Right> {
    tkEntrySetCursor %W [expr [%W index insert] + 1]
}
bind Entry <Shift-Left> {
    tkEntryKeySelect %W [expr [%W index insert] - 1]
    tkEntrySeeInsert %W
}
bind Entry <Shift-Right> {
    tkEntryKeySelect %W [expr [%W index insert] + 1]
    tkEntrySeeInsert %W
}
bind Entry <Control-Left> {
    tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
}
bind Entry <Control-Right> {
    tkEntrySetCursor %W [tkEntryNextWord %W insert]







<
<
<
|
<
<

|


|


|



|







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
}
bind Entry <ButtonRelease-1> {
    tkCancelRepeat
}
bind Entry <Control-1> {
    %W icursor @%x
}






bind Entry <Left> {
    tkEntrySetCursor %W [expr {[%W index insert] - 1}]
}
bind Entry <Right> {
    tkEntrySetCursor %W [expr {[%W index insert] + 1}]
}
bind Entry <Shift-Left> {
    tkEntryKeySelect %W [expr {[%W index insert] - 1}]
    tkEntrySeeInsert %W
}
bind Entry <Shift-Right> {
    tkEntryKeySelect %W [expr {[%W index insert] + 1}]
    tkEntrySeeInsert %W
}
bind Entry <Control-Left> {
    tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
}
bind Entry <Control-Right> {
    tkEntrySetCursor %W [tkEntryNextWord %W insert]
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
}
bind Entry <Shift-End> {
    tkEntryKeySelect %W end
    tkEntrySeeInsert %W
}

bind Entry <Delete> {
    if [%W selection present] {
	%W delete sel.first sel.last
    } else {
	%W delete insert
    }
}
bind Entry <BackSpace> {
    tkEntryBackspace %W







|







151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
}
bind Entry <Shift-End> {
    tkEntryKeySelect %W end
    tkEntrySeeInsert %W
}

bind Entry <Delete> {
    if {[%W selection present]} {
	%W delete sel.first sel.last
    } else {
	%W delete insert
    }
}
bind Entry <BackSpace> {
    tkEntryBackspace %W
198
199
200
201
202
203
204
205
206
207
208



209
210

211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
bind Entry <Alt-KeyPress> {# nothing}
bind Entry <Meta-KeyPress> {# nothing}
bind Entry <Control-KeyPress> {# nothing}
bind Entry <Escape> {# nothing}
bind Entry <Return> {# nothing}
bind Entry <KP_Enter> {# nothing}
bind Entry <Tab> {# nothing}
if {$tcl_platform(platform) == "macintosh"} {
	bind Entry <Command-KeyPress> {# nothing}
}




bind Entry <Insert> {
    catch {tkEntryInsert %W [selection get -displayof %W]}

}

# Additional emacs-like bindings:

bind Entry <Control-a> {
    if !$tk_strictMotif {
	tkEntrySetCursor %W 0
    }
}
bind Entry <Control-b> {
    if !$tk_strictMotif {
	tkEntrySetCursor %W [expr [%W index insert] - 1]
    }
}
bind Entry <Control-d> {
    if !$tk_strictMotif {
	%W delete insert
    }
}
bind Entry <Control-e> {
    if !$tk_strictMotif {
	tkEntrySetCursor %W end
    }
}
bind Entry <Control-f> {
    if !$tk_strictMotif {
	tkEntrySetCursor %W [expr [%W index insert] + 1]
    }
}
bind Entry <Control-h> {
    if !$tk_strictMotif {
	tkEntryBackspace %W
    }
}
bind Entry <Control-k> {
    if !$tk_strictMotif {
	%W delete insert end
    }
}
bind Entry <Control-t> {
    if !$tk_strictMotif {
	tkEntryTranspose %W
    }
}
bind Entry <Meta-b> {
    if !$tk_strictMotif {
	tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
    }
}
bind Entry <Meta-d> {
    if !$tk_strictMotif {
	%W delete insert [tkEntryNextWord %W insert]
    }
}
bind Entry <Meta-f> {
    if !$tk_strictMotif {
	tkEntrySetCursor %W [tkEntryNextWord %W insert]
    }
}
bind Entry <Meta-BackSpace> {
    if !$tk_strictMotif {
	%W delete [tkEntryPreviousWord %W insert] insert
    }
}
bind Entry <Meta-Delete> {
    if !$tk_strictMotif {
	%W delete [tkEntryPreviousWord %W insert] insert
    }
}

# A few additional bindings of my own.

bind Entry <2> {
    if !$tk_strictMotif {
	%W scan mark %x
	set tkPriv(x) %x
	set tkPriv(y) %y
	set tkPriv(mouseMoved) 0
    }
}
bind Entry <B2-Motion> {
    if !$tk_strictMotif {
	if {abs(%x-$tkPriv(x)) > 2} {
	    set tkPriv(mouseMoved) 1
	}
	%W scan dragto %x
    }
}








|



>
>
>
|
|
>





|




|
|



|




|




|
|



|




|




|




|




|




|




|




|







|







|







195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
bind Entry <Alt-KeyPress> {# nothing}
bind Entry <Meta-KeyPress> {# nothing}
bind Entry <Control-KeyPress> {# nothing}
bind Entry <Escape> {# nothing}
bind Entry <Return> {# nothing}
bind Entry <KP_Enter> {# nothing}
bind Entry <Tab> {# nothing}
if {![string compare $tcl_platform(platform) "macintosh"]} {
	bind Entry <Command-KeyPress> {# nothing}
}

# On Windows, paste is done using Shift-Insert.  Shift-Insert already
# generates the <<Paste>> event, so we don't need to do anything here.
if {[string compare $tcl_platform(platform) "windows"]} {
    bind Entry <Insert> {
	catch {tkEntryInsert %W [selection get -displayof %W]}
    }
}

# Additional emacs-like bindings:

bind Entry <Control-a> {
    if {!$tk_strictMotif} {
	tkEntrySetCursor %W 0
    }
}
bind Entry <Control-b> {
    if {!$tk_strictMotif} {
	tkEntrySetCursor %W [expr {[%W index insert] - 1}]
    }
}
bind Entry <Control-d> {
    if {!$tk_strictMotif} {
	%W delete insert
    }
}
bind Entry <Control-e> {
    if {!$tk_strictMotif} {
	tkEntrySetCursor %W end
    }
}
bind Entry <Control-f> {
    if {!$tk_strictMotif} {
	tkEntrySetCursor %W [expr {[%W index insert] + 1}]
    }
}
bind Entry <Control-h> {
    if {!$tk_strictMotif} {
	tkEntryBackspace %W
    }
}
bind Entry <Control-k> {
    if {!$tk_strictMotif} {
	%W delete insert end
    }
}
bind Entry <Control-t> {
    if {!$tk_strictMotif} {
	tkEntryTranspose %W
    }
}
bind Entry <Meta-b> {
    if {!$tk_strictMotif} {
	tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
    }
}
bind Entry <Meta-d> {
    if {!$tk_strictMotif} {
	%W delete insert [tkEntryNextWord %W insert]
    }
}
bind Entry <Meta-f> {
    if {!$tk_strictMotif} {
	tkEntrySetCursor %W [tkEntryNextWord %W insert]
    }
}
bind Entry <Meta-BackSpace> {
    if {!$tk_strictMotif} {
	%W delete [tkEntryPreviousWord %W insert] insert
    }
}
bind Entry <Meta-Delete> {
    if {!$tk_strictMotif} {
	%W delete [tkEntryPreviousWord %W insert] insert
    }
}

# A few additional bindings of my own.

bind Entry <2> {
    if {!$tk_strictMotif} {
	%W scan mark %x
	set tkPriv(x) %x
	set tkPriv(y) %y
	set tkPriv(mouseMoved) 0
    }
}
bind Entry <B2-Motion> {
    if {!$tk_strictMotif} {
	if {abs(%x-$tkPriv(x)) > 2} {
	    set tkPriv(mouseMoved) 1
	}
	%W scan dragto %x
    }
}

328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
    global tkPriv

    set tkPriv(selectMode) char
    set tkPriv(mouseMoved) 0
    set tkPriv(pressX) $x
    $w icursor [tkEntryClosestGap $w $x]
    $w selection from insert
    if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
}

# tkEntryMouseSelect --
# This procedure is invoked when dragging out a selection with
# the mouse.  Depending on the selection mode (character, word,
# line) it selects in different-sized units.  This procedure
# ignores mouse motions initially until the mouse has moved from







|







329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
    global tkPriv

    set tkPriv(selectMode) char
    set tkPriv(mouseMoved) 0
    set tkPriv(pressX) $x
    $w icursor [tkEntryClosestGap $w $x]
    $w selection from insert
    if {![string compare [$w cget -state] "normal"]} {focus $w}
}

# tkEntryMouseSelect --
# This procedure is invoked when dragging out a selection with
# the mouse.  Depending on the selection mode (character, word,
# line) it selects in different-sized units.  This procedure
# ignores mouse motions initially until the mouse has moved from
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
    set cur [tkEntryClosestGap $w $x]
    set anchor [$w index anchor]
    if {($cur != $anchor) || (abs($tkPriv(pressX) - $x) >= 3)} {
	set tkPriv(mouseMoved) 1
    }
    switch $tkPriv(selectMode) {
	char {
	    if $tkPriv(mouseMoved) {
		if {$cur < $anchor} {
		    $w selection range $cur $anchor
		} elseif {$cur > $anchor} {
		    $w selection range $anchor $cur
		} else {
		    $w selection clear
		}
	    }
	}
	word {
	    if {$cur < [$w index anchor]} {
		set before [tcl_wordBreakBefore [$w get] $cur]
		set after [tcl_wordBreakAfter [$w get] [expr $anchor-1]]
	    } else {
		set before [tcl_wordBreakBefore [$w get] $anchor]
		set after [tcl_wordBreakAfter [$w get] [expr $cur - 1]]
	    }
	    if {$before < 0} {
		set before 0
	    }
	    if {$after < 0} {
		set after end
	    }







|












|


|







353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
    set cur [tkEntryClosestGap $w $x]
    set anchor [$w index anchor]
    if {($cur != $anchor) || (abs($tkPriv(pressX) - $x) >= 3)} {
	set tkPriv(mouseMoved) 1
    }
    switch $tkPriv(selectMode) {
	char {
	    if {$tkPriv(mouseMoved)} {
		if {$cur < $anchor} {
		    $w selection range $cur $anchor
		} elseif {$cur > $anchor} {
		    $w selection range $anchor $cur
		} else {
		    $w selection clear
		}
	    }
	}
	word {
	    if {$cur < [$w index anchor]} {
		set before [tcl_wordBreakBefore [$w get] $cur]
		set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
	    } else {
		set before [tcl_wordBreakBefore [$w get] $anchor]
		set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
	    }
	    if {$before < 0} {
		set before 0
	    }
	    if {$after < 0} {
		set after end
	    }
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
# x -		X position of the mouse.

proc tkEntryPaste {w x} {
    global tkPriv

    $w icursor [tkEntryClosestGap $w $x]
    catch {$w insert insert [selection get -displayof $w]}
    if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
}

# tkEntryAutoScan --
# This procedure is invoked when the mouse leaves an entry window
# with button 1 down.  It scrolls the window left or right,
# depending on where the mouse is, and reschedules itself as an
# "after" command so that the window continues to scroll until the







|







399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
# x -		X position of the mouse.

proc tkEntryPaste {w x} {
    global tkPriv

    $w icursor [tkEntryClosestGap $w $x]
    catch {$w insert insert [selection get -displayof $w]}
    if {![string compare [$w cget -state] "normal"]} {focus $w}
}

# tkEntryAutoScan --
# This procedure is invoked when the mouse leaves an entry window
# with button 1 down.  It scrolls the window left or right,
# depending on where the mouse is, and reschedules itself as an
# "after" command so that the window continues to scroll until the
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
#
# Arguments:
# w -		The entry window.
# new -		A new position for the insertion cursor (the cursor hasn't
#		actually been moved to this position yet).

proc tkEntryKeySelect {w new} {
    if ![$w selection present] {
	$w selection from insert
	$w selection to $new
    } else {
	$w selection adjust $new
    }
    $w icursor $new
}

# tkEntryInsert --
# Insert a string into an entry at the point of the insertion cursor.
# If there is a selection in the entry, and it covers the point of the
# insertion cursor, then delete the selection before inserting.
#
# Arguments:
# w -		The entry window in which to insert the string
# s -		The string to insert (usually just a single character)

proc tkEntryInsert {w s} {
    if {$s == ""} {
	return
    }
    catch {
	set insert [$w index insert]
	if {([$w index sel.first] <= $insert)
		&& ([$w index sel.last] >= $insert)} {
	    $w delete sel.first sel.last







|


















|







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
#
# Arguments:
# w -		The entry window.
# new -		A new position for the insertion cursor (the cursor hasn't
#		actually been moved to this position yet).

proc tkEntryKeySelect {w new} {
    if {![$w selection present]} {
	$w selection from insert
	$w selection to $new
    } else {
	$w selection adjust $new
    }
    $w icursor $new
}

# tkEntryInsert --
# Insert a string into an entry at the point of the insertion cursor.
# If there is a selection in the entry, and it covers the point of the
# insertion cursor, then delete the selection before inserting.
#
# Arguments:
# w -		The entry window in which to insert the string
# s -		The string to insert (usually just a single character)

proc tkEntryInsert {w s} {
    if {![string compare $s ""]} {
	return
    }
    catch {
	set insert [$w index insert]
	if {([$w index sel.first] <= $insert)
		&& ([$w index sel.last] >= $insert)} {
	    $w delete sel.first sel.last
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
# If backspacing would move the cursor off the left edge of the
# window, reposition the cursor at about the middle of the window.
#
# Arguments:
# w -		The entry window in which to backspace.

proc tkEntryBackspace w {
    if [$w selection present] {
	$w delete sel.first sel.last
    } else {
	set x [expr {[$w index insert] - 1}]
	if {$x >= 0} {$w delete $x}
	if {[$w index @0] >= [$w index insert]} {
	    set range [$w xview]
	    set left [lindex $range 0]
	    set right [lindex $range 1]
	    $w xview moveto [expr $left - ($right - $left)/2.0]
	}
    }
}

# tkEntrySeeInsert --
# Make sure that the insertion cursor is visible in the entry window.
# If not, adjust the view so that it is.







|








|







479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
# If backspacing would move the cursor off the left edge of the
# window, reposition the cursor at about the middle of the window.
#
# Arguments:
# w -		The entry window in which to backspace.

proc tkEntryBackspace w {
    if {[$w selection present]} {
	$w delete sel.first sel.last
    } else {
	set x [expr {[$w index insert] - 1}]
	if {$x >= 0} {$w delete $x}
	if {[$w index @0] >= [$w index insert]} {
	    set range [$w xview]
	    set left [lindex $range 0]
	    set right [lindex $range 1]
	    $w xview moveto [expr {$left - ($right - $left)/2.0}]
	}
    }
}

# tkEntrySeeInsert --
# Make sure that the insertion cursor is visible in the entry window.
# If not, adjust the view so that it is.
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
# w -		The entry window.

proc tkEntryTranspose w {
    set i [$w index insert]
    if {$i < [$w index end]} {
	incr i
    }
    set first [expr $i-2]
    if {$first < 0} {
	return
    }
    set new [string index [$w get] [expr $i-1]][string index [$w get] $first]
    $w delete $first $i
    $w insert insert $new
    tkEntrySeeInsert $w
}

# tkEntryNextWord --
# Returns the index of the next word position after a given position in the
# entry.  The next word is platform dependent and may be either the next
# end-of-word position or the next start-of-word position after the next
# end-of-word position.
#
# Arguments:
# w -		The entry window in which the cursor is to move.
# start -	Position at which to start search.

if {$tcl_platform(platform) == "windows"}  {
    proc tkEntryNextWord {w start} {
	set pos [tcl_endOfWord [$w get] [$w index $start]]
	if {$pos >= 0} {
	    set pos [tcl_startOfNextWord [$w get] $pos]
	}
	if {$pos < 0} {
	    return end







|



|















|







544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
# w -		The entry window.

proc tkEntryTranspose w {
    set i [$w index insert]
    if {$i < [$w index end]} {
	incr i
    }
    set first [expr {$i-2}]
    if {$first < 0} {
	return
    }
    set new [string index [$w get] [expr {$i-1}]][string index [$w get] $first]
    $w delete $first $i
    $w insert insert $new
    tkEntrySeeInsert $w
}

# tkEntryNextWord --
# Returns the index of the next word position after a given position in the
# entry.  The next word is platform dependent and may be either the next
# end-of-word position or the next start-of-word position after the next
# end-of-word position.
#
# Arguments:
# w -		The entry window in which the cursor is to move.
# start -	Position at which to start search.

if {![string compare $tcl_platform(platform) "windows"]}  {
    proc tkEntryNextWord {w start} {
	set pos [tcl_endOfWord [$w get] [$w index $start]]
	if {$pos >= 0} {
	    set pos [tcl_startOfNextWord [$w get] $pos]
	}
	if {$pos < 0} {
	    return end
600
601
602
603
604
605
606

607













proc tkEntryPreviousWord {w start} {
    set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
    if {$pos < 0} {
	return 0
    }
    return $pos
}






















>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
proc tkEntryPreviousWord {w start} {
    set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
    if {$pos < 0} {
	return 0
    }
    return $pos
}
# tkEntryGetSelection --
#
# Returns the selected text of the entry with respect to the -show option.
#
# Arguments:
# w -         The entry window from which the text to get

proc tkEntryGetSelection {w} {
    set entryString [string range [$w get] [$w index sel.first] \
                       [expr [$w index sel.last] - 1]]
    if {[$w cget -show] != ""} {
      regsub -all . $entryString [string index [$w cget -show] 0] entryString
    }
    return $entryString
}

Changes to library/focus.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# focus.tcl --
#
# This file defines several procedures for managing the input
# focus.
#
# SCCS: @(#) focus.tcl 1.17 96/02/16 10:48:21
#
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#






|







1
2
3
4
5
6
7
8
9
10
11
12
13
# focus.tcl --
#
# This file defines several procedures for managing the input
# focus.
#
# RCS: @(#) $Id: focus.tcl,v 1.1.4.3 1999/04/06 03:52:54 stanton Exp $
#
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

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

	# Look for the next sibling that isn't a top-level.

	while 1 {
	    incr i
	    if {$i < [llength $children]} {
		set cur [lindex $children $i]
		if {[winfo toplevel $cur] == $cur} {
		    continue
		} else {
		    break
		}
	    }

	    # No more siblings, so go to the current widget's parent.
	    # If it's a top-level, break out of the loop, otherwise
	    # look for its next sibling.

	    set cur $parent
	    if {[winfo toplevel $cur] == $cur} {
		break
	    }
	    set parent [winfo parent $parent]
	    set children [winfo children $parent]
	    set i [lsearch -exact $children $cur]
	}
	if {($cur == $w) || [tkFocusOK $cur]} {
	    return $cur
	}
    }
}

# tk_focusPrev --
# This procedure returns the name of the previous window before "w" in







|











|






|







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

	# Look for the next sibling that isn't a top-level.

	while 1 {
	    incr i
	    if {$i < [llength $children]} {
		set cur [lindex $children $i]
              if {![string compare [winfo toplevel $cur] $cur]} {
		    continue
		} else {
		    break
		}
	    }

	    # No more siblings, so go to the current widget's parent.
	    # If it's a top-level, break out of the loop, otherwise
	    # look for its next sibling.

	    set cur $parent
          if {![string compare [winfo toplevel $cur] $cur]} {
		break
	    }
	    set parent [winfo parent $parent]
	    set children [winfo children $parent]
	    set i [lsearch -exact $children $cur]
	}
      if {![string compare $w $cur] || [tkFocusOK $cur]} {
	    return $cur
	}
    }
}

# tk_focusPrev --
# This procedure returns the name of the previous window before "w" in
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
proc tk_focusPrev w {
    set cur $w
    while 1 {

	# Collect information about the current window's position
	# among its siblings.  Also, if the window is a top-level,
	# then reposition to just after the last child of the window.
    
	if {[winfo toplevel $cur] == $cur}  {
	    set parent $cur
	    set children [winfo children $cur]
	    set i [llength $children]
	} else {
	    set parent [winfo parent $cur]
	    set children [winfo children $parent]
	    set i [lsearch -exact $children $cur]
	}

	# Go to the previous sibling, then descend to its last descendant
	# (highest in stacking order.  While doing this, ignore top-levels
	# and their descendants.  When we run out of descendants, go up
	# one level to the parent.

	while {$i > 0} {
	    incr i -1
	    set cur [lindex $children $i]
	    if {[winfo toplevel $cur] == $cur} {
		continue
	    }
	    set parent $cur
	    set children [winfo children $parent]
	    set i [llength $children]
	}
	set cur $parent
	if {($cur == $w) || [tkFocusOK $cur]} {
	    return $cur
	}
    }
}

# tkFocusOK --
#







|
|

















|







|







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
proc tk_focusPrev w {
    set cur $w
    while 1 {

	# Collect information about the current window's position
	# among its siblings.  Also, if the window is a top-level,
	# then reposition to just after the last child of the window.

      if {![string compare [winfo toplevel $cur] $cur]}  {
	    set parent $cur
	    set children [winfo children $cur]
	    set i [llength $children]
	} else {
	    set parent [winfo parent $cur]
	    set children [winfo children $parent]
	    set i [lsearch -exact $children $cur]
	}

	# Go to the previous sibling, then descend to its last descendant
	# (highest in stacking order.  While doing this, ignore top-levels
	# and their descendants.  When we run out of descendants, go up
	# one level to the parent.

	while {$i > 0} {
	    incr i -1
	    set cur [lindex $children $i]
          if {![string compare [winfo toplevel $cur] $cur]} {
		continue
	    }
	    set parent $cur
	    set children [winfo children $parent]
	    set i [llength $children]
	}
	set cur $parent
      if {![string compare $w $cur] || [tkFocusOK $cur]} {
	    return $cur
	}
    }
}

# tkFocusOK --
#
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
# bindings.  If all of these are true, then 1 is returned.
#
# Arguments:
# w -		Name of a window.

proc tkFocusOK w {
    set code [catch {$w cget -takefocus} value]
    if {($code == 0) && ($value != "")} {
	if {$value == 0} {
	    return 0
	} elseif {$value == 1} {
	    return [winfo viewable $w]
	} else {
	    set value [uplevel #0 $value $w]
	    if {$value != ""} {
		return $value
	    }
	}
    }
    if {![winfo viewable $w]} {
	return 0
    }
    set code [catch {$w cget -state} value]
    if {($code == 0) && ($value == "disabled")} {
	return 0
    }
    regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
}

# tk_focusFollowsMouse --
#
# If this procedure is invoked, Tk will enter "focus-follows-mouse"
# mode, where the focus is always on whatever window contains the
# mouse.  If this procedure isn't invoked, then the user typically
# has to click on a window to give it the focus.
#
# Arguments:
# None.

proc tk_focusFollowsMouse {} {
    set old [bind all <Enter>]
    set script {

	if {("%d" == "NotifyAncestor") || ("%d" == "NotifyNonlinear")
		|| ("%d" == "NotifyInferior")} {
	    if [tkFocusOK %W] {
		focus %W
	    }
	}
    }
    if {$old != ""} {
	bind all <Enter> "$old; $script"
    } else {
	bind all <Enter> $script
    }
}







|






|








|


















>
|
|
|
|
|


|





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
# bindings.  If all of these are true, then 1 is returned.
#
# Arguments:
# w -		Name of a window.

proc tkFocusOK w {
    set code [catch {$w cget -takefocus} value]
    if {($code == 0) && [string compare $value ""]} {
	if {$value == 0} {
	    return 0
	} elseif {$value == 1} {
	    return [winfo viewable $w]
	} else {
	    set value [uplevel #0 $value $w]
          if {[string compare $value ""]} {
		return $value
	    }
	}
    }
    if {![winfo viewable $w]} {
	return 0
    }
    set code [catch {$w cget -state} value]
    if {($code == 0) && ![string compare $value "disabled"]} {
	return 0
    }
    regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
}

# tk_focusFollowsMouse --
#
# If this procedure is invoked, Tk will enter "focus-follows-mouse"
# mode, where the focus is always on whatever window contains the
# mouse.  If this procedure isn't invoked, then the user typically
# has to click on a window to give it the focus.
#
# Arguments:
# None.

proc tk_focusFollowsMouse {} {
    set old [bind all <Enter>]
    set script {
      if {![string compare "%d" "NotifyAncestor"]
              || ![string compare "%d" "NotifyNonlinear"]
              || ![string compare "%d" "NotifyInferior"]} {
          if {[tkFocusOK %W]} {
              focus %W
          }
	}
    }
    if {[string compare $old ""]} {
	bind all <Enter> "$old; $script"
    } else {
	bind all <Enter> $script
    }
}

Changes to library/images/README.

1
2
3
4
5
6
7
8
9
10
README - images directory

SCCS: @(#) README 1.1 97/08/06 13:19:19


This directory includes images for the Tcl Logo and the Tcl Powered
Logo.  Please feel free to use the Tcl Powered Logo on any of your
products that employ the use of Tcl or Tk.  The Tcl logo may also be
used to promote Tcl in your product documentation, web site or other
places you so desire.


|







1
2
3
4
5
6
7
8
9
10
README - images directory

RCS: @(#) $Id: README,v 1.1.4.1 1998/09/30 02:17:57 stanton Exp $


This directory includes images for the Tcl Logo and the Tcl Powered
Logo.  Please feel free to use the Tcl Powered Logo on any of your
products that employ the use of Tcl or Tk.  The Tcl logo may also be
used to promote Tcl in your product documentation, web site or other
places you so desire.

Added library/images/logo.eps.























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
%!PS-Adobe-3.0 EPSF-3.0
%%Creator: Adobe Illustrator(TM) 5.5
%%For: (Bud Northern) (Mark Anderson Design)
%%Title: (TCL/TK LOGO.ILLUS)
%%CreationDate: (8/1/96) (4:58 PM)
%%BoundingBox: 251 331 371 512
%%HiResBoundingBox: 251.3386 331.5616 370.5213 511.775
%%DocumentProcessColors: Cyan Magenta Yellow
%%DocumentSuppliedResources: procset Adobe_level2_AI5 1.0 0
%%+ procset Adobe_IllustratorA_AI5 1.0 0
%AI5_FileFormat 1.2
%AI3_ColorUsage: Color
%%DocumentCustomColors: (TCL RED)
%%CMYKCustomColor: 0 0.45 1 0 (Orange)
%%+ 0 0.25 1 0 (Orange Yellow)
%%+ 0 0.79 0.91 0 (TCL RED)
%AI3_TemplateBox: 306 396 306 396
%AI3_TileBox: 12 12 600 780
%AI3_DocumentPreview: Macintosh_ColorPic
%AI5_ArtSize: 612 792
%AI5_RulerUnits: 0
%AI5_ArtFlags: 1 0 0 1 0 0 1 1 0
%AI5_TargetResolution: 800
%AI5_NumLayers: 1
%AI5_OpenToView: 90 576 2 938 673 18 1 1 2 40
%AI5_OpenViewLayers: 7
%%EndComments
%%BeginProlog
%%BeginResource: procset Adobe_level2_AI5 1.0 0
%%Title: (Adobe Illustrator (R) Version 5.0 Level 2 Emulation)
%%Version: 1.0 
%%CreationDate: (04/10/93) ()
%%Copyright: ((C) 1987-1993 Adobe Systems Incorporated All Rights Reserved)
userdict /Adobe_level2_AI5 21 dict dup begin
	put
	/packedarray where not
	{
		userdict begin
		/packedarray
		{
			array astore readonly
		} bind def
		/setpacking /pop load def
		/currentpacking false def
	 end
		0
	} if
	pop
	userdict /defaultpacking currentpacking put true setpacking
	/initialize
	{
		Adobe_level2_AI5 begin
	} bind def
	/terminate
	{
		currentdict Adobe_level2_AI5 eq
		{
		 end
		} if
	} bind def
	mark
	/setcustomcolor where not
	{
		/findcmykcustomcolor
		{
			5 packedarray
		} bind def
		/setcustomcolor
		{
			exch aload pop pop
			4
			{
				4 index mul 4 1 roll
			} repeat
			5 -1 roll pop
			setcmykcolor
		}
		def
	} if
	
	/gt38? mark {version cvx exec} stopped {cleartomark true} {38 gt exch pop} ifelse def
	userdict /deviceDPI 72 0 matrix defaultmatrix dtransform dup mul exch dup mul add sqrt put
	userdict /level2?
	systemdict /languagelevel known dup
	{
		pop systemdict /languagelevel get 2 ge
	} if
	put
	level2? not
	{
		/setcmykcolor where not
		{
			/setcmykcolor
			{
				exch .11 mul add exch .59 mul add exch .3 mul add
				1 exch sub setgray
			} def
		} if
		/currentcmykcolor where not
		{
			/currentcmykcolor
			{
				0 0 0 1 currentgray sub
			} def
		} if
		/setoverprint where not
		{
			/setoverprint /pop load def
		} if
		/selectfont where not
		{
			/selectfont
			{
				exch findfont exch
				dup type /arraytype eq
				{
					makefont
				}
				{
					scalefont
				} ifelse
				setfont
			} bind def
		} if
		/cshow where not
		{
			/cshow
			{
				[
				0 0 5 -1 roll aload pop
				] cvx bind forall
			} bind def
		} if
	} if
	cleartomark
	/anyColor?
	{
		add add add 0 ne
	} bind def
	/testColor
	{
		gsave
		setcmykcolor currentcmykcolor
		grestore
	} bind def
	/testCMYKColorThrough
	{
		testColor anyColor?
	} bind def
	userdict /composite?
	level2?
	{
		gsave 1 1 1 1 setcmykcolor currentcmykcolor grestore
		add add add 4 eq
	}
	{
		1 0 0 0 testCMYKColorThrough
		0 1 0 0 testCMYKColorThrough
		0 0 1 0 testCMYKColorThrough
		0 0 0 1 testCMYKColorThrough
		and and and
	} ifelse
	put
	composite? not
	{
		userdict begin
		gsave
		/cyan? 1 0 0 0 testCMYKColorThrough def
		/magenta? 0 1 0 0 testCMYKColorThrough def
		/yellow? 0 0 1 0 testCMYKColorThrough def
		/black? 0 0 0 1 testCMYKColorThrough def
		grestore
		/isCMYKSep? cyan? magenta? yellow? black? or or or def
		/customColor? isCMYKSep? not def
	 end
	} if
 end defaultpacking setpacking
%%EndResource
%%BeginResource: procset Adobe_IllustratorA_AI5 1.1 0
%%Title: (Adobe Illustrator (R) Version 5.0 Abbreviated Prolog)
%%Version: 1.1 
%%CreationDate: (3/7/1994) ()
%%Copyright: ((C) 1987-1994 Adobe Systems Incorporated All Rights Reserved)
currentpacking true setpacking
userdict /Adobe_IllustratorA_AI5_vars 70 dict dup begin
put
/_lp /none def
/_pf
{
} def
/_ps
{
} def
/_psf
{
} def
/_pss
{
} def
/_pjsf
{
} def
/_pjss
{
} def
/_pola 0 def
/_doClip 0 def
/cf currentflat def
/_tm matrix def
/_renderStart
[
/e0 /r0 /a0 /o0 /e1 /r1 /a1 /i0
] def
/_renderEnd
[
null null null null /i1 /i1 /i1 /i1
] def
/_render -1 def
/_rise 0 def
/_ax 0 def
/_ay 0 def
/_cx 0 def
/_cy 0 def
/_leading
[
0 0
] def
/_ctm matrix def
/_mtx matrix def
/_sp 16#020 def
/_hyphen (-) def
/_fScl 0 def
/_cnt 0 def
/_hs 1 def
/_nativeEncoding 0 def
/_useNativeEncoding 0 def
/_tempEncode 0 def
/_pntr 0 def
/_tDict 2 dict def
/_wv 0 def
/Tx
{
} def
/Tj
{
} def
/CRender
{
} def
/_AI3_savepage
{
} def
/_gf null def
/_cf 4 array def
/_if null def
/_of false def
/_fc
{
} def
/_gs null def
/_cs 4 array def
/_is null def
/_os false def
/_sc
{
} def
/discardSave null def
/buffer 256 string def
/beginString null def
/endString null def
/endStringLength null def
/layerCnt 1 def
/layerCount 1 def
/perCent (%) 0 get def
/perCentSeen? false def
/newBuff null def
/newBuffButFirst null def
/newBuffLast null def
/clipForward? false def
end
userdict /Adobe_IllustratorA_AI5 74 dict dup begin
put
/initialize
{
	Adobe_IllustratorA_AI5 dup begin
	Adobe_IllustratorA_AI5_vars begin
	discardDict
	{
		bind pop pop
	} forall
	dup /nc get begin
	{
		dup xcheck 1 index type /operatortype ne and
		{
			bind
		} if
		pop pop
	} forall
 end
	newpath
} def
/terminate
{
 end
 end
} def
/_
null def
/ddef
{
	Adobe_IllustratorA_AI5_vars 3 1 roll put
} def
/xput
{
	dup load dup length exch maxlength eq
	{
		dup dup load dup
		length 2 mul dict copy def
	} if
	load begin
	def
 end
} def
/npop
{
	{
		pop
	} repeat
} def
/sw
{
	dup length exch stringwidth
	exch 5 -1 roll 3 index mul add
	4 1 roll 3 1 roll mul add
} def
/swj
{
	dup 4 1 roll
	dup length exch stringwidth
	exch 5 -1 roll 3 index mul add
	4 1 roll 3 1 roll mul add
	6 2 roll /_cnt 0 ddef
	{
		1 index eq
		{
			/_cnt _cnt 1 add ddef
		} if
	} forall
	pop
	exch _cnt mul exch _cnt mul 2 index add 4 1 roll 2 index add 4 1 roll pop pop
} def
/ss
{
	4 1 roll
	{
		2 npop
		(0) exch 2 copy 0 exch put pop
		gsave
		false charpath currentpoint
		4 index setmatrix
		stroke
		grestore
		moveto
		2 copy rmoveto
	} exch cshow
	3 npop
} def
/jss
{
	4 1 roll
	{
		2 npop
		(0) exch 2 copy 0 exch put
		gsave
		_sp eq
		{
			exch 6 index 6 index 6 index 5 -1 roll widthshow
			currentpoint
		}
		{
			false charpath currentpoint
			4 index setmatrix stroke
		} ifelse
		grestore
		moveto
		2 copy rmoveto
	} exch cshow
	6 npop
} def
/sp
{
	{
		2 npop (0) exch
		2 copy 0 exch put pop
		false charpath
		2 copy rmoveto
	} exch cshow
	2 npop
} def
/jsp
{
	{
		2 npop
		(0) exch 2 copy 0 exch put
		_sp eq
		{
			exch 5 index 5 index 5 index 5 -1 roll widthshow
		}
		{
			false charpath
		} ifelse
		2 copy rmoveto
	} exch cshow
	5 npop
} def
/pl
{
	transform
	0.25 sub round 0.25 add exch
	0.25 sub round 0.25 add exch
	itransform
} def
/setstrokeadjust where
{
	pop true setstrokeadjust
	/c
	{
		curveto
	} def
	/C
	/c load def
	/v
	{
		currentpoint 6 2 roll curveto
	} def
	/V
	/v load def
	/y
	{
		2 copy curveto
	} def
	/Y
	/y load def
	/l
	{
		lineto
	} def
	/L
	/l load def
	/m
	{
		moveto
	} def
}
{
	/c
	{
		pl curveto
	} def
	/C
	/c load def
	/v
	{
		currentpoint 6 2 roll pl curveto
	} def
	/V
	/v load def
	/y
	{
		pl 2 copy curveto
	} def
	/Y
	/y load def
	/l
	{
		pl lineto
	} def
	/L
	/l load def
	/m
	{
		pl moveto
	} def
} ifelse
/d
{
	setdash
} def
/cf
{
} def
/i
{
	dup 0 eq
	{
		pop cf
	} if
	setflat
} def
/j
{
	setlinejoin
} def
/J
{
	setlinecap
} def
/M
{
	setmiterlimit
} def
/w
{
	setlinewidth
} def
/H
{
} def
/h
{
	closepath
} def
/N
{
	_pola 0 eq
	{
		_doClip 1 eq
		{
			clip /_doClip 0 ddef
		} if
		newpath
	}
	{
		/CRender
		{
			N
		} ddef
	} ifelse
} def
/n
{
	N
} def
/F
{
	_pola 0 eq
	{
		_doClip 1 eq
		{
			gsave _pf grestore clip newpath /_lp /none ddef _fc
			/_doClip 0 ddef
		}
		{
			_pf
		} ifelse
	}
	{
		/CRender
		{
			F
		} ddef
	} ifelse
} def
/f
{
	closepath
	F
} def
/S
{
	_pola 0 eq
	{
		_doClip 1 eq
		{
			gsave _ps grestore clip newpath /_lp /none ddef _sc
			/_doClip 0 ddef
		}
		{
			_ps
		} ifelse
	}
	{
		/CRender
		{
			S
		} ddef
	} ifelse
} def
/s
{
	closepath
	S
} def
/B
{
	_pola 0 eq
	{
		_doClip 1 eq
		gsave F grestore
		{
			gsave S grestore clip newpath /_lp /none ddef _sc
			/_doClip 0 ddef
		}
		{
			S
		} ifelse
	}
	{
		/CRender
		{
			B
		} ddef
	} ifelse
} def
/b
{
	closepath
	B
} def
/W
{
	/_doClip 1 ddef
} def
/*
{
	count 0 ne
	{
		dup type /stringtype eq
		{
			pop
		} if
	} if
	newpath
} def
/u
{
} def
/U
{
} def
/q
{
	_pola 0 eq
	{
		gsave
	} if
} def
/Q
{
	_pola 0 eq
	{
		grestore
	} if
} def
/*u
{
	_pola 1 add /_pola exch ddef
} def
/*U
{
	_pola 1 sub /_pola exch ddef
	_pola 0 eq
	{
		CRender
	} if
} def
/D
{
	pop
} def
/*w
{
} def
/*W
{
} def
/`
{
	/_i save ddef
	clipForward?
	{
		nulldevice
	} if
	6 1 roll 4 npop
	concat pop
	userdict begin
	/showpage
	{
	} def
	0 setgray
	0 setlinecap
	1 setlinewidth
	0 setlinejoin
	10 setmiterlimit
	[] 0 setdash
	/setstrokeadjust where {pop false setstrokeadjust} if
	newpath
	0 setgray
	false setoverprint
} def
/~
{
 end
	_i restore
} def
/O
{
	0 ne
	/_of exch ddef
	/_lp /none ddef
} def
/R
{
	0 ne
	/_os exch ddef
	/_lp /none ddef
} def
/g
{
	/_gf exch ddef
	/_fc
	{
		_lp /fill ne
		{
			_of setoverprint
			_gf setgray
			/_lp /fill ddef
		} if
	} ddef
	/_pf
	{
		_fc
		fill
	} ddef
	/_psf
	{
		_fc
		ashow
	} ddef
	/_pjsf
	{
		_fc
		awidthshow
	} ddef
	/_lp /none ddef
} def
/G
{
	/_gs exch ddef
	/_sc
	{
		_lp /stroke ne
		{
			_os setoverprint
			_gs setgray
			/_lp /stroke ddef
		} if
	} ddef
	/_ps
	{
		_sc
		stroke
	} ddef
	/_pss
	{
		_sc
		ss
	} ddef
	/_pjss
	{
		_sc
		jss
	} ddef
	/_lp /none ddef
} def
/k
{
	_cf astore pop
	/_fc
	{
		_lp /fill ne
		{
			_of setoverprint
			_cf aload pop setcmykcolor
			/_lp /fill ddef
		} if
	} ddef
	/_pf
	{
		_fc
		fill
	} ddef
	/_psf
	{
		_fc
		ashow
	} ddef
	/_pjsf
	{
		_fc
		awidthshow
	} ddef
	/_lp /none ddef
} def
/K
{
	_cs astore pop
	/_sc
	{
		_lp /stroke ne
		{
			_os setoverprint
			_cs aload pop setcmykcolor
			/_lp /stroke ddef
		} if
	} ddef
	/_ps
	{
		_sc
		stroke
	} ddef
	/_pss
	{
		_sc
		ss
	} ddef
	/_pjss
	{
		_sc
		jss
	} ddef
	/_lp /none ddef
} def
/x
{
	/_gf exch ddef
	findcmykcustomcolor
	/_if exch ddef
	/_fc
	{
		_lp /fill ne
		{
			_of setoverprint
			_if _gf 1 exch sub setcustomcolor
			/_lp /fill ddef
		} if
	} ddef
	/_pf
	{
		_fc
		fill
	} ddef
	/_psf
	{
		_fc
		ashow
	} ddef
	/_pjsf
	{
		_fc
		awidthshow
	} ddef
	/_lp /none ddef
} def
/X
{
	/_gs exch ddef
	findcmykcustomcolor
	/_is exch ddef
	/_sc
	{
		_lp /stroke ne
		{
			_os setoverprint
			_is _gs 1 exch sub setcustomcolor
			/_lp /stroke ddef
		} if
	} ddef
	/_ps
	{
		_sc
		stroke
	} ddef
	/_pss
	{
		_sc
		ss
	} ddef
	/_pjss
	{
		_sc
		jss
	} ddef
	/_lp /none ddef
} def
/A
{
	pop
} def
/annotatepage
{
userdict /annotatepage 2 copy known {get exec} {pop pop} ifelse
} def
/discard
{
	save /discardSave exch store
	discardDict begin
	/endString exch store
	gt38?
	{
		2 add
	} if
	load
	stopped
	pop
 end
	discardSave restore
} bind def
userdict /discardDict 7 dict dup begin
put
/pre38Initialize
{
	/endStringLength endString length store
	/newBuff buffer 0 endStringLength getinterval store
	/newBuffButFirst newBuff 1 endStringLength 1 sub getinterval store
	/newBuffLast newBuff endStringLength 1 sub 1 getinterval store
} def
/shiftBuffer
{
	newBuff 0 newBuffButFirst putinterval
	newBuffLast 0
	currentfile read not
	{
	stop
	} if
	put
} def
0
{
	pre38Initialize
	mark
	currentfile newBuff readstring exch pop
	{
		{
			newBuff endString eq
			{
				cleartomark stop
			} if
			shiftBuffer
		} loop
	}
	{
	stop
	} ifelse
} def
1
{
	pre38Initialize
	/beginString exch store
	mark
	currentfile newBuff readstring exch pop
	{
		{
			newBuff beginString eq
			{
				/layerCount dup load 1 add store
			}
			{
				newBuff endString eq
				{
					/layerCount dup load 1 sub store
					layerCount 0 eq
					{
						cleartomark stop
					} if
				} if
			} ifelse
			shiftBuffer
		} loop
	}
	{
	stop
	} ifelse
} def
2
{
	mark
	{
		currentfile buffer readline not
		{
		stop
		} if
		endString eq
		{
			cleartomark stop
		} if
	} loop
} def
3
{
	/beginString exch store
	/layerCnt 1 store
	mark
	{
		currentfile buffer readline not
		{
		stop
		} if
		dup beginString eq
		{
			pop /layerCnt dup load 1 add store
		}
		{
			endString eq
			{
				layerCnt 1 eq
				{
					cleartomark stop
				}
				{
					/layerCnt dup load 1 sub store
				} ifelse
			} if
		} ifelse
	} loop
} def
end
userdict /clipRenderOff 15 dict dup begin
put
{
	/n /N /s /S /f /F /b /B
}
{
	{
		_doClip 1 eq
		{
			/_doClip 0 ddef clip
		} if
		newpath
	} def
} forall
/Tr /pop load def
/Bb {} def
/BB /pop load def
/Bg {12 npop} def
/Bm {6 npop} def
/Bc /Bm load def
/Bh {4 npop} def
end
/Lb
{
	4 npop
	6 1 roll
	pop
	4 1 roll
	pop pop pop
	0 eq
	{
		0 eq
		{
			(%AI5_BeginLayer) 1 (%AI5_EndLayer--) discard
		}
		{
			/clipForward? true def
			
			/Tx /pop load def
			/Tj /pop load def
			currentdict end clipRenderOff begin begin
		} ifelse
	}
	{
		0 eq
		{
			save /discardSave exch store
		} if
	} ifelse
} bind def
/LB
{
	discardSave dup null ne
	{
		restore
	}
	{
		pop
		clipForward?
		{
			currentdict
		 end
		 end
		 begin
			
			/clipForward? false ddef
		} if
	} ifelse
} bind def
/Pb
{
	pop pop
	0 (%AI5_EndPalette) discard
} bind def
/Np
{
	0 (%AI5_End_NonPrinting--) discard
} bind def
/Ln /pop load def
/Ap
/pop load def
/Ar
{
	72 exch div
	0 dtransform dup mul exch dup mul add sqrt
	dup 1 lt
	{
		pop 1
	} if
	setflat
} def
/Mb
{
	q
} def
/Md
{
} def
/MB
{
	Q
} def
/nc 3 dict def
nc begin
/setgray
{
	pop
} bind def
/setcmykcolor
{
	4 npop
} bind def
/setcustomcolor
{
	2 npop
} bind def
currentdict readonly pop
end
currentdict readonly pop
end
setpacking
%%EndResource
%%EndProlog
%%BeginSetup
Adobe_level2_AI5 /initialize get exec
Adobe_IllustratorA_AI5 /initialize get exec
%AI5_Begin_NonPrinting
Np
%AI3_BeginPattern: (Yellow Stripe)
(Yellow Stripe) 8.4499 4.6 80.4499 76.6 [
%AI3_Tile
(0 O 0 R 0 0.4 1 0 k 0 0.4 1 0 K) @
(
800 Ar
0 J 0 j 3.6 w 4 M []0 d
%AI3_Note:
0 D
8.1999 8.1999 m
80.6999 8.1999 L
S
8.1999 22.6 m
80.6999 22.6 L
S
8.1999 37.0001 m
80.6999 37.0001 L
S
8.1999 51.3999 m
80.6999 51.3999 L
S
8.1999 65.8 m
80.6999 65.8 L
S
8.1999 15.3999 m
80.6999 15.3999 L
S
8.1999 29.8 m
80.6999 29.8 L
S
8.1999 44.1999 m
80.6999 44.1999 L
S
8.1999 58.6 m
80.6999 58.6 L
S
8.1999 73.0001 m
80.6999 73.0001 L
S
) &
] E
%AI3_EndPattern
%AI5_End_NonPrinting--
%AI5_Begin_NonPrinting
Np
3 Bn
%AI5_BeginGradient: (Black & White)
(Black & White) 0 2 Bd
[
<
FFFEFDFCFBFAF9F8F7F6F5F4F3F2F1F0EFEEEDECEBEAE9E8E7E6E5E4E3E2E1E0DFDEDDDCDBDAD9D8
D7D6D5D4D3D2D1D0CFCECDCCCBCAC9C8C7C6C5C4C3C2C1C0BFBEBDBCBBBAB9B8B7B6B5B4B3B2B1B0
AFAEADACABAAA9A8A7A6A5A4A3A2A1A09F9E9D9C9B9A999897969594939291908F8E8D8C8B8A8988
87868584838281807F7E7D7C7B7A797877767574737271706F6E6D6C6B6A69686766656463626160
5F5E5D5C5B5A595857565554535251504F4E4D4C4B4A494847464544434241403F3E3D3C3B3A3938
37363534333231302F2E2D2C2B2A292827262524232221201F1E1D1C1B1A19181716151413121110
0F0E0D0C0B0A09080706050403020100
>
0 %_Br
[
0 0 50 100 %_Bs
1 0 50 0 %_Bs
BD
%AI5_EndGradient
%AI5_BeginGradient: (Red & Yellow)
(Red & Yellow) 0 2 Bd
[
0
<
000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F2021222324252627
28292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F404142434445464748494A4B4C4D4E4F
505152535455565758595A5B5C5D5E5F606162636465666768696A6B6C6D6E6F7071727374757677
78797A7B7C7D7E7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F
A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7
C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF
F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF
>
<
FFFFFEFEFDFDFDFCFCFBFBFBFAFAF9F9F9F8F8F7F7F7F6F6F5F5F5F4F4F3F3F3F2F2F1F1F1F0F0EF
EFEFEEEEEDEDEDECECEBEBEBEAEAE9E9E9E8E8E7E7E7E6E6E5E5E5E4E4E3E3E3E2E2E1E1E1E0E0DF
DFDFDEDEDDDDDDDCDCDBDBDBDADAD9D9D9D8D8D7D7D7D6D6D5D5D5D4D4D3D3D3D2D2D1D1D1D0D0CF
CFCFCECECDCDCDCCCCCBCBCBCACAC9C9C9C8C8C7C7C7C6C6C5C5C5C4C4C3C3C3C2C2C1C1C1C0C0BF
BFBFBEBEBDBDBDBCBCBBBBBBBABAB9B9B9B8B8B7B7B7B6B6B5B5B5B4B4B3B3B3B2B2B1B1B1B0B0AF
AFAFAEAEADADADACACABABABAAAAA9A9A9A8A8A7A7A7A6A6A5A5A5A4A4A3A3A3A2A2A1A1A1A0A09F
9F9F9E9E9D9D9D9C9C9B9B9B9A9A9999
>
0
1 %_Br
[
0 1 0.6 0 1 50 100 %_Bs
0 0 1 0 1 50 0 %_Bs
BD
%AI5_EndGradient
%AI5_BeginGradient: (Yellow & Blue Radial)
(Yellow & Blue Radial) 1 2 Bd
[
<
000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F2021222324252627
28292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F404142434445464748494A4B4C4D4E4F
505152535455565758595A5B5C5D5E5F606162636465666768696A6B6C6D6E6F7071727374757677
78797A7B7C7D7E7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F
A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7
C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF
F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF
>
<
1415161718191A1B1C1D1E1F1F202122232425262728292A2A2B2C2D2E2F30313233343536363738
393A3B3C3D3E3F40414142434445464748494A4B4C4D4D4E4F50515253545556575858595A5B5C5D
5E5F60616263646465666768696A6B6C6D6E6F6F707172737475767778797A7B7B7C7D7E7F808182
83848586868788898A8B8C8D8E8F90919292939495969798999A9B9C9D9D9E9FA0A1A2A3A4A5A6A7
A8A9A9AAABACADAEAFB0B1B2B3B4B4B5B6B7B8B9BABBBCBDBEBFC0C0C1C2C3C4C5C6C7C8C9CACBCB
CCCDCECFD0D1D2D3D4D5D6D7D7D8D9DADBDCDDDEDFE0E1E2E2E3E4E5E6E7E8E9EAEBECEDEEEEEFF0
F1F2F3F4F5F6F7F8F9F9FAFBFCFDFEFF
>
<
ABAAAAA9A8A7A7A6A5A5A4A3A3A2A1A1A09F9F9E9D9D9C9B9B9A9999989797969595949393929191
908F8F8E8D8D8C8B8B8A8989888787868585848383828181807F7F7E7D7D7C7B7B7A797978777776
7575747373727171706F6F6E6D6D6C6B6B6A6969686767666565646362626160605F5E5E5D5C5C5B
5A5A5958585756565554545352525150504F4E4E4D4C4C4B4A4A4948484746464544444342424140
403F3E3E3D3C3C3B3A3A3938383736363534343332323130302F2E2E2D2C2C2B2A2A292828272626
25242423222121201F1F1E1D1D1C1B1B1A1919181717161515141313121111100F0F0E0D0D0C0B0B
0A090908070706050504030302010100
>
0
1 %_Br
[
0 0.08 0.67 0 1 50 14 %_Bs
1 1 0 0 1 50 100 %_Bs
BD
%AI5_EndGradient
%AI5_End_NonPrinting--
%AI5_BeginPalette
144 170 Pb
Pn
Pc
1 g
Pc
0 g
Pc
0 0 0 0 k
Pc
0.75 g
Pc
0.5 g
Pc
0.25 g
Pc
0 g
Pc
Bb
2 (Black & White) -4014 4716 0 0 1 0 0 1 0 0 Bg
0 BB
Pc
0.25 0 0 0 k
Pc
0.5 0 0 0 k
Pc
0.75 0 0 0 k
Pc
1 0 0 0 k
Pc
0.25 0.25 0 0 k
Pc
0.5 0.5 0 0 k
Pc
0.75 0.75 0 0 k
Pc
1 1 0 0 k
Pc
Bb
2 (Red & Yellow) -4014 4716 0 0 1 0 0 1 0 0 Bg
0 BB
Pc
0 0.25 0 0 k
Pc
0 0.5 0 0 k
Pc
0 0.75 0 0 k
Pc
0 1 0 0 k
Pc
0 0.25 0.25 0 k
Pc
0 0.5 0.5 0 k
Pc
0 0.75 0.75 0 k
Pc
0 1 1 0 k
Pc
Bb
0 0 0 0 Bh
2 (Yellow & Blue Radial) -4014 4716 0 0 1 0 0 1 0 0 Bg
0 BB
Pc
0 0 0.25 0 k
Pc
0 0 0.5 0 k
Pc
0 0 0.75 0 k
Pc
0 0 1 0 k
Pc
0.25 0 0.25 0 k
Pc
0.5 0 0.5 0 k
Pc
0.75 0 0.75 0 k
Pc
1 0 1 0 k
Pc
(Yellow Stripe) 0 0 1 1 0 0 0 0 0 [1 0 0 1 0 0] p
Pc
0.25 0.125 0 0 k
Pc
0.5 0.25 0 0 k
Pc
0.75 0.375 0 0 k
Pc
1 0.5 0 0 k
Pc
0.125 0.25 0 0 k
Pc
0.25 0.5 0 0 k
Pc
0.375 0.75 0 0 k
Pc
0.5 1 0 0 k
Pc
0.375 0.375 0.75 0 k
Pc
0 0.25 0.125 0 k
Pc
0 0.5 0.25 0 k
Pc
0 0.75 0.375 0 k
Pc
0 1 0.5 0 k
Pc
0 0.125 0.25 0 k
Pc
0 0.25 0.5 0 k
Pc
0 0.375 0.75 0 k
Pc
0 0.5 1 0 k
Pc
0 0.79 0.91 0 (TCL RED) 0 x
Pc
0.125 0 0.25 0 k
Pc
0.25 0 0.5 0 k
Pc
0.375 0 0.75 0 k
Pc
0.5 0 1 0 k
Pc
0.25 0 0.125 0 k
Pc
0.5 0 0.25 0 k
Pc
0.75 0 0.375 0 k
Pc
1 0 0.5 0 k
Pc
0.5 1 0 0 k
Pc
0.25 0.125 0.125 0 k
Pc
0.5 0.25 0.25 0 k
Pc
0.75 0.375 0.375 0 k
Pc
1 0.5 0.5 0 k
Pc
0.25 0.25 0.125 0 k
Pc
0.5 0.5 0.25 0 k
Pc
0.75 0.75 0.375 0 k
Pc
1 1 0.5 0 k
Pc
0 1 0.5 0 k
Pc
0.125 0.25 0.125 0 k
Pc
0.25 0.5 0.25 0 k
Pc
0.375 0.75 0.375 0 k
Pc
0.5 1 0.5 0 k
Pc
0.125 0.25 0.25 0 k
Pc
0.25 0.5 0.5 0 k
Pc
0.375 0.75 0.75 0 k
Pc
0.5 1 1 0 k
Pc
0.75 0.75 0.375 0 k
Pc
0.125 0.125 0.25 0 k
Pc
0.25 0.25 0.5 0 k
Pc
0.375 0.375 0.75 0 k
Pc
0.5 0.5 1 0 k
Pc
0.25 0.125 0.25 0 k
Pc
0.5 0.25 0.5 0 k
Pc
0.75 0.375 0.75 0 k
Pc
1 0.5 1 0 k
Pc
0 0.79 0.91 0 (TCL RED) 0 x
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
1 0.5 0.5 0 k
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
0 0.25 1 0 (Orange Yellow) 0 x
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
0 1 0.5 0 k
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
1 0 0.5 0 k
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
0 0.45 1 0 (Orange) 0 x
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
0.375 0.375 0.75 0 k
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
0 0.79 0.91 0 (TCL RED) 0 x
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
1 0.65 0 0 k
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
0 0 1 0 k
Pc
PB
%AI5_EndPalette
%%EndSetup
%AI5_BeginLayer
1 1 1 1 0 0 0 79 128 255 Lb
(Layer 1) Ln
0 A
u
1 Ap
0 O
0 0.79 0.91 0 (TCL RED) 0 x
800 Ar
0 J 0 j 1.25 w 4 M []0 d
%AI3_Note:
0 D
294.5207 335.3041 m
368.2181 333.001 L
363.6121 423.9713 L
370.5213 507.1689 L
336.5513 505.4417 L
320.7179 511.775 L
251.3386 508.0325 L
254.7931 425.9866 L
251.3386 331.5616 L
294.5207 335.3041 L
f
u
0 Ap
1 0.65 0 0 k
1 w
318.1366 400.9627 m
311.8663 399.2526 l
315.2864 407.5177 l
318.7064 430.6032 l
314.4314 431.4581 l
319.5616 438.5832 l
325.9526 462.6014 l
314.7164 460.2436 l
320.6412 471.0911 326.9284 478.1557 v
318.7064 484.469 l
292.2183 472.8011 299.3434 434.8954 v
293.8679 435.8542 l
299.1189 396.1175 l
294.6797 394.9775 l
299.2277 385.6974 305.5963 381.2973 v
306.1744 380.8979 297.6162 412.3629 306.7363 443.7133 c
307.5914 441.7183 l
300.3238 408.3015 307.5914 381.2973 v
307.9261 380.656 311.5598 381.0836 v
318.1366 393.4813 318.1366 400.9627 v
f
u
*u
1 g
271.4311 372.5074 m
272.7184 372.5074 L
272.7184 375.1913 L
273.2858 375.1913 273.8313 375.1913 274.3768 375.2786 c
274.3768 372.5074 L
276.2969 372.5074 L
276.2969 372.0056 L
274.3768 372.0056 L
274.3768 365.3286 L
274.3768 364.9359 274.3768 364.3467 275.2059 364.3467 c
275.7733 364.3467 276.0787 364.7395 276.4279 365.1541 c
276.777 364.9141 L
276.3624 364.0849 275.2932 363.583 274.4204 363.583 c
272.8494 363.583 272.6748 364.434 272.6748 365.4814 c
272.6748 372.0056 L
271.4311 372.0056 L
271.4311 372.5074 l
f
*U
*u
290.5617 366.5724 m
290.0598 365.0232 289.187 363.6703 286.9178 363.583 c
283.5356 363.583 282.5101 366.3978 282.5101 367.9034 c
282.5101 371.7874 285.6304 372.7256 286.8741 372.7256 c
288.2924 372.7256 290.2999 372.071 290.2999 370.3909 c
290.2999 369.8018 289.9289 369.2344 289.318 369.2344 c
288.7288 369.2344 288.2924 369.6272 288.2924 370.26 c
288.2924 371.111 288.9907 371.2201 288.9907 371.4601 c
288.9907 372.0492 287.616 372.2892 287.136 372.2892 c
285.0412 372.2892 284.4957 370.7618 284.4957 367.9034 c
284.4957 366.5942 284.823 365.5905 284.9539 365.285 c
285.2812 364.5649 285.9577 364.1067 287.0923 364.0413 c
288.3579 363.9758 289.5798 365.0013 290.1035 366.5724 C
290.5617 366.5724 l
f
*U
*u
296.6 363.8667 m
296.6 364.3686 L
298.2802 364.3686 L
298.2802 378.3989 L
296.6 378.3989 L
296.6 378.9007 L
297.5383 378.9007 L
298.3457 378.9007 299.1966 378.9444 299.9822 379.0971 c
299.9822 364.3686 L
301.6623 364.3686 L
301.6623 363.8667 L
296.6 363.8667 l
f
*U
*u
317.4527 372.5074 m
318.7401 372.5074 L
318.7401 375.1913 L
319.3074 375.1913 319.8529 375.1913 320.3984 375.2786 c
320.3984 372.5074 L
322.3186 372.5074 L
322.3186 372.0056 L
320.3984 372.0056 L
320.3984 365.3286 L
320.3984 364.9359 320.3984 364.3467 321.2276 364.3467 c
321.7949 364.3467 322.1004 364.7395 322.4495 365.1541 c
322.7986 364.9141 L
322.384 364.0849 321.3148 363.583 320.442 363.583 c
318.871 363.583 318.6964 364.434 318.6964 365.4814 c
318.6964 372.0056 L
317.4527 372.0056 L
317.4527 372.5074 l
f
*U
*u
333.7467 372.0056 m
333.7467 372.5074 L
337.3252 372.5074 L
337.3252 372.0056 L
335.9942 372.0056 L
332.983 369.3872 L
337.1288 364.3686 L
338.0453 364.3686 L
338.0453 363.8667 L
333.8995 363.8667 L
333.8995 364.3686 L
334.9905 364.3686 L
331.3465 368.798 L
335.0341 371.9401 L
335.0341 372.0056 L
333.7467 372.0056 l
f
328.4881 363.8667 m
328.4881 364.3686 L
329.6227 364.3686 L
329.6227 378.3989 L
328.4881 378.3989 L
328.4881 378.9007 L
328.8809 378.9007 L
329.6882 378.9007 330.5392 378.9444 331.3247 379.0971 c
331.3247 364.3686 L
332.6339 364.3686 L
332.6339 363.8667 L
328.4881 363.8667 l
f
*U
u
309.5341 446.5364 m
305.6878 429.3874 306.7947 401.5837 v
307.1266 393.2441 308.0387 385.5779 309.1527 378.9301 C
309.1587 378.9297 L
309.8832 373.0923 310.3679 370.9791 312.2568 363.9454 C
312.1466 359.4091 L
297.0216 407.7015 309.5341 446.5364 V
f
318.8187 461.4058 m
322.2203 463.1 327.0966 463.7165 v
332.427 453.9463 319.3087 437.2655 v
327.1346 454.735 325.2889 460.2079 v
323.225 461.4903 318.8187 461.4058 v
f
317.2065 432.0795 m
320.2613 431.3723 321.7279 432.5601 v
318.8383 421.2839 319.5958 415.0813 v
320.3533 408.8787 314.8881 404.9079 y
319.5435 410.7982 318.0802 415.5959 v
317.0657 418.9214 318.2006 427.4326 319.4809 430.1349 c
318.2853 430.3025 317.2065 432.0795 v
f
314.1861 402.3703 m
319.2343 402.9744 319.7646 405.5244 v
320.3824 390.2725 313.3689 383.9873 v
318.7204 392.3347 317.8807 400.9697 v
314.1861 402.3703 l
f
299.9864 396.0219 m
298.3586 394.1986 293.4739 398.2203 v
295.0301 387.9694 304.6978 383.2767 v
298.0444 388.2897 296.2519 393.7045 v
298.6029 394.3966 299.9864 396.0219 v
f
298.4281 399.9096 m
291.8229 416.6749 293.2382 439.3286 v
294.7808 435.2261 299.738 433.7875 v
297.4026 433.3101 296.0372 433.517 v
292.5816 423.9535 298.4281 399.9096 v
f
326.1736 477.812 m
323.6983 496.0028 308.2122 477.6066 v
295.8813 462.9582 297.3508 450.5217 298.1072 443.5831 c
298.3007 441.8079 295.8131 462.1138 309.3231 475.4768 c
322.8328 488.8398 325.8846 478.5879 326.1736 477.812 c
f
U
0 0 1 0 k
303.3623 493.3274 m
291.211 496.7978 287.3437 456.5222 v
284.3599 468.9535 292.0777 486.5353 v
299.7955 504.1172 303.3623 493.3274 y
f
288.2873 496.2718 m
282.0897 486.9502 283.4958 477.0213 v
278.7953 495.712 288.2873 496.2718 v
f
333.8987 470.1328 m
341.2276 472.8361 330.7334 445.5571 v
336.1654 453.5292 339.5844 466.0531 v
341.7789 474.0903 333.8987 470.1328 y
f
345.752 472.2583 m
350.9334 467.5681 347.2615 461.3636 v
356.4779 471.0481 345.752 472.2583 v
f
U
*u
273.1765 354.3318 m
273.1765 353.7507 273.1305 353.2908 272.5159 353.2908 c
271.8846 353.2908 271.8554 353.7674 271.8554 354.3318 c
271.8554 356.485 L
272.148 356.485 L
272.148 354.3486 L
272.148 353.8259 272.1773 353.5751 272.5159 353.5751 c
272.8504 353.5751 272.8839 353.8259 272.8839 354.3486 c
272.8839 356.485 L
273.1765 356.485 L
273.1765 354.3318 l
f
*U
*u
277.1612 356.485 m
276.9062 356.485 L
276.9062 354.3862 l
276.9062 354.2482 276.9271 354.1061 276.9355 353.9681 C
276.9229 353.9681 l
276.8937 354.0768 276.8644 354.1855 276.8268 354.2942 C
276.1035 356.485 L
275.8484 356.485 L
275.8484 353.3326 L
276.1035 353.3326 L
276.1035 355.2474 l
276.1035 355.4523 276.0826 355.653 276.07 355.8579 C
276.0867 355.8579 l
276.1244 355.7241 276.1495 355.5819 276.1954 355.4523 C
276.9062 353.3326 L
277.1612 353.3326 l
277.1612 356.485 L
f
*U
*u
280.1421 353.3326 m
279.8494 353.3326 L
279.8494 356.485 L
280.1421 356.485 L
280.1421 353.3326 l
f
*U
*u
283.5141 353.3326 m
283.2549 353.3326 L
282.6194 356.485 L
282.9205 356.485 L
283.3344 354.1897 L
283.3511 354.1102 283.3678 353.9054 283.3845 353.7632 c
283.4013 353.7632 L
283.4138 353.9054 283.4305 354.1144 283.4431 354.1897 c
283.8528 356.485 L
284.1496 356.485 L
283.5141 353.3326 l
f
*U
*u
287.6238 356.2174 m
286.9256 356.2174 L
286.9256 355.1053 L
287.6029 355.1053 L
287.6029 354.8377 L
286.9256 354.8377 L
286.9256 353.6002 L
287.6238 353.6002 L
287.6238 353.3326 L
286.6329 353.3326 L
286.6329 356.485 L
287.6238 356.485 L
287.6238 356.2174 l
f
*U
*u
290.2278 353.3326 m
290.2278 356.485 L
290.5414 356.485 L
290.9804 356.485 291.4026 356.4515 291.4026 355.6823 c
291.4026 355.2809 291.3148 354.8879 290.8089 354.8712 c
291.5072 353.3326 L
291.1978 353.3326 L
290.5288 354.8753 L
290.5205 354.8753 L
290.5205 353.3326 L
290.2278 353.3326 l
f
290.5205 355.1137 m
290.625 355.1137 L
291.0347 355.1137 291.1016 355.2558 291.1016 355.6697 c
291.1016 356.1672 290.9511 356.2174 290.579 356.2174 c
290.5205 356.2174 L
290.5205 355.1137 l
f
*U
*u
295.0981 355.9875 m
294.9727 356.1296 294.8347 356.2425 294.634 356.2425 c
294.3414 356.2425 294.1783 356 294.1783 355.7324 c
294.1783 355.3645 294.4459 355.1931 294.7176 355.0091 c
294.9852 354.821 295.2528 354.6203 295.2528 354.1855 c
295.2528 353.7256 294.9559 353.2908 294.4626 353.2908 c
294.287 353.2908 294.1072 353.341 293.9651 353.4497 c
293.9651 353.8301 L
294.0989 353.688 294.2745 353.5751 294.4751 353.5751 c
294.7845 353.5751 294.9559 353.8468 294.9518 354.1311 c
294.9559 354.4991 294.6842 354.6621 294.4166 354.8503 c
294.149 355.0342 293.8773 355.2391 293.8773 355.6906 c
293.8773 356.1129 294.1365 356.5268 294.6006 356.5268 c
294.7887 356.5268 294.9476 356.4641 295.0981 356.3596 C
295.0981 355.9875 l
f
*U
*u
299.0865 353.3326 m
298.773 353.3326 L
298.6559 353.9806 L
297.9869 353.9806 L
297.8741 353.3326 L
297.5605 353.3326 L
298.1793 356.485 L
298.4552 356.485 L
299.0865 353.3326 l
f
298.6099 354.2357 m
298.4009 355.444 L
298.3632 355.6572 298.3465 355.8746 298.3214 356.0878 c
298.3047 356.0878 L
298.2754 355.8746 298.2545 355.6572 298.2211 355.444 c
298.0371 354.2357 L
298.6099 354.2357 l
f
*U
*u
301.8124 353.6002 m
302.4981 353.6002 L
302.4981 353.3326 L
301.5198 353.3326 L
301.5198 356.485 L
301.8124 356.485 L
301.8124 353.6002 l
f
*U
*u
309.0754 355.9875 m
308.95 356.1296 308.812 356.2425 308.6114 356.2425 c
308.3187 356.2425 308.1556 356 308.1556 355.7324 c
308.1556 355.3645 308.4232 355.1931 308.695 355.0091 c
308.9626 354.821 309.2301 354.6203 309.2301 354.1855 c
309.2301 353.7256 308.9333 353.2908 308.4399 353.2908 c
308.2643 353.2908 308.0846 353.341 307.9424 353.4497 c
307.9424 353.8301 L
308.0762 353.688 308.2518 353.5751 308.4525 353.5751 c
308.7619 353.5751 308.9333 353.8468 308.9291 354.1311 c
308.9333 354.4991 308.6615 354.6621 308.3939 354.8503 c
308.1264 355.0342 307.8546 355.2391 307.8546 355.6906 c
307.8546 356.1129 308.1138 356.5268 308.5779 356.5268 c
308.766 356.5268 308.9249 356.4641 309.0754 356.3596 C
309.0754 355.9875 l
f
*U
*u
312.9468 353.7172 m
312.8339 353.6378 312.7001 353.5751 312.558 353.5751 c
311.9977 353.5751 311.9977 354.5492 311.9977 354.9172 c
311.9977 355.5025 312.0688 356.2425 312.5789 356.2425 c
312.7252 356.2425 312.8297 356.184 312.9468 356.1045 C
312.9468 356.4265 l
312.8506 356.4975 312.6918 356.5268 312.5747 356.5268 c
311.7134 356.5268 311.6967 355.306 311.6967 354.7959 c
311.6967 354.2566 311.8054 353.2908 312.5454 353.2908 c
312.6834 353.2908 312.8381 353.3451 312.9468 353.4204 c
312.9468 353.7172 L
f
*U
*u
315.5053 353.3326 m
315.5053 356.485 L
315.8188 356.485 L
316.2578 356.485 316.6801 356.4515 316.6801 355.6823 c
316.6801 355.2809 316.5923 354.8879 316.0864 354.8712 c
316.7846 353.3326 L
316.4752 353.3326 L
315.8063 354.8753 L
315.7979 354.8753 L
315.7979 353.3326 L
315.5053 353.3326 l
f
315.7979 355.1137 m
315.9025 355.1137 L
316.3122 355.1137 316.3791 355.2558 316.3791 355.6697 c
316.3791 356.1672 316.2286 356.2174 315.8565 356.2174 c
315.7979 356.2174 L
315.7979 355.1137 l
f
*U
*u
319.5728 353.3326 m
319.2802 353.3326 L
319.2802 356.485 L
319.5728 356.485 L
319.5728 353.3326 l
f
*U
*u
322.2551 353.3326 m
322.2551 356.485 L
322.5812 356.485 L
323.0327 356.485 323.4341 356.4432 323.4341 355.6655 c
323.4341 355.0551 323.2209 354.8419 322.623 354.8419 c
322.5477 354.8419 L
322.5477 353.3326 L
322.2551 353.3326 l
f
322.5477 355.1095 m
322.6606 355.1095 L
323.0703 355.1095 323.1205 355.26 323.1331 355.6655 c
323.1331 356.1004 323.016 356.2174 322.6063 356.2174 c
322.5477 356.2174 L
322.5477 355.1095 l
f
*U
*u
326.9539 356.485 m
325.7164 356.485 L
325.7164 356.2174 L
326.1888 356.2174 L
326.1888 353.3326 L
326.4815 353.3326 L
326.4815 356.2174 L
326.9539 356.2174 l
326.9539 356.485 L
f
*U
*u
329.7077 353.3326 m
329.4151 353.3326 L
329.4151 356.485 L
329.7077 356.485 L
329.7077 353.3326 l
f
*U
*u
333.7028 353.3326 m
333.4477 353.3326 L
332.737 355.4523 L
332.691 355.5819 332.6659 355.7241 332.6283 355.8579 c
332.6116 355.8579 L
332.6241 355.653 332.645 355.4523 332.645 355.2474 c
332.645 353.3326 L
332.39 353.3326 L
332.39 356.485 L
332.645 356.485 L
333.3683 354.2942 L
333.4059 354.1855 333.4352 354.0768 333.4645 353.9681 c
333.477 353.9681 L
333.4686 354.1061 333.4477 354.2482 333.4477 354.3862 c
333.4477 356.485 L
333.7028 356.485 L
333.7028 353.3326 l
f
*U
*u
336.9846 354.9966 m
337.7037 354.9966 L
337.7037 354.4154 L
337.7037 353.9179 337.6787 353.2908 337.0264 353.2908 c
336.3617 353.2908 336.299 353.989 336.299 354.9841 c
336.299 355.7283 336.3868 356.5268 337.0557 356.5268 c
337.432 356.5268 337.6201 356.276 337.6996 355.9331 c
337.4111 355.8202 L
337.3776 356.0084 337.2982 356.2425 337.0682 356.2425 c
336.6334 356.2383 336.6 355.5652 336.6 355.0091 c
336.6 353.8427 336.7463 353.5751 337.0515 353.5751 c
337.3818 353.5751 337.4111 353.8176 337.4111 354.4907 c
337.4111 354.729 L
336.9846 354.729 L
336.9846 354.9966 l
f
*U
U
U
337.6667 -3924 m
(N) *
337.6667 4716 m
(N) *
LB
%AI5_EndLayer--
%%PageTrailer
gsave annotatepage grestore showpage
%%Trailer
Adobe_IllustratorA_AI5 /terminate get exec
Adobe_level2_AI5 /terminate get exec
%%EOF

Deleted library/images/logo100.gif.

1
2
3
4
5
6
7
8
GIF89aDd�������������f��3���������̙��f��3�������������f��3���f��f��f��ff�f3�f�3��3��3��3f�33�3�������f�3������������f��3���������̙��f��3��̙�̙�̙�̙f̙3̙�f��f��f��ff�f3�f�3��3��3��3f�33�3����̙�f�3̙����̙����f��3�������̙̙��f��3�̙����̙����f��3���f��f̙f��ff�f3�f�3��3̙3��3f�33�3���̙��f�3�f��f��f��f�ff�3f�f��f��f̙f�ff�3f�f��f��f��f�ff�3f�ff�ff�ff�fffff3fff3�f3�f3�f3ff33f3f�f�f�fff3f3��3��3��3�f3�33�3��3��3̙3�f3�33�3��3��3��3�f3�33�3f�3f�3f�3ff3f33f33�33�33�33f333333�3�3�3f333�������f�3�����̙�f�3̙��̙��f�3�f�f�f�fff3f3�3�3�3f333�̙f3�ݻ��wUD"�ݻ��wUD"�ݻ��wUD"�����ݻ��������wwwUUUDDD""",Dd�H����*\Ȱ��z�Ht@Q��92�p���z�$@@сE�uY�2�˗0c�q�cB,[��ɳ�� �1qbM2~*]��Ƌs��S�@L�jݺ�#�\Ê����سh����֣��]
D(��m����@�Z��ܱ�oO�3=�c��G"(��pL�q]��%��
[���#���+���X�h���^������~�r��K#Gp]���z���:���{�԰�s�F���z�\)t��W�r�= ٷn�ݧ��;r�?���zO��s��-A��g�� T�8���mU9p�e�QW=�(�!2]�e�@n��n1Yx�=	j�!g�EP���������ΐ�M����c��8:��!;”\�=a�bX@*YZ�E������N� 4���t@E*��N5@݀k�VPR�5Vb�������g2�ԥ@p�N�Y�*�)w����VC�;17[�a隅(��cN���k5��UA�Gإ��!��`������z_�x*LP��*� �kFW[;=X+Z@�p�����m����E_̪�E��m��_��j���ף��d�g���̮�zA�.L��XX��k�!�)S��;����9F=2�ukVNt^�9$\f��+`Vʆ����
I���1w��HJ��@�X����*�O�V<P�O17��*+Zr�cъ�X��!ت�O�[�e�bI�>
�"��V�e�@T�U�=T2ø������u�
++�����AFȮ�d�O��H�=��HD�"�cԪ��������A�kU���g��=��S���u��׵,)����Ԟ;`���Է, �}�J	����й��N��>�
"���*Z��X��̯�IF*�(��b�>2�98���s�u�b��9> >�@ �;S������9��Y�ߖњ9X��?����C��ʷ�Cz�S�䧹�,Y�^�T�����gwIK�F'���~J!����rӳ��⛂��`:D�g% �#�h9Y��$�U	c	Z�HqC��`9�!���z�n�ay��0s@8��˪BϢE��!E@ ��V`��DlRS�+&��)!̨���)(:k�b- �#A���dpG<�K���4@d�-��d!�A���������#�a9PV��Ҽ��%��8�\����"0qٽ���qZ=B���_�8��-w��8}��VL�"�`1Ej	�m�Ť�|�3���r�rqJ',�6M������7���<�.�*W�P�˗Ъ=ܼ�_"��<8�̱nS�h�'�,Q@uc��t�3���<�q���Wϼ9/��GQۜ��~9N�~%���DPMX53�J��4u��rB�4X�I =�$��W8���@�zx��
�f��v�'&#�I9�_,�V_���$�Y�Lu*�V.9����O�����u�-��W�,�}%_�I���\�B�!826-�9�c����d*gm���G��D#2��Dd���D$%)�IP�f6�	�F<�
<
<
<
<
<
<
<
<
















Deleted library/images/logo64.gif.

1
2
GIF89a+@�������������f��3���������̙��f��3�������������f��3���f��f��f��ff�f3�f�3��3��3��3f�33�3�������f�3������������f��3���������̙��f��3��̙�̙�̙�̙f̙3̙�f��f��f��ff�f3�f�3��3��3��3f�33�3����̙�f�3̙����̙����f��3�������̙̙��f��3�̙����̙����f��3���f��f̙f��ff�f3�f�3��3̙3��3f�33�3���̙��f�3�f��f��f��f�ff�3f�f��f��f̙f�ff�3f�f��f��f��f�ff�3f�ff�ff�ff�fffff3fff3�f3�f3�f3ff33f3f�f�f�fff3f3��3��3��3�f3�33�3��3��3̙3�f3�33�3��3��3��3�f3�33�3f�3f�3f�3ff3f33f33�33�33�33f333333�3�3�3f333�������f�3�����̙�f�3̙��̙��f�3�f�f�f�fff3f3�3�3�3f333�̙f3�ݻ��wUD"�ݻ��wUD"�ݻ��wUD"�����ݻ��������wwwUUUDDD""",+@�H� �z�(tp��Â�@ࠢ�92���#�  A����C�\ɲ%)Z��1a˛8s��W/�Ο@��3�ќC��y$䑦GW���厐5�FU��j�;�F(Pc+W�-��XD-[�*g���F��`�:mkT��Lw��A/�u�7p�a�9P���q2Xg�G��˃̙3}AKv\d�yL�>��1�#��:�-{UP�gxvZ��l�dT��YeR2���WZ6"l*�Y���9����۴o�!��r�@�9��Q9|�r�������Vg2�<�Z͵��� ��>d�Uf!��P@��3��_�-�%��y�>(��aH��"�*
�ρ���@�HJ}2��SI2��* R)3����p���#�>U��@E�T�]�a_��JG ���a"�����>��'歀�O� $�S2x�J����Yuy����A�Iԡm=a���r �E��@x>��i��x�VB�i�<���J��`��:3��֓*�]8�ju]���@�̰��� �2����!8��FA�*�xxߩC-N���3��0�J���x��x:C��@�x.N���[>@��R��}���8���Q�lƑ�gP& �Q��c���5��?�G[TrN3��>������B��VsH�$�S,���@�9^�A%��9$]����C�38��S[����m�3̐e�9�V���}�tS@���
<
<




Deleted library/images/logoLarge.gif.

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
GIF89ab�������������f��3���������̙��f��3�������������f��3���f��f��f��ff�f3�f�3��3��3��3f�33�3�������f�3������������f��3���������̙��f��3��̙�̙�̙�̙f̙3̙�f��f��f��ff�f3�f�3��3��3��3f�33�3����̙�f�3̙����̙����f��3�������̙̙��f��3�̙����̙����f��3���f��f̙f��ff�f3�f�3��3̙3��3f�33�3���̙��f�3�f��f��f��f�ff�3f�f��f��f̙f�ff�3f�f��f��f��f�ff�3f�ff�ff�ff�fffff3fff3�f3�f3�f3ff33f3f�f�f�fff3f3��3��3��3�f3�33�3��3��3̙3�f3�33�3��3��3��3�f3�33�3f�3f�3f�3ff3f33f33�33�33�33f333333�3�3�3f333�������f�3�����̙�f�3̙��̙��f�3�f�f�f�fff3f3�3�3�3f333�̙f3�ݻ��wUD"�ݻ��wUD"�ݻ��wUD"�����ݻ��������wwwUUUDDD""",b�H����*\Ȱ�Ç#J�H��ŋ3j�ȱ�Ǐ '�;p��(8X��^ȗ0cʜI���z8O�\����:�
�$�ѣFu<8`��ӧP�>%I�gO�C�h-�+ү`���@�ٳh��ę�dJ?�
K��ݻH�,U˷�_�#홤��g�[�*^�x���J�L!ۓ'������Ϡ=+eZ��i��ynF�8��װ]y|��m�l� ֩r5����~T/���k
���ϬZ�K�N]��ɳG�`$��+���쵺��觏�~{$I��}��|����W'�~��(���W|=P��6H�c�!x��Vhᅢ(!Fݹ��q	Q��$�XD���4y�=���&�h��z��w�`O���p2.D�H&)``�QPz��UX�GTt��Jv�e~�)tYj�=���A�WbYq��pR7[�r��e�a!���x�����&��j�p@���6��x�B@j饐J���v꩟:4�����j���2t����*��.�T���j�}Z*�����p�&4��lC��첟����F+m]�>;����hB�f����"����������C���@<t��b�����F��/��*4��pB|�p�����xV�0�{)�g�d��j�q�T��$cx��%���������0)�0׬��ڬ�}8/������DK'tBE'\� )��k���ԌE�иTg]W��>�C��ZS��AX��C `/ ���-w�]�p�F���;��-w��=��u��:��j�����n8l:�����xl�C��K4�����6瞧^�栃�s�|/�ݯ���ꭇvt����9l�߮y��ޱ��N�k�?;���/��%/��t�<�w1-*������]���/&�����=��K�~hV/D����]l�#��ǘ�E�e�j��'<�04�e��94
����Id��
��@��ُ����1�A¦�& 
����sM	O8C׉�W���=S��ɰ����A�EA�m�1%|"��C�E�wA��%��!�]hD�E��OV{+T���-��eE�H��eωq|�ٸ����Ϗy����/��a 33���������ȻTdt�R���J��}��$��IR��R ��F�ҔA埚��Ŵp�$�
��Ń$�Q�M+���8`E�y�.��K����$!�p��菎�jfA�y��Q�.�$�h�z�2]g�$�(��و��e�ҩ�P�/���"��w �x�z�8��ET�sK�J�
!%�v^�F���,��q��!KzF$�̖
)bQ5�����A��ri���;ic�9�
P4#�V �*H���H)�"j�T�
z�C���m��[;e�=B�'��(ڻg��i�*���X���.�h 9�VD	2�>^5��>r@ c�x������[kH[!yU��<H���Ɔ�EqU�j���3Y�PbW�X�zVd�Һ��*d�xb�gh� �����X�Z�����"���c�
�u U��l���2%��Z)�H7P�d�A�{-q�K��S]�5r��ܰĕAƫuǫ�*<UZ��#9�H�WLz�|�F��Tq	�f+��+�أ��n��oy�"��-5����� � p�IQ�#	�����������P�_$�pj�~����X�F�!�X���M��s	��z����2�U���U���|d	�b�D�ȑ[�A'�o�%\`r��!S� �`�x��������'���=3���Wu�V!=U��c5��y�3V�'b�Z�6KY���ee Z"���~�3-/:��*3E"m+7�gЖ�4��iB7�Q{N��B-��:��ǩUe��ɭ��*f���:IJ�szg��:�jv�����FM��y�=[�zy �h������wڞՇ��-�lwzp9F��W \p���]��}��mJ������!gw�5�6��6�!z;�ޅvЊ��ƾZI����|�`/0=p�v��*�7 s FOv	�8w�'X���x^^���m�:��V�3�徊��.�U>��| �� g���ܸP�N����sȞl��/+� ��J��A9��j��l��&�l�Bn��
��I�η�jߧ�����e;��
�uW�������b�t�i#a�T+ /��*��]��0�{>�]8�H�1U�S'X����#����ʼ@oŹ��do:��Szy��KC��/^������P��8��'i ���m_P�q����";;�{�諂A���(�) �^众R�~����\�;>R<��FZ��$�tre�v��A�:v�b��DLr"��o�~�Cw�Cwd���q�Qf�v� �'u:�{dv_�*H�lx~�7�Gi���� l� |��#~JV���F1h {7z"B�9��7(87O'�o�
BF��;EQ(��'nT�_�+H�p8 �ׅtc���|RS*Z$��!1X8m.���=�)�@� rXqjw��`��r<�����R�!s��8vh�xZC���2��pJhJ�(g���F6p(Hq�x�E��'ؖ���}�&�$L9��׊��xWU�4��I�!��t�I]8��Al¸�q�x`H��n{h �hnrG���5r`f'fo(�b[�~@�&��xK�c!�vbC(;D��\M'@@c��@
�G��H�gw(����Xv�Ȉ^�y�e�Le� Ykt(a�z�����,� {�"Fa�7�E�X(%	!���Iǁ�Ӧ
�0gȐ����pr�9Ik��7a��7^�p6�[��'K	M�xZR:�"v2p��I�(Y	[�MM��b)_d�33��(�H)Hfz<y�s�d�qwy�3X(�v�Prph@����vID�(�i��*�e��n�	c3�eQ���J]y!���6HZ"��9j�Y���(�i�����,�����1���v�bw5�~r�A (��Ӆ�)��%��b�Q_|�(����I]�v0�<��'��ؙ.#���X�>�E��r��+�+ ����V�]�G�a��&P��b�G�T�%������R$+I��Ug�6�w�@ʉ!{i��R$�(��U`�y������8O������zHA���}�.�қ,*V��h)7��!4*Q�B*��f5jK��(���+@�#a��bU`��I��Ҥ��J���=�A�9�'\*��ҏ)'�y������R�᥷ҏ�	���>�U��m�,�x�T�e�eN��)�)��,���9��|�}J����8٦
�x%��>�)���
E��]���i����x橬�^a9
N2�)��fj�P�bj�Iq��P���
o
�a��Uy���)y��ڧ��*2d���R����ں�8�&��c�%r���Pj���X^i��O��/�J�*h�Z�G�L��S�����|�ڝ"j9����©�	���(��.j�9���!��.u�*��5���HB�X�N%K��EP6�r��a���/˪F0	���)���6��V��f��Ҳ���2�|ԡF`_ul��|�G16��s�.0��E
y��\ֳ:�[�ص0���RbK]6m��M�r�ᶵ��hyl�ZfL�,��S��V j^ulu,zk/⚷m������g��v�z�1�‚~��o�⹗�!����V�*j��0�*-����M�A)V]Ÿ]q2���1���BM6�V��k�Z���b�A�ђ�0Z���z�EQ-�+-�����B��dE1aE�V�W����K.�c�
�@
���F[2��������`�v���ǁ��뵪�{Z�ty��� +_���K,<���"V�P����!�:կ�'��‘�jd���ۼ#�����"�ö"�|c@
��jza��)��-�{�Fqz�9gB��Z,<,K�-M��^Q^���6��îR��f��֛�FA�.���E�[*hl�҂����Um5���k]Ы,wj|(���L\]6	�
ddI�**�l(x|�ܢ]v&|¢�
}����\(+�K@<]w+PċF3Pǧ� qʄbdw����j@��1�MY��/�|9͊Vv�ǣfd�ȗc��/.���R�u�̱yd�!�[��K�*iK�K]�<�,Dz��*��'=3:�H�ʀ�f�x��-�3:��jH��Ύ�������RC2��w��!Z�!�<^��L4�П�S����
���������Ž�����~��H�A�,���qS����+�GT)�f��m�41�?m���F1:"�"���4�,J$�pU���VЂ5�s�YM�Q����U��@��S��GY�dr��
��C��g��9�������a�˗R���Zb�\�E �"��c�dqŽ����x�5�8,���(�(A>}+M�=G͞H1O9É]�߂�2�:�+�]P�"�
%MѱS0|*<-�M�)���0g��%]���.�m��l��q��jm�}+�[�M��M��1�T���P�)X}��]�[�5���sƾ�ޱj�=}��GA���}����b�M�ߟ dj���ݲ5c��_j����=V���(jc���m+,����q��\����(����R�<]�z�m�FLC����,-���Ga~iQJ,��5�ٞ��S���!ް�e��K�-3����]1�7�h�0v�./��f>���߰�gdY9)dΗ�"u^�c�88 d]�p1Hn)� �) s���Ha]�(j9�(�n�5���c���]�ۜ�Q�2��J�p�����[c�`�2���K�!�N\��~�>���r��������M�v8^/����r/����)�h�p��V}'ڮ���v@����g�^��*�]�or�0��j��� r�4F��u.2p�|�xn�[�
N�����-S.2���yq�D��^p2��+�ݶ�r_��U�җ�kY�/�gYZ�,��VdP�[������0��q�,���Ucp27n���I���=-ZR)�Σn�6I_�L?GN���ޢS�sF��:��A�_���� �a���{h�(X;s�%�R)�|����R.1U�-f�w�$#eY�����&d��2��Y�Ib@�E�x���[Y�/�o���$�anB�X���F=�*�����_4�HR-r��5z��p/۟�/�n��O Q?��݁�����/��v-Z� l�Xj���g+1Ȟ�3�!��
��ԥfD��hoC���o��E^�*`�[�q������O�� A��rV��A��a��=�#���ń�>��AC�!E�$Y��I�)U�4ɱ�K�1e�<��M�9u�dx "��0^\��aG�C�&���G�Q�N�*��L�Ya֬�իW]��(�1%�+��Y� :::�Z��� W���
�_�$��9ƭ3Ug������Ң:�I����r�n�I�g�.��p�X񘗎_L�H؟�e���ٶ�DϳuG�M��i���ƨ�&���w/�[����̥��蛠�ө�_���*���:�9�x�"}zx��b}ڷg)9����o)�~a��}�O���ε���A��돳� D�%τ����K� ���4KI�	���D�4�KòZk�õ><H� $��QLQ�y�M��sk���1"�>4.$�4q��
RJـP�����'� ���U		�(����*g�R��`�����$Rt�����S?6ی��?wK�Ё��3Om\�!�������)�l���s�;b�F�
��4��Kc�TU�\d���BehT&KuǫބU7V[��W���H�\T�q��Ab�VX�r�����!��e��O���.9j%�V\���0n�dv;3��Wt/ӫ�^��+�|kK�[�%�ѼF�w�{�����&pCQ^���&e����]��|���v�㪎c�8-W��Q�*,�>�H1\�,U1�,v90��wg�8�*١h�8HO����-r�������'��<��j�է���a#�2���B�!��~���/ �m����˥�&5����n��^9\�w�����ޛdH'�p�"]yn�W�k,��V<�2�
����lp�CG	�z��"�9�����4�+-�t���"�j����튲�\ܫ2���W��#��Y����n�p;y��_�t�E�(v!���*ڮ)ɮ�^'���~����J&�|��5�uP��LKX�`S���L�3������� !W�$�>��~Q ����\p�A`�D�= `�R�W������NX�^��;Ph5�G�
0$�F����~��q�{�y���h����'����1��$�� �+J$�e!X}��O��gw�#�N#�F��5:x���8Ǔ�QPr�d�A�dm1~ A�
<���#G��6yr}H���"�1��%��Z\�8QU��%
��U,%I�\�a��Bf����ʬ�H����IT�@�dn������b��������f�,�!�a@>�!�>ռT:����#oF�[�(2t�
q�:��NA`���T��Ր�PAp:6Drª�@��.��55˃�ND�1�� ��D#�ϕU�� �h�GҎT�-MHaJg܏2+W���LH2�/��RT1�C�#:���N��*i���YʣA��� Le�T�EѫA�iA��B�dU�\�c���"�Т!QjB~&�2	Z�*�5��,���_J�y�C��{�+L�S��J�]���W���"IJlGV�X�bt����$�#�aCs �Y2?փ�۹*�{�pv��cIZ{#��v����Nk��MPp�q��2W���s��QERu\P�v�Ӫ�d�B�\�ʺ
��NH��#t����ED��vd���UJ���*�m3Y�=�a�{�rA@ȯ�څg�՟��S��ֈ��"|t�h;�Q���O�eHV�֮e��-N��G=h�8�=n6M(F��
��d ���C��S$���(�W�#�n���
 7˿D�ۏP�5�`ǫ9��c�+��&D@�t宱
ī	��Y]�p����D/�߷ՆLni����1��س�"�� ��(��H��c^<���?��خe6Ư��vT`�%�N:E����[m���Jf��zB��rZW#���I@(&��'����{�:5p�8&z5ԃ�Io[���f\6
�|��Yث���I�r�����	���k�A;�Ǔ���f[���Bw�����`#����CW��~�O�}�$�["�j#��6�E&�ݒ$U?��i�z�=V�s��x�s?��fA���4��9�y��3�������92/��%�8?d��s�K���W?|k:�9�Ԓ�Ye�S�$X��_`!{ܝ�'���"�
r#���G�����fߕw�DN��'�;��e����Ҍ���6�]������cr��0,�l�>��W�p,6b�w(	k���D2��_���A�k���]�� "��t$�e邉��	z���6���!�	=Fh"��E��C��j �^�n}D�|>����zduAz<d/�;_(��’gXb"�}�$��m�_���Hj���;�k���?ck�ٺ'����?=:6�;#J@44ěٺ}���9���g�/#
 ��Vy=t+#��@������ �7��?� ���v��w����2�,��=6�������x��6��8Ы����BS/+� ��$/ҋ���#$���-��B�!���$@�����B�-5yC8t9���4,�5D&#�	;|;k�K�>�p6ҁ8�C���8Ć�FL���8��M����L�!C܉`i��@��b�bqĽ���:E��"Xa�P|�QLYt+Z�	��E�EWČ�3��2�R4��b$�c�a4E�XF�Cy�_��XL�_�	��-g�b��W�U|e�	V����FX�@+��j�NRxTyĊt,�o�	��G��GM�G7ɒ��u�	��Jȯ HJ1H�pȆ�C�9��i����	$����!6IG�,�B��쉘��5�G�`�A�V8�!Gb9��pECb��Ⱥ�H���$I���|�\I�tɛЋ�J�,J@����\�z�	�xʊ�J�pGY�*IJ��I�ɜ8��ɘ ʯ,�X��Q�J����	*�G��H�T�@�A�|	�d�2|�
�Ȏa��iF�����KM������������8'�h���K��ƴ��̜
�,$O\���݀E� -�x�9�z��9����*	p8�A�q�
м	��
�$~���+#�s�	6�؜	٬n�鬡`q/ƪ(N¼G��KiJ�ԁ
X��l�d�Lz�ꔉ��I|#�`M4�̶��K$Nż���
>�D�8����̐H���	�Ϻ�8j���	�d	VL�pL�aІpP���=P�P�	K�e�¬����ђQ�|�~J��4���-˯x%�i�	M����˶�J��f;ѩ�ѭR�����s�Q�HR���%	�
�̽c�ҩ����F�ҮH�������
*1�1E;4S.e�|	6����ю3��U�:�	rQ�<EϷ��(��?�O�tS�Ș��0UԗHT�P�mR&}RH���JeL�T�(!�����. P�\�Q�	�4U�lEJmPER�
���̤�Ee�>q�G�
\t8K9R�8B�V�p��	ke	/]	Va֮,�B�UK�j͊m5	l�Qm��nU�F}LR��'UӔ����T=�u�G[��wM���W�Wz�'��� 5��܌{��+��v��E���֕h����O4����K�ة8�tU������S15�\�'���쑐�G+����“�deG�!S�%�D�a���U��Ib�W�H�D����Bq��	Z�كY��
X5�HsZ���m�؝ H��؜P��XX�-ZT�8�[�舨�ک���;P���Eʤ�O�d'�Bٵ�	�-�oZ�=X�����������M�µX_�S�m�ƅT]uR��O�͏���b�WBbH��$���e	�e�!�A<+ɼ�	��ֱ�\����L��N��r%�����׋<܌%Q����M	*}�V�G��/&Z/���U\�]ZLu
{�[�E)��[��ޕ�����4�
�P�k��C�\�݊$��Y^�+E�Y��
0�M9$��C�I����4��ZM�-2V}[��	I�Dm���D
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






























































































































Deleted library/images/logoMed.gif.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
GIF87ax���������������������������������������
��������������������������z����{��o����m��b��`{�X���vy���hk�Um�N��I`�D�Z^�LP�?R�;!����?C�5C�3#�l��,6�*&�15���`��#(�If�y�����l����_��#/ߕ��Hm�>_�y��4R�k��#6ٵ��_�ؤ�ה��w��*K�^��"<Ϣ�Δ��G{�w��3_�"C�Q��F�ē��v��!K��ѷv÷2m�)_�[��!R�uʮ1t�g��)f� X�O��E��1z�gà _�Z��D��:��0��Z�� f�D��0��'z�m�N��C�/�zsvC�q/�mze7�\�P.�I�1%�,��,x��H����D��!� 7�PAQ��_l8���Ǐ C<аa��*�x���˗0q�� ��M�%<�HBe̟@�����Q�7��XC�ӧP��<z3�իX���P�jA�%'@�J�lV
ȹ�R�,�ʝ+���t����7hӾ���(��a�+^ܲ'�LJ7�L���ʘ�V���s�$���a��	8`�9� }K��`�����s��`���|�1@��,2`p�r��Y`���գ��H���@�/3L�=<T*���%s�	L��
�^���@�T$�_^�L0�Vm��^��^K�9Ga��^0�W��QU"]��Rv| W	Ը!d��^���Rw$��AsY�Y����.5�`V,tw���! ��0 8��Ve���� �Wt��F%Tt`h�P&�^q��!�V�)`�ȟ��QD���w�^g:@�y���F�<�@q�e�Km���!�O��إp&�s-@	]�����J���%(��f���muB�*��Z��Y��`�U
�]al�s<�l��� ГN͐�N+)�2�Ⲁ�Z�Si�+.����@"�^�B���fA��fu�ζ�����Y3���H6�B)J�	�1�y��A���N5(j�:!�_tmP�X�\���(���S,�(��vJ蔡��S�Q�p�Q�6�Q�L�z�=�2T . ��V����|���OĹ��Q�ݵK��	������m���=�qUt����N]�by$��=SqU����@9�^���Ҁ��\mL3�Q�����N�۷�I���(R��00�uH�K��� pA��d��
(��-�<P����tA)�ʆ�@Em�BA�����,�S���- @y�|��H�p0��� [K�K��I��{���'�%�sN��Q�C
V^�V?��`����:�;��%��V�&���k	v��Z}�e�A��4�b2�BGe�oe.;w��«�n��2�v\�� ��q�
��9 �{2[�^�xDƈ�����H��EvT�
(�?�@Q�"���=x@�G�ƚ�0m��,��aP�H8��A��2I� D��A��H��}�<�A@Y���8��`������y%��8*Y�u�%et9�҉�R���bD@�2b���.'t�L�K3?�3�� c \�>�Lq �<���@4pTw�2���-& �� x���.,*���g: �c�� �^�<��2T����0�i��g2L!e�9�Vo0��i,8��1E�`2Y�,P��rhOD1�H;%�. ����)���"z���q�aw�)��%�7H�8XBS�e�ʐ� F���I��	�*��0
� �~@��FJc�ik�*����LW�����3!U��@؉� ��q�A	,P�̓����]��ృ�C�`�de�0�Hq0� ���*=�C	������V?�O�5�(&�{ �@ +W�`��2����E Ɣ����Z�!�(=maR�H��y8/�87/��.�p@���K eLsc�5H z�Xރ��0��:���+	/��lKh/X�V��6+��.�Q�z��Z�P8R���`�_�(�Ł&,.>`�ZR �sR���I��c+�$լ80����?�7�i~)�	��F>N3|J!����``���K@�QY�Z�뀼,0/F�=�2���]�x�0nV�>*�4K��'�̔!�s�V���Z1(AY��h?G�g�a3_ �L*���t��������K2��nL����hcI6r�櫳��������b�aJ��(�]e6z�X���@��0�1(�����f�J���4sR��$��D�4����T�������'�����<�}�x������;� �ʩ�� �l!R��½�<�)��7_����X��BvpT�x���Bdz:�?́LF���L��%�80�{�%s�$S���v�'Xa��B3f���X@?��A�^�#�N�<��`�(�����B�U(.�v1+8c)�}Q�
Q/��+b�f�0:Bw�@���Ok`h��~�Pi��98*)��v+c��^������	�����+w|����� a����־3H bf������~�:�����g� �L\�B*䠏Tp}$�W�[�@�?�������@,,�+D�PmƤ���A����J
C��2�)�v-��Q��3?`W�F�$5�Fͦ?�?T��Y	XȀw�ёP]u"@��!/�i=�AChn�w &XЂ��2s/-��AC6�)���QzVA)p���:؃/hYA���G�C�.!��N(\��)p `S�y3؂?����W��`����c�1�����k؆oH�.�4E�0a��E6 `` ��3(
�� ��0��Sr-
�/�Yx���y�r( ��0a`�8@ ����C�.��-`�ȓ�(�.���E���@�-���)`����� �����|�?�xD��-��x��l��?1�v�g���|��V��.юN1�ѱ=�Dh��x䋨�<H.a��9��X�EȆp�zq-��������h	��:���� 9�|1��`
���4Њ
�0��ȃ
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
































Added library/images/pwrdLogo.eps.



















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
%!PS-Adobe-3.0 EPSF-3.0
%%Creator: Adobe Illustrator(TM) 5.5
%%For: (Bud Northern) (Mark Anderson Design)
%%Title: (TCL PWRD LOGO.ILLUS)
%%CreationDate: (8/1/96) (4:59 PM)
%%BoundingBox: 242 302 377 513
%%HiResBoundingBox: 242.0523 302.5199 376.3322 512.5323
%%DocumentProcessColors: Cyan Magenta Yellow
%%DocumentSuppliedResources: procset Adobe_level2_AI5 1.0 0
%%+ procset Adobe_IllustratorA_AI5 1.0 0
%AI5_FileFormat 1.2
%AI3_ColorUsage: Color
%%CMYKCustomColor: 0 0.45 1 0 (Orange)
%%+ 0 0.25 1 0 (Orange Yellow)
%%+ 0 0.79 0.91 0 (PANTONE Warm Red CV)
%%+ 0 0.79 0.91 0 (TCL RED)
%AI3_TemplateBox: 306 396 306 396
%AI3_TileBox: 12 12 600 780
%AI3_DocumentPreview: Macintosh_ColorPic
%AI5_ArtSize: 612 792
%AI5_RulerUnits: 0
%AI5_ArtFlags: 1 0 0 1 0 0 1 1 0
%AI5_TargetResolution: 800
%AI5_NumLayers: 1
%AI5_OpenToView: 102 564 2 938 673 18 1 1 2 40
%AI5_OpenViewLayers: 7
%%EndComments
%%BeginProlog
%%BeginResource: procset Adobe_level2_AI5 1.0 0
%%Title: (Adobe Illustrator (R) Version 5.0 Level 2 Emulation)
%%Version: 1.0 
%%CreationDate: (04/10/93) ()
%%Copyright: ((C) 1987-1993 Adobe Systems Incorporated All Rights Reserved)
userdict /Adobe_level2_AI5 21 dict dup begin
	put
	/packedarray where not
	{
		userdict begin
		/packedarray
		{
			array astore readonly
		} bind def
		/setpacking /pop load def
		/currentpacking false def
	 end
		0
	} if
	pop
	userdict /defaultpacking currentpacking put true setpacking
	/initialize
	{
		Adobe_level2_AI5 begin
	} bind def
	/terminate
	{
		currentdict Adobe_level2_AI5 eq
		{
		 end
		} if
	} bind def
	mark
	/setcustomcolor where not
	{
		/findcmykcustomcolor
		{
			5 packedarray
		} bind def
		/setcustomcolor
		{
			exch aload pop pop
			4
			{
				4 index mul 4 1 roll
			} repeat
			5 -1 roll pop
			setcmykcolor
		}
		def
	} if
	
	/gt38? mark {version cvx exec} stopped {cleartomark true} {38 gt exch pop} ifelse def
	userdict /deviceDPI 72 0 matrix defaultmatrix dtransform dup mul exch dup mul add sqrt put
	userdict /level2?
	systemdict /languagelevel known dup
	{
		pop systemdict /languagelevel get 2 ge
	} if
	put
	level2? not
	{
		/setcmykcolor where not
		{
			/setcmykcolor
			{
				exch .11 mul add exch .59 mul add exch .3 mul add
				1 exch sub setgray
			} def
		} if
		/currentcmykcolor where not
		{
			/currentcmykcolor
			{
				0 0 0 1 currentgray sub
			} def
		} if
		/setoverprint where not
		{
			/setoverprint /pop load def
		} if
		/selectfont where not
		{
			/selectfont
			{
				exch findfont exch
				dup type /arraytype eq
				{
					makefont
				}
				{
					scalefont
				} ifelse
				setfont
			} bind def
		} if
		/cshow where not
		{
			/cshow
			{
				[
				0 0 5 -1 roll aload pop
				] cvx bind forall
			} bind def
		} if
	} if
	cleartomark
	/anyColor?
	{
		add add add 0 ne
	} bind def
	/testColor
	{
		gsave
		setcmykcolor currentcmykcolor
		grestore
	} bind def
	/testCMYKColorThrough
	{
		testColor anyColor?
	} bind def
	userdict /composite?
	level2?
	{
		gsave 1 1 1 1 setcmykcolor currentcmykcolor grestore
		add add add 4 eq
	}
	{
		1 0 0 0 testCMYKColorThrough
		0 1 0 0 testCMYKColorThrough
		0 0 1 0 testCMYKColorThrough
		0 0 0 1 testCMYKColorThrough
		and and and
	} ifelse
	put
	composite? not
	{
		userdict begin
		gsave
		/cyan? 1 0 0 0 testCMYKColorThrough def
		/magenta? 0 1 0 0 testCMYKColorThrough def
		/yellow? 0 0 1 0 testCMYKColorThrough def
		/black? 0 0 0 1 testCMYKColorThrough def
		grestore
		/isCMYKSep? cyan? magenta? yellow? black? or or or def
		/customColor? isCMYKSep? not def
	 end
	} if
 end defaultpacking setpacking
%%EndResource
%%BeginResource: procset Adobe_IllustratorA_AI5 1.1 0
%%Title: (Adobe Illustrator (R) Version 5.0 Abbreviated Prolog)
%%Version: 1.1 
%%CreationDate: (3/7/1994) ()
%%Copyright: ((C) 1987-1994 Adobe Systems Incorporated All Rights Reserved)
currentpacking true setpacking
userdict /Adobe_IllustratorA_AI5_vars 70 dict dup begin
put
/_lp /none def
/_pf
{
} def
/_ps
{
} def
/_psf
{
} def
/_pss
{
} def
/_pjsf
{
} def
/_pjss
{
} def
/_pola 0 def
/_doClip 0 def
/cf currentflat def
/_tm matrix def
/_renderStart
[
/e0 /r0 /a0 /o0 /e1 /r1 /a1 /i0
] def
/_renderEnd
[
null null null null /i1 /i1 /i1 /i1
] def
/_render -1 def
/_rise 0 def
/_ax 0 def
/_ay 0 def
/_cx 0 def
/_cy 0 def
/_leading
[
0 0
] def
/_ctm matrix def
/_mtx matrix def
/_sp 16#020 def
/_hyphen (-) def
/_fScl 0 def
/_cnt 0 def
/_hs 1 def
/_nativeEncoding 0 def
/_useNativeEncoding 0 def
/_tempEncode 0 def
/_pntr 0 def
/_tDict 2 dict def
/_wv 0 def
/Tx
{
} def
/Tj
{
} def
/CRender
{
} def
/_AI3_savepage
{
} def
/_gf null def
/_cf 4 array def
/_if null def
/_of false def
/_fc
{
} def
/_gs null def
/_cs 4 array def
/_is null def
/_os false def
/_sc
{
} def
/discardSave null def
/buffer 256 string def
/beginString null def
/endString null def
/endStringLength null def
/layerCnt 1 def
/layerCount 1 def
/perCent (%) 0 get def
/perCentSeen? false def
/newBuff null def
/newBuffButFirst null def
/newBuffLast null def
/clipForward? false def
end
userdict /Adobe_IllustratorA_AI5 74 dict dup begin
put
/initialize
{
	Adobe_IllustratorA_AI5 dup begin
	Adobe_IllustratorA_AI5_vars begin
	discardDict
	{
		bind pop pop
	} forall
	dup /nc get begin
	{
		dup xcheck 1 index type /operatortype ne and
		{
			bind
		} if
		pop pop
	} forall
 end
	newpath
} def
/terminate
{
 end
 end
} def
/_
null def
/ddef
{
	Adobe_IllustratorA_AI5_vars 3 1 roll put
} def
/xput
{
	dup load dup length exch maxlength eq
	{
		dup dup load dup
		length 2 mul dict copy def
	} if
	load begin
	def
 end
} def
/npop
{
	{
		pop
	} repeat
} def
/sw
{
	dup length exch stringwidth
	exch 5 -1 roll 3 index mul add
	4 1 roll 3 1 roll mul add
} def
/swj
{
	dup 4 1 roll
	dup length exch stringwidth
	exch 5 -1 roll 3 index mul add
	4 1 roll 3 1 roll mul add
	6 2 roll /_cnt 0 ddef
	{
		1 index eq
		{
			/_cnt _cnt 1 add ddef
		} if
	} forall
	pop
	exch _cnt mul exch _cnt mul 2 index add 4 1 roll 2 index add 4 1 roll pop pop
} def
/ss
{
	4 1 roll
	{
		2 npop
		(0) exch 2 copy 0 exch put pop
		gsave
		false charpath currentpoint
		4 index setmatrix
		stroke
		grestore
		moveto
		2 copy rmoveto
	} exch cshow
	3 npop
} def
/jss
{
	4 1 roll
	{
		2 npop
		(0) exch 2 copy 0 exch put
		gsave
		_sp eq
		{
			exch 6 index 6 index 6 index 5 -1 roll widthshow
			currentpoint
		}
		{
			false charpath currentpoint
			4 index setmatrix stroke
		} ifelse
		grestore
		moveto
		2 copy rmoveto
	} exch cshow
	6 npop
} def
/sp
{
	{
		2 npop (0) exch
		2 copy 0 exch put pop
		false charpath
		2 copy rmoveto
	} exch cshow
	2 npop
} def
/jsp
{
	{
		2 npop
		(0) exch 2 copy 0 exch put
		_sp eq
		{
			exch 5 index 5 index 5 index 5 -1 roll widthshow
		}
		{
			false charpath
		} ifelse
		2 copy rmoveto
	} exch cshow
	5 npop
} def
/pl
{
	transform
	0.25 sub round 0.25 add exch
	0.25 sub round 0.25 add exch
	itransform
} def
/setstrokeadjust where
{
	pop true setstrokeadjust
	/c
	{
		curveto
	} def
	/C
	/c load def
	/v
	{
		currentpoint 6 2 roll curveto
	} def
	/V
	/v load def
	/y
	{
		2 copy curveto
	} def
	/Y
	/y load def
	/l
	{
		lineto
	} def
	/L
	/l load def
	/m
	{
		moveto
	} def
}
{
	/c
	{
		pl curveto
	} def
	/C
	/c load def
	/v
	{
		currentpoint 6 2 roll pl curveto
	} def
	/V
	/v load def
	/y
	{
		pl 2 copy curveto
	} def
	/Y
	/y load def
	/l
	{
		pl lineto
	} def
	/L
	/l load def
	/m
	{
		pl moveto
	} def
} ifelse
/d
{
	setdash
} def
/cf
{
} def
/i
{
	dup 0 eq
	{
		pop cf
	} if
	setflat
} def
/j
{
	setlinejoin
} def
/J
{
	setlinecap
} def
/M
{
	setmiterlimit
} def
/w
{
	setlinewidth
} def
/H
{
} def
/h
{
	closepath
} def
/N
{
	_pola 0 eq
	{
		_doClip 1 eq
		{
			clip /_doClip 0 ddef
		} if
		newpath
	}
	{
		/CRender
		{
			N
		} ddef
	} ifelse
} def
/n
{
	N
} def
/F
{
	_pola 0 eq
	{
		_doClip 1 eq
		{
			gsave _pf grestore clip newpath /_lp /none ddef _fc
			/_doClip 0 ddef
		}
		{
			_pf
		} ifelse
	}
	{
		/CRender
		{
			F
		} ddef
	} ifelse
} def
/f
{
	closepath
	F
} def
/S
{
	_pola 0 eq
	{
		_doClip 1 eq
		{
			gsave _ps grestore clip newpath /_lp /none ddef _sc
			/_doClip 0 ddef
		}
		{
			_ps
		} ifelse
	}
	{
		/CRender
		{
			S
		} ddef
	} ifelse
} def
/s
{
	closepath
	S
} def
/B
{
	_pola 0 eq
	{
		_doClip 1 eq
		gsave F grestore
		{
			gsave S grestore clip newpath /_lp /none ddef _sc
			/_doClip 0 ddef
		}
		{
			S
		} ifelse
	}
	{
		/CRender
		{
			B
		} ddef
	} ifelse
} def
/b
{
	closepath
	B
} def
/W
{
	/_doClip 1 ddef
} def
/*
{
	count 0 ne
	{
		dup type /stringtype eq
		{
			pop
		} if
	} if
	newpath
} def
/u
{
} def
/U
{
} def
/q
{
	_pola 0 eq
	{
		gsave
	} if
} def
/Q
{
	_pola 0 eq
	{
		grestore
	} if
} def
/*u
{
	_pola 1 add /_pola exch ddef
} def
/*U
{
	_pola 1 sub /_pola exch ddef
	_pola 0 eq
	{
		CRender
	} if
} def
/D
{
	pop
} def
/*w
{
} def
/*W
{
} def
/`
{
	/_i save ddef
	clipForward?
	{
		nulldevice
	} if
	6 1 roll 4 npop
	concat pop
	userdict begin
	/showpage
	{
	} def
	0 setgray
	0 setlinecap
	1 setlinewidth
	0 setlinejoin
	10 setmiterlimit
	[] 0 setdash
	/setstrokeadjust where {pop false setstrokeadjust} if
	newpath
	0 setgray
	false setoverprint
} def
/~
{
 end
	_i restore
} def
/O
{
	0 ne
	/_of exch ddef
	/_lp /none ddef
} def
/R
{
	0 ne
	/_os exch ddef
	/_lp /none ddef
} def
/g
{
	/_gf exch ddef
	/_fc
	{
		_lp /fill ne
		{
			_of setoverprint
			_gf setgray
			/_lp /fill ddef
		} if
	} ddef
	/_pf
	{
		_fc
		fill
	} ddef
	/_psf
	{
		_fc
		ashow
	} ddef
	/_pjsf
	{
		_fc
		awidthshow
	} ddef
	/_lp /none ddef
} def
/G
{
	/_gs exch ddef
	/_sc
	{
		_lp /stroke ne
		{
			_os setoverprint
			_gs setgray
			/_lp /stroke ddef
		} if
	} ddef
	/_ps
	{
		_sc
		stroke
	} ddef
	/_pss
	{
		_sc
		ss
	} ddef
	/_pjss
	{
		_sc
		jss
	} ddef
	/_lp /none ddef
} def
/k
{
	_cf astore pop
	/_fc
	{
		_lp /fill ne
		{
			_of setoverprint
			_cf aload pop setcmykcolor
			/_lp /fill ddef
		} if
	} ddef
	/_pf
	{
		_fc
		fill
	} ddef
	/_psf
	{
		_fc
		ashow
	} ddef
	/_pjsf
	{
		_fc
		awidthshow
	} ddef
	/_lp /none ddef
} def
/K
{
	_cs astore pop
	/_sc
	{
		_lp /stroke ne
		{
			_os setoverprint
			_cs aload pop setcmykcolor
			/_lp /stroke ddef
		} if
	} ddef
	/_ps
	{
		_sc
		stroke
	} ddef
	/_pss
	{
		_sc
		ss
	} ddef
	/_pjss
	{
		_sc
		jss
	} ddef
	/_lp /none ddef
} def
/x
{
	/_gf exch ddef
	findcmykcustomcolor
	/_if exch ddef
	/_fc
	{
		_lp /fill ne
		{
			_of setoverprint
			_if _gf 1 exch sub setcustomcolor
			/_lp /fill ddef
		} if
	} ddef
	/_pf
	{
		_fc
		fill
	} ddef
	/_psf
	{
		_fc
		ashow
	} ddef
	/_pjsf
	{
		_fc
		awidthshow
	} ddef
	/_lp /none ddef
} def
/X
{
	/_gs exch ddef
	findcmykcustomcolor
	/_is exch ddef
	/_sc
	{
		_lp /stroke ne
		{
			_os setoverprint
			_is _gs 1 exch sub setcustomcolor
			/_lp /stroke ddef
		} if
	} ddef
	/_ps
	{
		_sc
		stroke
	} ddef
	/_pss
	{
		_sc
		ss
	} ddef
	/_pjss
	{
		_sc
		jss
	} ddef
	/_lp /none ddef
} def
/A
{
	pop
} def
/annotatepage
{
userdict /annotatepage 2 copy known {get exec} {pop pop} ifelse
} def
/discard
{
	save /discardSave exch store
	discardDict begin
	/endString exch store
	gt38?
	{
		2 add
	} if
	load
	stopped
	pop
 end
	discardSave restore
} bind def
userdict /discardDict 7 dict dup begin
put
/pre38Initialize
{
	/endStringLength endString length store
	/newBuff buffer 0 endStringLength getinterval store
	/newBuffButFirst newBuff 1 endStringLength 1 sub getinterval store
	/newBuffLast newBuff endStringLength 1 sub 1 getinterval store
} def
/shiftBuffer
{
	newBuff 0 newBuffButFirst putinterval
	newBuffLast 0
	currentfile read not
	{
	stop
	} if
	put
} def
0
{
	pre38Initialize
	mark
	currentfile newBuff readstring exch pop
	{
		{
			newBuff endString eq
			{
				cleartomark stop
			} if
			shiftBuffer
		} loop
	}
	{
	stop
	} ifelse
} def
1
{
	pre38Initialize
	/beginString exch store
	mark
	currentfile newBuff readstring exch pop
	{
		{
			newBuff beginString eq
			{
				/layerCount dup load 1 add store
			}
			{
				newBuff endString eq
				{
					/layerCount dup load 1 sub store
					layerCount 0 eq
					{
						cleartomark stop
					} if
				} if
			} ifelse
			shiftBuffer
		} loop
	}
	{
	stop
	} ifelse
} def
2
{
	mark
	{
		currentfile buffer readline not
		{
		stop
		} if
		endString eq
		{
			cleartomark stop
		} if
	} loop
} def
3
{
	/beginString exch store
	/layerCnt 1 store
	mark
	{
		currentfile buffer readline not
		{
		stop
		} if
		dup beginString eq
		{
			pop /layerCnt dup load 1 add store
		}
		{
			endString eq
			{
				layerCnt 1 eq
				{
					cleartomark stop
				}
				{
					/layerCnt dup load 1 sub store
				} ifelse
			} if
		} ifelse
	} loop
} def
end
userdict /clipRenderOff 15 dict dup begin
put
{
	/n /N /s /S /f /F /b /B
}
{
	{
		_doClip 1 eq
		{
			/_doClip 0 ddef clip
		} if
		newpath
	} def
} forall
/Tr /pop load def
/Bb {} def
/BB /pop load def
/Bg {12 npop} def
/Bm {6 npop} def
/Bc /Bm load def
/Bh {4 npop} def
end
/Lb
{
	4 npop
	6 1 roll
	pop
	4 1 roll
	pop pop pop
	0 eq
	{
		0 eq
		{
			(%AI5_BeginLayer) 1 (%AI5_EndLayer--) discard
		}
		{
			/clipForward? true def
			
			/Tx /pop load def
			/Tj /pop load def
			currentdict end clipRenderOff begin begin
		} ifelse
	}
	{
		0 eq
		{
			save /discardSave exch store
		} if
	} ifelse
} bind def
/LB
{
	discardSave dup null ne
	{
		restore
	}
	{
		pop
		clipForward?
		{
			currentdict
		 end
		 end
		 begin
			
			/clipForward? false ddef
		} if
	} ifelse
} bind def
/Pb
{
	pop pop
	0 (%AI5_EndPalette) discard
} bind def
/Np
{
	0 (%AI5_End_NonPrinting--) discard
} bind def
/Ln /pop load def
/Ap
/pop load def
/Ar
{
	72 exch div
	0 dtransform dup mul exch dup mul add sqrt
	dup 1 lt
	{
		pop 1
	} if
	setflat
} def
/Mb
{
	q
} def
/Md
{
} def
/MB
{
	Q
} def
/nc 3 dict def
nc begin
/setgray
{
	pop
} bind def
/setcmykcolor
{
	4 npop
} bind def
/setcustomcolor
{
	2 npop
} bind def
currentdict readonly pop
end
currentdict readonly pop
end
setpacking
%%EndResource
%%EndProlog
%%BeginSetup
Adobe_level2_AI5 /initialize get exec
Adobe_IllustratorA_AI5 /initialize get exec
%AI5_Begin_NonPrinting
Np
%AI3_BeginPattern: (Yellow Stripe)
(Yellow Stripe) 8.4499 4.6 80.4499 76.6 [
%AI3_Tile
(0 O 0 R 0 0.4 1 0 k 0 0.4 1 0 K) @
(
800 Ar
0 J 0 j 3.6 w 4 M []0 d
%AI3_Note:
0 D
8.1999 8.1999 m
80.6999 8.1999 L
S
8.1999 22.6 m
80.6999 22.6 L
S
8.1999 37.0001 m
80.6999 37.0001 L
S
8.1999 51.3999 m
80.6999 51.3999 L
S
8.1999 65.8 m
80.6999 65.8 L
S
8.1999 15.3999 m
80.6999 15.3999 L
S
8.1999 29.8 m
80.6999 29.8 L
S
8.1999 44.1999 m
80.6999 44.1999 L
S
8.1999 58.6 m
80.6999 58.6 L
S
8.1999 73.0001 m
80.6999 73.0001 L
S
) &
] E
%AI3_EndPattern
%AI5_End_NonPrinting--
%AI5_Begin_NonPrinting
Np
3 Bn
%AI5_BeginGradient: (Black & White)
(Black & White) 0 2 Bd
[
<
FFFEFDFCFBFAF9F8F7F6F5F4F3F2F1F0EFEEEDECEBEAE9E8E7E6E5E4E3E2E1E0DFDEDDDCDBDAD9D8
D7D6D5D4D3D2D1D0CFCECDCCCBCAC9C8C7C6C5C4C3C2C1C0BFBEBDBCBBBAB9B8B7B6B5B4B3B2B1B0
AFAEADACABAAA9A8A7A6A5A4A3A2A1A09F9E9D9C9B9A999897969594939291908F8E8D8C8B8A8988
87868584838281807F7E7D7C7B7A797877767574737271706F6E6D6C6B6A69686766656463626160
5F5E5D5C5B5A595857565554535251504F4E4D4C4B4A494847464544434241403F3E3D3C3B3A3938
37363534333231302F2E2D2C2B2A292827262524232221201F1E1D1C1B1A19181716151413121110
0F0E0D0C0B0A09080706050403020100
>
0 %_Br
[
0 0 50 100 %_Bs
1 0 50 0 %_Bs
BD
%AI5_EndGradient
%AI5_BeginGradient: (Red & Yellow)
(Red & Yellow) 0 2 Bd
[
0
<
000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F2021222324252627
28292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F404142434445464748494A4B4C4D4E4F
505152535455565758595A5B5C5D5E5F606162636465666768696A6B6C6D6E6F7071727374757677
78797A7B7C7D7E7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F
A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7
C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF
F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF
>
<
FFFFFEFEFDFDFDFCFCFBFBFBFAFAF9F9F9F8F8F7F7F7F6F6F5F5F5F4F4F3F3F3F2F2F1F1F1F0F0EF
EFEFEEEEEDEDEDECECEBEBEBEAEAE9E9E9E8E8E7E7E7E6E6E5E5E5E4E4E3E3E3E2E2E1E1E1E0E0DF
DFDFDEDEDDDDDDDCDCDBDBDBDADAD9D9D9D8D8D7D7D7D6D6D5D5D5D4D4D3D3D3D2D2D1D1D1D0D0CF
CFCFCECECDCDCDCCCCCBCBCBCACAC9C9C9C8C8C7C7C7C6C6C5C5C5C4C4C3C3C3C2C2C1C1C1C0C0BF
BFBFBEBEBDBDBDBCBCBBBBBBBABAB9B9B9B8B8B7B7B7B6B6B5B5B5B4B4B3B3B3B2B2B1B1B1B0B0AF
AFAFAEAEADADADACACABABABAAAAA9A9A9A8A8A7A7A7A6A6A5A5A5A4A4A3A3A3A2A2A1A1A1A0A09F
9F9F9E9E9D9D9D9C9C9B9B9B9A9A9999
>
0
1 %_Br
[
0 1 0.6 0 1 50 100 %_Bs
0 0 1 0 1 50 0 %_Bs
BD
%AI5_EndGradient
%AI5_BeginGradient: (Yellow & Blue Radial)
(Yellow & Blue Radial) 1 2 Bd
[
<
000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F2021222324252627
28292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F404142434445464748494A4B4C4D4E4F
505152535455565758595A5B5C5D5E5F606162636465666768696A6B6C6D6E6F7071727374757677
78797A7B7C7D7E7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F
A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3C4C5C6C7
C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF
F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF
>
<
1415161718191A1B1C1D1E1F1F202122232425262728292A2A2B2C2D2E2F30313233343536363738
393A3B3C3D3E3F40414142434445464748494A4B4C4D4D4E4F50515253545556575858595A5B5C5D
5E5F60616263646465666768696A6B6C6D6E6F6F707172737475767778797A7B7B7C7D7E7F808182
83848586868788898A8B8C8D8E8F90919292939495969798999A9B9C9D9D9E9FA0A1A2A3A4A5A6A7
A8A9A9AAABACADAEAFB0B1B2B3B4B4B5B6B7B8B9BABBBCBDBEBFC0C0C1C2C3C4C5C6C7C8C9CACBCB
CCCDCECFD0D1D2D3D4D5D6D7D7D8D9DADBDCDDDEDFE0E1E2E2E3E4E5E6E7E8E9EAEBECEDEEEEEFF0
F1F2F3F4F5F6F7F8F9F9FAFBFCFDFEFF
>
<
ABAAAAA9A8A7A7A6A5A5A4A3A3A2A1A1A09F9F9E9D9D9C9B9B9A9999989797969595949393929191
908F8F8E8D8D8C8B8B8A8989888787868585848383828181807F7F7E7D7D7C7B7B7A797978777776
7575747373727171706F6F6E6D6D6C6B6B6A6969686767666565646362626160605F5E5E5D5C5C5B
5A5A5958585756565554545352525150504F4E4E4D4C4C4B4A4A4948484746464544444342424140
403F3E3E3D3C3C3B3A3A3938383736363534343332323130302F2E2E2D2C2C2B2A2A292828272626
25242423222121201F1F1E1D1D1C1B1B1A1919181717161515141313121111100F0F0E0D0D0C0B0B
0A090908070706050504030302010100
>
0
1 %_Br
[
0 0.08 0.67 0 1 50 14 %_Bs
1 1 0 0 1 50 100 %_Bs
BD
%AI5_EndGradient
%AI5_End_NonPrinting--
%AI5_BeginPalette
144 161 Pb
Pn
Pc
1 g
Pc
0 g
Pc
0 0 0 0 k
Pc
0.75 g
Pc
0.5 g
Pc
0.25 g
Pc
0 g
Pc
Bb
2 (Black & White) -4014 4716 0 0 1 0 0 1 0 0 Bg
0 BB
Pc
0.25 0 0 0 k
Pc
0.5 0 0 0 k
Pc
0.75 0 0 0 k
Pc
1 0 0 0 k
Pc
0.25 0.25 0 0 k
Pc
0.5 0.5 0 0 k
Pc
0.75 0.75 0 0 k
Pc
1 1 0 0 k
Pc
Bb
2 (Red & Yellow) -4014 4716 0 0 1 0 0 1 0 0 Bg
0 BB
Pc
0 0.25 0 0 k
Pc
0 0.5 0 0 k
Pc
0 0.75 0 0 k
Pc
0 1 0 0 k
Pc
0 0.25 0.25 0 k
Pc
0 0.5 0.5 0 k
Pc
0 0.75 0.75 0 k
Pc
0 1 1 0 k
Pc
Bb
0 0 0 0 Bh
2 (Yellow & Blue Radial) -4014 4716 0 0 1 0 0 1 0 0 Bg
0 BB
Pc
0 0 0.25 0 k
Pc
0 0 0.5 0 k
Pc
0 0 0.75 0 k
Pc
0 0 1 0 k
Pc
0.25 0 0.25 0 k
Pc
0.5 0 0.5 0 k
Pc
0.75 0 0.75 0 k
Pc
1 0 1 0 k
Pc
(Yellow Stripe) 0 0 1 1 0 0 0 0 0 [1 0 0 1 0 0] p
Pc
0.25 0.125 0 0 k
Pc
0.5 0.25 0 0 k
Pc
0.75 0.375 0 0 k
Pc
1 0.5 0 0 k
Pc
0.125 0.25 0 0 k
Pc
0.25 0.5 0 0 k
Pc
0.375 0.75 0 0 k
Pc
0.5 1 0 0 k
Pc
0.375 0.375 0.75 0 k
Pc
0 0.25 0.125 0 k
Pc
0 0.5 0.25 0 k
Pc
0 0.75 0.375 0 k
Pc
0 1 0.5 0 k
Pc
0 0.125 0.25 0 k
Pc
0 0.25 0.5 0 k
Pc
0 0.375 0.75 0 k
Pc
0 0.5 1 0 k
Pc
0 0.79 0.91 0 (PANTONE Warm Red CV) 0 x
Pc
0.125 0 0.25 0 k
Pc
0.25 0 0.5 0 k
Pc
0.375 0 0.75 0 k
Pc
0.5 0 1 0 k
Pc
0.25 0 0.125 0 k
Pc
0.5 0 0.25 0 k
Pc
0.75 0 0.375 0 k
Pc
1 0 0.5 0 k
Pc
0.5 1 0 0 k
Pc
0.25 0.125 0.125 0 k
Pc
0.5 0.25 0.25 0 k
Pc
0.75 0.375 0.375 0 k
Pc
1 0.5 0.5 0 k
Pc
0.25 0.25 0.125 0 k
Pc
0.5 0.5 0.25 0 k
Pc
0.75 0.75 0.375 0 k
Pc
1 1 0.5 0 k
Pc
0 1 0.5 0 k
Pc
0.125 0.25 0.125 0 k
Pc
0.25 0.5 0.25 0 k
Pc
0.375 0.75 0.375 0 k
Pc
0.5 1 0.5 0 k
Pc
0.125 0.25 0.25 0 k
Pc
0.25 0.5 0.5 0 k
Pc
0.375 0.75 0.75 0 k
Pc
0.5 1 1 0 k
Pc
0.75 0.75 0.375 0 k
Pc
0.125 0.125 0.25 0 k
Pc
0.25 0.25 0.5 0 k
Pc
0.375 0.375 0.75 0 k
Pc
0.5 0.5 1 0 k
Pc
0.25 0.125 0.25 0 k
Pc
0.5 0.25 0.5 0 k
Pc
0.75 0.375 0.75 0 k
Pc
1 0.5 1 0 k
Pc
0 0.79 0.91 0 (PANTONE Warm Red CV) 0 x
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
1 0.5 0.5 0 k
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
0 0.25 1 0 (Orange Yellow) 0 x
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
0 1 0.5 0 k
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
1 0 0.5 0 k
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
0 0.45 1 0 (Orange) 0 x
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
0.375 0.375 0.75 0 k
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
0 0.79 0.91 0 (PANTONE Warm Red CV) 0 x
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
1 0.65 0 0 k
Pc
0 0 0 0 k
Pc
Pc
Pc
Pc
Pc
Pc
Pc
Pc
0 0 1 0 k
Pc
PB
%AI5_EndPalette
%%EndSetup
%AI5_BeginLayer
1 1 1 1 0 0 0 79 128 255 Lb
(Layer 1) Ln
0 A
1 Ap
0 O
1 0.65 0 0 k
800 Ar
0 J 0 j 1 w 4 M []0 d
%AI3_Note:
0 D
285.0121 311.7976 m
357.5043 302.5199 L
361.6071 392.7105 L
376.3322 474.1377 L
342.6527 475.6628 L
327.6333 483.4165 L
258.8269 486.3189 L
254.4361 405.0427 L
242.0523 312.2099 L
285.0121 311.7976 L
f
0 0.79 0.91 0 k
1.25 w
295.4466 337.6172 m
368.4943 335.3343 L
363.9288 425.5026 L
370.7771 507.9667 L
337.1066 506.2547 L
321.4128 512.5323 L
252.6452 508.8228 L
256.0692 427.5002 L
252.6452 333.9077 L
295.4466 337.6172 L
f
u
0 Ap
1 0.65 0 0 k
1 w
320.532 390.6149 m
312.9017 388.534 l
317.0637 398.5921 l
321.2256 426.6854 l
316.0232 427.7258 l
322.2662 436.3965 l
330.0436 465.6249 l
316.3701 462.7557 l
323.5798 475.9563 331.2311 484.5534 v
321.2256 492.2363 l
288.9913 478.0373 297.6622 431.9088 v
290.9988 433.0755 l
297.3888 384.7188 l
291.9867 383.3315 l
297.5214 372.0383 305.2714 366.6837 v
305.9749 366.1976 295.5601 404.4882 306.6587 442.6395 c
307.6992 440.2117 l
298.855 399.5459 307.6992 366.6837 v
308.1064 365.9033 312.5286 366.4235 v
320.532 381.5106 320.532 390.6149 v
f
u
*u
1 g
263.6948 355.9856 m
265.2612 355.9856 L
265.2612 359.2513 L
265.9515 359.2513 266.6153 359.2513 267.2791 359.3575 c
267.2791 355.9856 L
269.6155 355.9856 L
269.6155 355.3749 L
267.2791 355.3749 L
267.2791 347.2505 L
267.2791 346.7726 267.2791 346.0558 268.288 346.0558 c
268.9783 346.0558 269.35 346.5337 269.7748 347.0381 c
270.1996 346.7461 L
269.6951 345.7372 268.3942 345.1265 267.3322 345.1265 c
265.4205 345.1265 265.2081 346.162 265.2081 347.4364 c
265.2081 355.3749 L
263.6948 355.3749 L
263.6948 355.9856 l
f
*U
*u
285.7796 348.7639 m
285.1689 346.8788 284.1069 345.2327 281.3457 345.1265 c
277.2304 345.1265 275.9825 348.5515 275.9825 350.3835 c
275.9825 355.1094 279.7792 356.2511 281.2926 356.2511 c
283.0184 356.2511 285.461 355.4546 285.461 353.4102 c
285.461 352.6934 285.0096 352.003 284.2662 352.003 c
283.5494 352.003 283.0184 352.481 283.0184 353.2509 c
283.0184 354.2864 283.868 354.4191 283.868 354.7112 c
283.868 355.428 282.1953 355.7201 281.6112 355.7201 c
279.0624 355.7201 278.3986 353.8616 278.3986 350.3835 c
278.3986 348.7905 278.7969 347.5691 278.9562 347.1974 c
279.3544 346.3213 280.1775 345.7637 281.5581 345.6841 c
283.098 345.6044 284.5848 346.8523 285.222 348.7639 C
285.7796 348.7639 l
f
*U
*u
291.9344 345.4717 m
291.9344 346.0823 L
293.9788 346.0823 L
293.9788 363.1542 L
291.9344 363.1542 L
291.9344 363.7648 L
293.0761 363.7648 L
294.0585 363.7648 295.0939 363.8179 296.0497 364.0038 c
296.0497 346.0823 L
298.0941 346.0823 L
298.0941 345.4717 L
291.9344 345.4717 l
f
*U
u
310.0634 446.075 m
305.3828 425.2059 306.7298 391.3708 v
307.1338 381.222 308.2436 371.8929 309.5993 363.8029 C
309.6066 363.8025 L
310.4883 356.6987 311.0781 354.1272 313.3768 345.5676 C
313.2426 340.0473 L
294.8367 398.8155 310.0634 446.075 V
f
321.3622 464.1699 m
325.5016 466.2317 331.4359 466.9819 v
337.9224 455.0924 321.9584 434.793 v
331.4821 456.0522 329.2358 462.7122 v
326.7243 464.2727 321.3622 464.1699 v
f
319.4002 428.4819 m
323.1177 427.6214 324.9024 429.0668 v
321.386 415.3445 322.3077 407.7964 v
323.2297 400.2483 316.5788 395.4159 y
322.2441 402.584 320.4635 408.4226 v
319.2289 412.4694 320.6101 422.8271 322.1681 426.1155 c
320.7131 426.3196 319.4002 428.4819 v
f
315.7246 392.3281 m
321.8677 393.0631 322.5131 396.1662 v
323.265 377.6058 314.7299 369.9571 v
321.2425 380.1152 320.2206 390.6235 v
315.7246 392.3281 l
f
298.4445 384.6023 m
296.4635 382.3836 290.5192 387.2778 v
292.4131 374.803 304.1781 369.0924 v
296.0814 375.1928 293.9 381.7824 v
296.7611 382.6245 298.4445 384.6023 v
f
296.5483 389.3335 m
288.5102 409.7356 290.2325 437.3036 v
292.1098 432.3112 298.1424 430.5604 v
295.3003 429.9794 293.6387 430.2313 v
289.4335 418.5932 296.5483 389.3335 v
f
330.3126 484.1353 m
327.3003 506.2722 308.4549 483.8853 v
293.4491 466.0592 295.2373 450.9247 296.1578 442.4811 c
296.3932 440.3206 293.366 465.0316 309.8067 481.2933 c
326.2471 497.5553 329.9609 485.0794 330.3126 484.1353 c
f
U
0 0 1 0 k
302.5528 503.0164 m
287.7656 507.2395 283.0593 458.227 v
279.4282 473.3549 288.8204 494.7509 v
298.2122 516.1468 302.5528 503.0164 y
f
284.2076 506.5994 m
276.6655 495.2557 278.3767 483.1729 v
272.6565 505.9183 284.2076 506.5994 v
f
339.7135 474.7902 m
348.6321 478.0799 335.8615 444.8834 v
342.4718 454.5848 346.6326 469.8253 v
349.303 479.6062 339.7135 474.7902 y
f
354.1382 477.3767 m
360.4435 471.669 355.9752 464.1187 v
367.1908 475.904 354.1382 477.3767 v
f
U
U
*u
1 g
258.2029 317.4593 m
256.6821 317.4593 L
256.6821 325.2598 L
258.7512 325.2598 L
260.3858 325.2598 261.4514 324.608 261.4514 322.839 c
261.4514 321.1837 260.5513 320.3767 258.9581 320.3767 c
258.2029 320.3767 L
258.2029 317.4593 l
f
1 D
258.2029 321.6389 m
258.5132 321.6389 L
259.4133 321.6389 259.8995 321.8354 259.8995 322.8493 c
259.8995 323.8528 259.3202 323.9976 258.4719 323.9976 c
258.2029 323.9976 L
258.2029 321.6389 l
f
*U
*u
0 D
269.0694 321.3699 m
269.0694 323.5528 270.6523 325.4667 272.9283 325.4667 c
275.2043 325.4667 276.7871 323.5528 276.7871 321.3699 c
276.7871 319.1353 275.2043 317.2524 272.9283 317.2524 c
270.6523 317.2524 269.0694 319.1353 269.0694 321.3699 c
f
1 D
270.6419 321.432 m
270.6419 320.2526 271.6351 318.7525 272.9283 318.7525 c
274.2215 318.7525 275.2146 320.2526 275.2146 321.432 c
275.2146 322.6941 274.2628 323.9666 272.9283 323.9666 c
271.5937 323.9666 270.6419 322.6941 270.6419 321.432 c
f
*U
*u
0 D
287.2943 319.9422 m
287.315 319.9422 L
288.8668 325.3632 L
289.7668 325.3632 L
291.3807 319.9422 L
291.4014 319.9422 L
292.9326 325.2598 L
294.5258 325.2598 L
291.8877 317.3041 L
290.7704 317.3041 L
289.2185 322.4044 L
289.1978 322.4044 L
287.7288 317.3041 L
286.6115 317.3041 L
284.1286 325.2598 L
285.7218 325.2598 L
287.2943 319.9422 l
f
*U
*u
303.7595 323.9356 m
303.7595 322.2182 L
306.1803 322.2182 L
306.1803 320.894 L
303.7595 320.894 L
303.7595 318.7835 L
306.2734 318.7835 L
306.2734 317.4593 L
302.2387 317.4593 L
302.2387 325.2598 L
306.2734 325.2598 L
306.2734 323.9356 L
303.7595 323.9356 l
f
*U
*u
319.8602 317.4593 m
318.0187 317.4593 L
316.1255 320.6043 L
316.1048 320.6043 L
316.1048 317.4593 L
314.5841 317.4593 L
314.5841 325.2598 L
316.6428 325.2598 L
318.1843 325.2598 319.2499 324.577 319.2499 322.9114 c
319.2499 321.9182 318.7015 320.925 317.6567 320.7492 C
319.8602 317.4593 l
f
1 D
316.1048 321.6699 m
316.3014 321.6699 L
317.1394 321.6699 317.7291 321.9182 317.7291 322.87 c
317.7291 323.8321 317.1187 324.0183 316.3117 324.0183 c
316.1048 324.0183 L
316.1048 321.6699 l
f
*U
*u
0 D
329.1754 323.9356 m
329.1754 322.2182 L
331.5962 322.2182 L
331.5962 320.894 L
329.1754 320.894 L
329.1754 318.7835 L
331.6894 318.7835 L
331.6894 317.4593 L
327.6546 317.4593 L
327.6546 325.2598 L
331.6894 325.2598 L
331.6894 323.9356 L
329.1754 323.9356 l
f
*U
*u
340 325.2598 m
342.1725 325.2598 L
344.4279 325.2598 345.9383 323.5735 345.9383 321.3492 c
345.9383 319.156 344.3865 317.4593 342.1622 317.4593 c
340 317.4593 L
340 325.2598 l
f
1 D
341.5208 318.7835 m
341.7691 318.7835 L
343.6416 318.7835 344.3658 319.8181 344.3658 321.3596 c
344.3658 323.0562 343.4968 323.9356 341.7691 323.9356 c
341.5208 323.9356 L
341.5208 318.7835 l
f
*U
LB
%AI5_EndLayer--
%%PageTrailer
gsave annotatepage grestore showpage
%%Trailer
Adobe_IllustratorA_AI5 /terminate get exec
Adobe_level2_AI5 /terminate get exec
%%EOF

Changes to library/images/pwrdLogo100.gif.

cannot compute difference between binary files

Changes to library/images/pwrdLogo150.gif.

cannot compute difference between binary files

Changes to library/images/pwrdLogo175.gif.

cannot compute difference between binary files

Changes to library/images/pwrdLogo200.gif.

cannot compute difference between binary files

Changes to library/images/pwrdLogo75.gif.

cannot compute difference between binary files

Added library/images/tai-ku.gif.

cannot compute difference between binary files

Changes to library/listbox.tcl.

1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
# listbox.tcl --
#
# This file defines the default bindings for Tk listbox widgets
# and provides procedures that help in implementing those bindings.
#
# SCCS: @(#) listbox.tcl 1.21 97/06/10 17:13:55
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.

#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#--------------------------------------------------------------------------
# tkPriv elements used in this file:
#





|



>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
# listbox.tcl --
#
# This file defines the default bindings for Tk listbox widgets
# and provides procedures that help in implementing those bindings.
#
# RCS: @(#) $Id: listbox.tcl,v 1.1.4.4 1999/04/06 03:52:54 stanton Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#--------------------------------------------------------------------------
# tkPriv elements used in this file:
#
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
# Note: the check for existence of %W below is because this binding
# is sometimes invoked after a window has been deleted (e.g. because
# there is a double-click binding on the widget that deletes it).  Users
# can put "break"s in their bindings to avoid the error, but this check
# makes that unnecessary.

bind Listbox <1> {
    if [winfo exists %W] {
	tkListboxBeginSelect %W [%W index @%x,%y]
    }
}

# Ignore double clicks so that users can define their own behaviors.
# Among other things, this prevents errors if the user deletes the
# listbox on a double click.







|







30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
# Note: the check for existence of %W below is because this binding
# is sometimes invoked after a window has been deleted (e.g. because
# there is a double-click binding on the widget that deletes it).  Users
# can put "break"s in their bindings to avoid the error, but this check
# makes that unnecessary.

bind Listbox <1> {
    if {[winfo exists %W]} {
	tkListboxBeginSelect %W [%W index @%x,%y]
    }
}

# Ignore double clicks so that users can define their own behaviors.
# Among other things, this prevents errors if the user deletes the
# listbox on a double click.
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
    %W xview moveto 1
}
bind Listbox <Control-Home> {
    %W activate 0
    %W see 0
    %W selection clear 0 end
    %W selection set 0

}
bind Listbox <Shift-Control-Home> {
    tkListboxDataExtend %W 0
}
bind Listbox <Control-End> {
    %W activate end
    %W see end
    %W selection clear 0 end
    %W selection set end

}
bind Listbox <Shift-Control-End> {
    tkListboxDataExtend %W [%W index end]
}
bind Listbox <<Copy>> {
    if {[selection own -displayof %W] == "%W"} {
	clipboard clear -displayof %W
	clipboard append -displayof %W [selection get -displayof %W]
    }
}
bind Listbox <space> {
    tkListboxBeginSelect %W [%W index active]
}







>









>





|







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
    %W xview moveto 1
}
bind Listbox <Control-Home> {
    %W activate 0
    %W see 0
    %W selection clear 0 end
    %W selection set 0
    event generate %W <<ListboxSelect>>
}
bind Listbox <Shift-Control-Home> {
    tkListboxDataExtend %W 0
}
bind Listbox <Control-End> {
    %W activate end
    %W see end
    %W selection clear 0 end
    %W selection set end
    event generate %W <<ListboxSelect>>
}
bind Listbox <Shift-Control-End> {
    tkListboxDataExtend %W [%W index end]
}
bind Listbox <<Copy>> {
    if {![string compare [selection own -displayof %W] "%W"]} {
	clipboard clear -displayof %W
	clipboard append -displayof %W [selection get -displayof %W]
    }
}
bind Listbox <space> {
    tkListboxBeginSelect %W [%W index active]
}
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
bind Listbox <Escape> {
    tkListboxCancel %W
}
bind Listbox <Control-slash> {
    tkListboxSelectAll %W
}
bind Listbox <Control-backslash> {
    if {[%W cget -selectmode] != "browse"} {
	%W selection clear 0 end

    }
}

# Additional Tk bindings that aren't part of the Motif look and feel:

bind Listbox <2> {
    %W scan mark %x %y
}
bind Listbox <B2-Motion> {
    %W scan dragto %x %y
}









# tkListboxBeginSelect --
#
# This procedure is typically invoked on button-1 presses.  It begins
# the process of making a selection in the listbox.  Its exact behavior
# depends on the selection mode currently in effect for the listbox;
# see the Motif documentation for details.
#
# Arguments:
# w -		The listbox widget.
# el -		The element for the selection operation (typically the
#		one under the pointer).  Must be in numerical form.

proc tkListboxBeginSelect {w el} {
    global tkPriv
    if {[$w cget -selectmode]  == "multiple"} {
	if [$w selection includes $el] {
	    $w selection clear $el
	} else {
	    $w selection set $el
	}
    } else {
	$w selection clear 0 end
	$w selection set $el
	$w selection anchor $el
	set tkPriv(listboxSelection) {}
	set tkPriv(listboxPrev) $el
    }

}

# tkListboxMotion --
#
# This procedure is called to process mouse motion events while
# button 1 is down.  It may move or extend the selection, depending
# on the listbox's selection mode.







|

>











>
>
>
>
>
>
>
>















|
|











>







156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
bind Listbox <Escape> {
    tkListboxCancel %W
}
bind Listbox <Control-slash> {
    tkListboxSelectAll %W
}
bind Listbox <Control-backslash> {
    if {[string compare [%W cget -selectmode] "browse"]} {
	%W selection clear 0 end
      event generate %W <<ListboxSelect>>
    }
}

# Additional Tk bindings that aren't part of the Motif look and feel:

bind Listbox <2> {
    %W scan mark %x %y
}
bind Listbox <B2-Motion> {
    %W scan dragto %x %y
}

# The MouseWheel will typically only fire on Windows.  However,
# someone could use the "event generate" command to produce one
# on other platforms.

bind Listbox <MouseWheel> {
    %W yview scroll [expr {- (%D / 120) * 4}] units
}

# tkListboxBeginSelect --
#
# This procedure is typically invoked on button-1 presses.  It begins
# the process of making a selection in the listbox.  Its exact behavior
# depends on the selection mode currently in effect for the listbox;
# see the Motif documentation for details.
#
# Arguments:
# w -		The listbox widget.
# el -		The element for the selection operation (typically the
#		one under the pointer).  Must be in numerical form.

proc tkListboxBeginSelect {w el} {
    global tkPriv
    if {![string compare [$w cget -selectmode] "multiple"]} {
	if {[$w selection includes $el]} {
	    $w selection clear $el
	} else {
	    $w selection set $el
	}
    } else {
	$w selection clear 0 end
	$w selection set $el
	$w selection anchor $el
	set tkPriv(listboxSelection) {}
	set tkPriv(listboxPrev) $el
    }
    event generate $w <<ListboxSelect>>
}

# tkListboxMotion --
#
# This procedure is called to process mouse motion events while
# button 1 is down.  It may move or extend the selection, depending
# on the listbox's selection mode.
217
218
219
220
221
222
223

224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246

247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297

298
299
300
301
302
303
304
    }
    set anchor [$w index anchor]
    switch [$w cget -selectmode] {
	browse {
	    $w selection clear 0 end
	    $w selection set $el
	    set tkPriv(listboxPrev) $el

	}
	extended {
	    set i $tkPriv(listboxPrev)
	    if [$w selection includes anchor] {
		$w selection clear $i $el
		$w selection set anchor $el
	    } else {
		$w selection clear $i $el
		$w selection clear anchor $el
	    }
	    while {($i < $el) && ($i < $anchor)} {
		if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {
		    $w selection set $i
		}
		incr i
	    }
	    while {($i > $el) && ($i > $anchor)} {
		if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {
		    $w selection set $i
		}
		incr i -1
	    }
	    set tkPriv(listboxPrev) $el

	}
    }
}

# tkListboxBeginExtend --
#
# This procedure is typically invoked on shift-button-1 presses.  It
# begins the process of extending a selection in the listbox.  Its
# exact behavior depends on the selection mode currently in effect
# for the listbox;  see the Motif documentation for details.
#
# Arguments:
# w -		The listbox widget.
# el -		The element for the selection operation (typically the
#		one under the pointer).  Must be in numerical form.

proc tkListboxBeginExtend {w el} {
    if {[$w cget -selectmode] == "extended"} {
	if {[$w selection includes anchor]} {
	    tkListboxMotion $w $el
	} else {
	    # No selection yet; simulate the begin-select operation.

	    tkListboxBeginSelect $w $el
	}
    }
}

# tkListboxBeginToggle --
#
# This procedure is typically invoked on control-button-1 presses.  It
# begins the process of toggling a selection in the listbox.  Its
# exact behavior depends on the selection mode currently in effect
# for the listbox;  see the Motif documentation for details.
#
# Arguments:
# w -		The listbox widget.
# el -		The element for the selection operation (typically the
#		one under the pointer).  Must be in numerical form.

proc tkListboxBeginToggle {w el} {
    global tkPriv
    if {[$w cget -selectmode] == "extended"} {
	set tkPriv(listboxSelection) [$w curselection]
	set tkPriv(listboxPrev) $el
	$w selection anchor $el
	if [$w selection includes $el] {
	    $w selection clear $el
	} else {
	    $w selection set $el
	}

    }
}

# tkListboxAutoScan --
# This procedure is invoked when the mouse leaves an entry window
# with button 1 down.  It scrolls the window up, down, left, or
# right, depending on where the mouse left the window, and reschedules







>



|



















>

















|




<



















|



|




>







230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283

284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
    }
    set anchor [$w index anchor]
    switch [$w cget -selectmode] {
	browse {
	    $w selection clear 0 end
	    $w selection set $el
	    set tkPriv(listboxPrev) $el
          event generate $w <<ListboxSelect>>
	}
	extended {
	    set i $tkPriv(listboxPrev)
	    if {[$w selection includes anchor]} {
		$w selection clear $i $el
		$w selection set anchor $el
	    } else {
		$w selection clear $i $el
		$w selection clear anchor $el
	    }
	    while {($i < $el) && ($i < $anchor)} {
		if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {
		    $w selection set $i
		}
		incr i
	    }
	    while {($i > $el) && ($i > $anchor)} {
		if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {
		    $w selection set $i
		}
		incr i -1
	    }
	    set tkPriv(listboxPrev) $el
          event generate $w <<ListboxSelect>>
	}
    }
}

# tkListboxBeginExtend --
#
# This procedure is typically invoked on shift-button-1 presses.  It
# begins the process of extending a selection in the listbox.  Its
# exact behavior depends on the selection mode currently in effect
# for the listbox;  see the Motif documentation for details.
#
# Arguments:
# w -		The listbox widget.
# el -		The element for the selection operation (typically the
#		one under the pointer).  Must be in numerical form.

proc tkListboxBeginExtend {w el} {
    if {![string compare [$w cget -selectmode] "extended"]} {
	if {[$w selection includes anchor]} {
	    tkListboxMotion $w $el
	} else {
	    # No selection yet; simulate the begin-select operation.

	    tkListboxBeginSelect $w $el
	}
    }
}

# tkListboxBeginToggle --
#
# This procedure is typically invoked on control-button-1 presses.  It
# begins the process of toggling a selection in the listbox.  Its
# exact behavior depends on the selection mode currently in effect
# for the listbox;  see the Motif documentation for details.
#
# Arguments:
# w -		The listbox widget.
# el -		The element for the selection operation (typically the
#		one under the pointer).  Must be in numerical form.

proc tkListboxBeginToggle {w el} {
    global tkPriv
    if {![string compare [$w cget -selectmode] "extended"]} {
	set tkPriv(listboxSelection) [$w curselection]
	set tkPriv(listboxPrev) $el
	$w selection anchor $el
	if {[$w selection includes $el]} {
	    $w selection clear $el
	} else {
	    $w selection set $el
	}
      event generate $w <<ListboxSelect>>
    }
}

# tkListboxAutoScan --
# This procedure is invoked when the mouse leaves an entry window
# with button 1 down.  It scrolls the window up, down, left, or
# right, depending on where the mouse left the window, and reschedules
336
337
338
339
340
341
342
343
344
345
346
347
348

349
350
351
352
353
354
355

356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432

433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451

452
#
# Arguments:
# w -		The listbox widget.
# amount -	+1 to move down one item, -1 to move back one item.

proc tkListboxUpDown {w amount} {
    global tkPriv
    $w activate [expr [$w index active] + $amount]
    $w see active
    switch [$w cget -selectmode] {
	browse {
	    $w selection clear 0 end
	    $w selection set active

	}
	extended {
	    $w selection clear 0 end
	    $w selection set active
	    $w selection anchor active
	    set tkPriv(listboxPrev) [$w index active]
	    set tkPriv(listboxSelection) {}

	}
    }
}

# tkListboxExtendUpDown --
#
# Does nothing unless we're in extended selection mode;  in this
# case it moves the location cursor (active element) up or down by
# one element, and extends the selection to that point.
#
# Arguments:
# w -		The listbox widget.
# amount -	+1 to move down one item, -1 to move back one item.

proc tkListboxExtendUpDown {w amount} {
    if {[$w cget -selectmode] != "extended"} {
	return
    }
    $w activate [expr [$w index active] + $amount]
    $w see active
    tkListboxMotion $w [$w index active]
}

# tkListboxDataExtend
#
# This procedure is called for key-presses such as Shift-KEndData.
# If the selection mode isn't multiple or extend then it does nothing.
# Otherwise it moves the active element to el and, if we're in
# extended mode, extends the selection to that point.
#
# Arguments:
# w -		The listbox widget.
# el -		An integer element number.

proc tkListboxDataExtend {w el} {
    set mode [$w cget -selectmode]
    if {$mode == "extended"} {
	$w activate $el
	$w see $el
        if [$w selection includes anchor] {
	    tkListboxMotion $w $el
	}
    } elseif {$mode == "multiple"} {
	$w activate $el
	$w see $el
    }
}

# tkListboxCancel
#
# This procedure is invoked to cancel an extended selection in
# progress.  If there is an extended selection in progress, it
# restores all of the items between the active one and the anchor
# to their previous selection state.
#
# Arguments:
# w -		The listbox widget.

proc tkListboxCancel w {
    global tkPriv
    if {[$w cget -selectmode] != "extended"} {
	return
    }
    set first [$w index anchor]
    set last $tkPriv(listboxPrev)
    if {$first > $last} {
	set tmp $first
	set first $last
	set last $tmp
    }
    $w selection clear $first $last
    while {$first <= $last} {
	if {[lsearch $tkPriv(listboxSelection) $first] >= 0} {
	    $w selection set $first
	}
	incr first
    }

}

# tkListboxSelectAll
#
# This procedure is invoked to handle the "select all" operation.
# For single and browse mode, it just selects the active element.
# Otherwise it selects everything in the widget.
#
# Arguments:
# w -		The listbox widget.

proc tkListboxSelectAll w {
    set mode [$w cget -selectmode]
    if {($mode == "single") || ($mode == "browse")} {
	$w selection clear 0 end
	$w selection set active
    } else {
	$w selection set 0 end
    }

}







|





>







>















|


|

















|


|


|

















|
















>













|





>

351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
#
# Arguments:
# w -		The listbox widget.
# amount -	+1 to move down one item, -1 to move back one item.

proc tkListboxUpDown {w amount} {
    global tkPriv
    $w activate [expr {[$w index active] + $amount}]
    $w see active
    switch [$w cget -selectmode] {
	browse {
	    $w selection clear 0 end
	    $w selection set active
          event generate $w <<ListboxSelect>>
	}
	extended {
	    $w selection clear 0 end
	    $w selection set active
	    $w selection anchor active
	    set tkPriv(listboxPrev) [$w index active]
	    set tkPriv(listboxSelection) {}
          event generate $w <<ListboxSelect>>
	}
    }
}

# tkListboxExtendUpDown --
#
# Does nothing unless we're in extended selection mode;  in this
# case it moves the location cursor (active element) up or down by
# one element, and extends the selection to that point.
#
# Arguments:
# w -		The listbox widget.
# amount -	+1 to move down one item, -1 to move back one item.

proc tkListboxExtendUpDown {w amount} {
    if {[string compare [$w cget -selectmode] "extended"]} {
	return
    }
    $w activate [expr {[$w index active] + $amount}]
    $w see active
    tkListboxMotion $w [$w index active]
}

# tkListboxDataExtend
#
# This procedure is called for key-presses such as Shift-KEndData.
# If the selection mode isn't multiple or extend then it does nothing.
# Otherwise it moves the active element to el and, if we're in
# extended mode, extends the selection to that point.
#
# Arguments:
# w -		The listbox widget.
# el -		An integer element number.

proc tkListboxDataExtend {w el} {
    set mode [$w cget -selectmode]
    if {![string compare $mode "extended"]} {
	$w activate $el
	$w see $el
        if {[$w selection includes anchor]} {
	    tkListboxMotion $w $el
	}
    } elseif {![string compare $mode "multiple"]} {
	$w activate $el
	$w see $el
    }
}

# tkListboxCancel
#
# This procedure is invoked to cancel an extended selection in
# progress.  If there is an extended selection in progress, it
# restores all of the items between the active one and the anchor
# to their previous selection state.
#
# Arguments:
# w -		The listbox widget.

proc tkListboxCancel w {
    global tkPriv
    if {[string compare [$w cget -selectmode] "extended"]} {
	return
    }
    set first [$w index anchor]
    set last $tkPriv(listboxPrev)
    if {$first > $last} {
	set tmp $first
	set first $last
	set last $tmp
    }
    $w selection clear $first $last
    while {$first <= $last} {
	if {[lsearch $tkPriv(listboxSelection) $first] >= 0} {
	    $w selection set $first
	}
	incr first
    }
    event generate $w <<ListboxSelect>>
}

# tkListboxSelectAll
#
# This procedure is invoked to handle the "select all" operation.
# For single and browse mode, it just selects the active element.
# Otherwise it selects everything in the widget.
#
# Arguments:
# w -		The listbox widget.

proc tkListboxSelectAll w {
    set mode [$w cget -selectmode]
    if {![string compare $mode "single"] || ![string compare $mode "browse"]} {
	$w selection clear 0 end
	$w selection set active
    } else {
	$w selection set 0 end
    }
    event generate $w <<ListboxSelect>>
}

Changes to library/menu.tcl.

1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
# menu.tcl --
#
# This file defines the default bindings for Tk menus and menubuttons.
# It also implements keyboard traversal of menus and implements a few
# other utility procedures related to menus.
#
# SCCS: @(#) menu.tcl 1.103 97/10/31 15:26:08
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.

#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# Elements of tkPriv that are used in this file:






|



>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
# menu.tcl --
#
# This file defines the default bindings for Tk menus and menubuttons.
# It also implements keyboard traversal of menus and implements a few
# other utility procedures related to menus.
#
# RCS: @(#) $Id: menu.tcl,v 1.1.4.6 1999/04/06 03:52:55 stanton Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# Elements of tkPriv that are used in this file:
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
bind Menubutton <Enter> {
    tkMbEnter %W
}
bind Menubutton <Leave> {
    tkMbLeave %W
}
bind Menubutton <1> {
    if {$tkPriv(inMenubutton) != ""} {
	tkMbPost $tkPriv(inMenubutton) %X %Y
    }
}
bind Menubutton <Motion> {
    tkMbMotion %W up %X %Y
}
bind Menubutton <B1-Motion> {







|







86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
bind Menubutton <Enter> {
    tkMbEnter %W
}
bind Menubutton <Leave> {
    tkMbLeave %W
}
bind Menubutton <1> {
    if {[string compare $tkPriv(inMenubutton) ""]} {
	tkMbPost $tkPriv(inMenubutton) %X %Y
    }
}
bind Menubutton <Motion> {
    tkMbMotion %W up %X %Y
}
bind Menubutton <B1-Motion> {
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
# a cascaded chain of menus, after the focus has already been
# restored to wherever it was before menu selection started.

bind Menu <FocusIn> {}

bind Menu <Enter> {
    set tkPriv(window) %W
    if {[%W cget -type] == "tearoff"} {
	if {"%m" != "NotifyUngrab"} {
	    if {$tcl_platform(platform) == "unix"} {
		tk_menuSetFocus %W
	    }
	}
    }
    tkMenuMotion %W %x %y %s
}








|
|
|







115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
# a cascaded chain of menus, after the focus has already been
# restored to wherever it was before menu selection started.

bind Menu <FocusIn> {}

bind Menu <Enter> {
    set tkPriv(window) %W
    if {![string compare [%W cget -type] "tearoff"]} {
      if {[string compare "%m" "NotifyUngrab"]} {
          if {![string compare $tcl_platform(platform) "unix"]} {
		tk_menuSetFocus %W
	    }
	}
    }
    tkMenuMotion %W %x %y %s
}

164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
bind Menu <KeyPress> {
    tkTraverseWithinMenu %W %A
}

# The following bindings apply to all windows, and are used to
# implement keyboard menu traversal.

if {$tcl_platform(platform) == "unix"} {
    bind all <Alt-KeyPress> {
	tkTraverseToMenu %W %A
    }

    bind all <F10> {
	tkFirstMenu %W
    }







|







165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
bind Menu <KeyPress> {
    tkTraverseWithinMenu %W %A
}

# The following bindings apply to all windows, and are used to
# implement keyboard menu traversal.

if {![string compare $tcl_platform(platform) "unix"]} {
    bind all <Alt-KeyPress> {
	tkTraverseToMenu %W %A
    }

    bind all <F10> {
	tkFirstMenu %W
    }
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244

245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
#
# Arguments:
# w -			The  name of the widget.

proc tkMbEnter w {
    global tkPriv

    if {$tkPriv(inMenubutton) != ""} {
	tkMbLeave $tkPriv(inMenubutton)
    }
    set tkPriv(inMenubutton) $w
    if {[$w cget -state] != "disabled"} {
	$w configure -state active
    }
}

# tkMbLeave --
# This procedure is invoked when the mouse leaves a menubutton widget.
# It de-activates the widget, if the widget still exists.
#
# Arguments:
# w -			The  name of the widget.

proc tkMbLeave w {
    global tkPriv

    set tkPriv(inMenubutton) {}
    if ![winfo exists $w] {
	return
    }
    if {[$w cget -state] == "active"} {
	$w configure -state normal
    }
}

# tkMbPost --
# Given a menubutton, this procedure does all the work of posting
# its associated menu and unposting any other menu that is currently
# posted.
#
# Arguments:
# w -			The name of the menubutton widget whose menu
#			is to be posted.
# x, y -		Root coordinates of cursor, used for positioning
#			option menus.  If not specified, then the center
#			of the menubutton is used for an option menu.

proc tkMbPost {w {x {}} {y {}}} {
    global tkPriv errorInfo
    global tcl_platform


    if {([$w cget -state] == "disabled") || ($w == $tkPriv(postedMb))} {
	return
    }
    set menu [$w cget -menu]
    if {$menu == ""} {
	return
    }
    set tearoff [expr {($tcl_platform(platform) == "unix") \
		     || ([$menu cget -type] == "tearoff")}]
    if {[string first $w $menu] != 0} {
	error "can't post $menu:  it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)"
    }
    set cur $tkPriv(postedMb)
    if {$cur != ""} {
	tkMenuUnpost {}
    }
    set tkPriv(cursor) [$w cget -cursor]
    set tkPriv(relief) [$w cget -relief]
    $w configure -cursor arrow
    $w configure -relief raised

    set tkPriv(postedMb) $w
    set tkPriv(focus) [focus]
    $menu activate none
    tkGenerateMenuSelect $menu

    # If this looks like an option menubutton then post the menu so
    # that the current entry is on top of the mouse.  Otherwise post
    # the menu just below the menubutton, as for a pull-down.

    update idletasks
    if [catch {
    	 switch [$w cget -direction] {
    	    above {
    	    	set x [winfo rootx $w]
    	    	set y [expr [winfo rooty $w] - [winfo reqheight $menu]]
    	    	$menu post $x $y
    	    }
    	    below {
    	    	set x [winfo rootx $w]
    	    	set y [expr [winfo rooty $w] + [winfo height $w]]
    	    	$menu post $x $y
    	    }
    	    left {
    	    	set x [expr [winfo rootx $w] - [winfo reqwidth $menu]]
    	    	set y [expr (2 * [winfo rooty $w] + [winfo height $w]) / 2]
    	    	set entry [tkMenuFindName $menu [$w cget -text]]
    	    	if [$w cget -indicatoron] {
		    if {$entry == [$menu index last]} {
		    	incr y [expr -([$menu yposition $entry] \
			    	+ [winfo reqheight $menu])/2]
		    } else {
		    	incr y [expr -([$menu yposition $entry] \
			        + [$menu yposition [expr $entry+1]])/2]
		    }
    	    	}
    	    	$menu post $x $y
    	    	if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {
    	    	    $menu activate $entry
		    tkGenerateMenuSelect $menu
    	    	}
    	    }
    	    right {
    	    	set x [expr [winfo rootx $w] + [winfo width $w]]
    	    	set y [expr (2 * [winfo rooty $w] + [winfo height $w]) / 2]
    	    	set entry [tkMenuFindName $menu [$w cget -text]]
    	    	if [$w cget -indicatoron] {
		    if {$entry == [$menu index last]} {
		    	incr y [expr -([$menu yposition $entry] \
			    	+ [winfo reqheight $menu])/2]
		    } else {
		    	incr y [expr -([$menu yposition $entry] \
			        + [$menu yposition [expr $entry+1]])/2]
		    }
    	    	}
    	    	$menu post $x $y
    	    	if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {
    	    	    $menu activate $entry
		    tkGenerateMenuSelect $menu
    	    	}
    	    }
    	    default {
    	    	if [$w cget -indicatoron] {
	    	    if {$y == ""} {
			set x [expr [winfo rootx $w] + [winfo width $w]/2]
			set y [expr [winfo rooty $w] + [winfo height $w]/2]
	    	    }
	            tkPostOverPoint $menu $x $y [tkMenuFindName $menu [$w cget -text]]
		} else {
	    	    $menu post [winfo rootx $w] [expr [winfo rooty $w]+[winfo height $w]]
    	    	}  
    	    }
    	 }
     } msg] {
	# Error posting menu (e.g. bogus -postcommand). Unpost it and
	# reflect the error.
	
	set savedInfo $errorInfo
	tkMenuUnpost {}
	error $msg $savedInfo








|



|















|


|




















>
|



|


|
|




|

















|



|




|



|
|

|

|
|

|
|



|





|
|

|

|
|

|
|



|





|
|
|
|



|



|







195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
#
# Arguments:
# w -			The  name of the widget.

proc tkMbEnter w {
    global tkPriv

    if {[string compare $tkPriv(inMenubutton) ""]} {
	tkMbLeave $tkPriv(inMenubutton)
    }
    set tkPriv(inMenubutton) $w
    if {[string compare [$w cget -state] "disabled"]} {
	$w configure -state active
    }
}

# tkMbLeave --
# This procedure is invoked when the mouse leaves a menubutton widget.
# It de-activates the widget, if the widget still exists.
#
# Arguments:
# w -			The  name of the widget.

proc tkMbLeave w {
    global tkPriv

    set tkPriv(inMenubutton) {}
    if {![winfo exists $w]} {
	return
    }
    if {![string compare [$w cget -state] "active"]} {
	$w configure -state normal
    }
}

# tkMbPost --
# Given a menubutton, this procedure does all the work of posting
# its associated menu and unposting any other menu that is currently
# posted.
#
# Arguments:
# w -			The name of the menubutton widget whose menu
#			is to be posted.
# x, y -		Root coordinates of cursor, used for positioning
#			option menus.  If not specified, then the center
#			of the menubutton is used for an option menu.

proc tkMbPost {w {x {}} {y {}}} {
    global tkPriv errorInfo
    global tcl_platform

    if {![string compare [$w cget -state] "disabled"] ||
      ![string compare $w $tkPriv(postedMb)]} {
	return
    }
    set menu [$w cget -menu]
    if {![string compare $menu ""]} {
	return
    }
    set tearoff [expr {![string compare $tcl_platform(platform) "unix"] \
          || ![string compare [$menu cget -type] "tearoff"]}]
    if {[string first $w $menu] != 0} {
	error "can't post $menu:  it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)"
    }
    set cur $tkPriv(postedMb)
    if {[string compare $cur ""]} {
	tkMenuUnpost {}
    }
    set tkPriv(cursor) [$w cget -cursor]
    set tkPriv(relief) [$w cget -relief]
    $w configure -cursor arrow
    $w configure -relief raised

    set tkPriv(postedMb) $w
    set tkPriv(focus) [focus]
    $menu activate none
    tkGenerateMenuSelect $menu

    # If this looks like an option menubutton then post the menu so
    # that the current entry is on top of the mouse.  Otherwise post
    # the menu just below the menubutton, as for a pull-down.

    update idletasks
    if {[catch {
    	 switch [$w cget -direction] {
    	    above {
    	    	set x [winfo rootx $w]
    	    	set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}]
    	    	$menu post $x $y
    	    }
    	    below {
    	    	set x [winfo rootx $w]
    	    	set y [expr {[winfo rooty $w] + [winfo height $w]}]
    	    	$menu post $x $y
    	    }
    	    left {
    	    	set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}]
    	    	set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
    	    	set entry [tkMenuFindName $menu [$w cget -text]]
    	    	if {[$w cget -indicatoron]} {
		    if {$entry == [$menu index last]} {
		    	incr y [expr {-([$menu yposition $entry] \
			    	+ [winfo reqheight $menu])/2}]
		    } else {
		    	incr y [expr {-([$menu yposition $entry] \
			        + [$menu yposition [expr {$entry+1}]])/2}]
		    }
    	    	}
    	    	$menu post $x $y
              if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
    	    	    $menu activate $entry
		    tkGenerateMenuSelect $menu
    	    	}
    	    }
    	    right {
    	    	set x [expr {[winfo rootx $w] + [winfo width $w]}]
    	    	set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
    	    	set entry [tkMenuFindName $menu [$w cget -text]]
    	    	if {[$w cget -indicatoron]} {
		    if {$entry == [$menu index last]} {
		    	incr y [expr {-([$menu yposition $entry] \
			    	+ [winfo reqheight $menu])/2}]
		    } else {
		    	incr y [expr {-([$menu yposition $entry] \
			        + [$menu yposition [expr {$entry+1}]])/2}]
		    }
    	    	}
    	    	$menu post $x $y
              if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
    	    	    $menu activate $entry
		    tkGenerateMenuSelect $menu
    	    	}
    	    }
    	    default {
    	    	if {[$w cget -indicatoron]} {
                  if {![string compare $y {}]} {
			set x [expr {[winfo rootx $w] + [winfo width $w]/2}]
			set y [expr {[winfo rooty $w] + [winfo height $w]/2}]
	    	    }
	            tkPostOverPoint $menu $x $y [tkMenuFindName $menu [$w cget -text]]
		} else {
	    	    $menu post [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]
    	    	}  
    	    }
    	 }
     } msg]} {
	# Error posting menu (e.g. bogus -postcommand). Unpost it and
	# reflect the error.
	
	set savedInfo $errorInfo
	tkMenuUnpost {}
	error $msg $savedInfo

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
    catch {focus $tkPriv(focus)}
    set tkPriv(focus) ""

    # Unpost menu(s) and restore some stuff that's dependent on
    # what was posted.

    catch {
	if {$mb != ""} {
	    set menu [$mb cget -menu]
	    $menu unpost
	    set tkPriv(postedMb) {}
	    $mb configure -cursor $tkPriv(cursor)
	    $mb configure -relief $tkPriv(relief)
	} elseif {$tkPriv(popup) != ""} {
	    $tkPriv(popup) unpost
	    set tkPriv(popup) {}
	} elseif {(!([$menu cget -type] == "menubar")
		&& !([$menu cget -type] == "tearoff"))} {
	    # We're in a cascaded sub-menu from a torn-off menu or popup.
	    # Unpost all the menus up to the toplevel one (but not
	    # including the top-level torn-off one) and deactivate the
	    # top-level torn off menu if there is one.

	    while 1 {
		set parent [winfo parent $menu]
		if {([winfo class $parent] != "Menu")
			|| ![winfo ismapped $parent]} {
		    break
		}
		$parent activate none
		$parent postcascade none
		tkGenerateMenuSelect $parent
		set type [$parent cget -type]

		if {($type == "menubar")|| ($type == "tearoff")} {
		    break
		}
		set menu $parent
	    }
	    if {[$menu cget -type] != "menubar"} {
		$menu unpost
	    }
	}
    }

    if {($tkPriv(tearoff) != 0) || ($tkPriv(menuBar) != "")} {
    	# Release grab, if any, and restore the previous grab, if there
    	# was one.

	if {$menu != ""} {
	    set grab [grab current $menu]
	    if {$grab != ""} {
		grab release $grab
	    }
	}
	tkRestoreOldGrab
	if {$tkPriv(menuBar) != ""} {
	    $tkPriv(menuBar) configure -cursor $tkPriv(cursor)
	    set tkPriv(menuBar) {}
	}
	if {$tcl_platform(platform) != "unix"} {
	    set tkPriv(tearoff) 0
	}
    }
}

# tkMbMotion --
# This procedure handles mouse motion events inside menubuttons, and
# also outside menubuttons when a menubutton has a grab (e.g. when a
# menu selection operation is in progress).
#
# Arguments:
# w -			The name of the menubutton widget.
# upDown - 		"down" means button 1 is pressed, "up" means
#			it isn't.
# rootx, rooty -	Coordinates of mouse, in (virtual?) root window.

proc tkMbMotion {w upDown rootx rooty} {
    global tkPriv

    if {$tkPriv(inMenubutton) == $w} {
	return
    }
    set new [winfo containing $rootx $rooty]
    if {($new != $tkPriv(inMenubutton)) && (($new == "")

	    || ([winfo toplevel $new] == [winfo toplevel $w]))} {
	if {$tkPriv(inMenubutton) != ""} {
	    tkMbLeave $tkPriv(inMenubutton)
	}

	if {($new != "") && ([winfo class $new] == "Menubutton")
		&& ([$new cget -indicatoron] == 0)
		&& ([$w cget -indicatoron] == 0)} {
	    if {$upDown == "down"} {
		tkMbPost $new $rootx $rooty
	    } else {
		tkMbEnter $new
	    }
	}
    }
}

# tkMbButtonUp --
# This procedure is invoked to handle button 1 releases for menubuttons.
# If the release happens inside the menubutton then leave its menu
# posted with element 0 activated.  Otherwise, unpost the menu.
#
# Arguments:
# w -			The name of the menubutton widget.

proc tkMbButtonUp w {
    global tkPriv
    global tcl_platform


    set tearoff [expr {($tcl_platform(platform) == "unix") \
		     || ([[$w cget -menu] cget -type] == "tearoff")}]
    if {($tearoff != 0) && ($tkPriv(postedMb) == $w) 
	    && ($tkPriv(inMenubutton) == $w)} {
	tkMenuFirstEntry [$tkPriv(postedMb) cget -menu]
    } else {
	tkMenuUnpost {}
    }
}







|





|


|
|







|







>
|




|





|


|
<

|




|



|



















|



|
>
|
|


>
|


|




















>

|







383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431

432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
    catch {focus $tkPriv(focus)}
    set tkPriv(focus) ""

    # Unpost menu(s) and restore some stuff that's dependent on
    # what was posted.

    catch {
      if {[string compare $mb ""]} {
	    set menu [$mb cget -menu]
	    $menu unpost
	    set tkPriv(postedMb) {}
	    $mb configure -cursor $tkPriv(cursor)
	    $mb configure -relief $tkPriv(relief)
      } elseif {[string compare $tkPriv(popup) ""]} {
	    $tkPriv(popup) unpost
	    set tkPriv(popup) {}
      } elseif {[string compare [$menu cget -type] "menubar"]
              && [string compare [$menu cget -type] "tearoff"]} {
	    # We're in a cascaded sub-menu from a torn-off menu or popup.
	    # Unpost all the menus up to the toplevel one (but not
	    # including the top-level torn-off one) and deactivate the
	    # top-level torn off menu if there is one.

	    while 1 {
		set parent [winfo parent $menu]
              if {[string compare [winfo class $parent] "Menu"]
			|| ![winfo ismapped $parent]} {
		    break
		}
		$parent activate none
		$parent postcascade none
		tkGenerateMenuSelect $parent
		set type [$parent cget -type]
              if {![string compare $type "menubar"] ||
                  ![string compare $type "tearoff"]} {
		    break
		}
		set menu $parent
	    }
          if {[string compare [$menu cget -type] "menubar"]} {
		$menu unpost
	    }
	}
    }

    if {($tkPriv(tearoff) != 0) || [string compare $tkPriv(menuBar) ""]} {
    	# Release grab, if any, and restore the previous grab, if there
    	# was one.
      if {[string compare $menu ""]} {

	    set grab [grab current $menu]
          if {[string compare $grab ""]} {
		grab release $grab
	    }
	}
	tkRestoreOldGrab
      if {[string compare $tkPriv(menuBar) ""]} {
	    $tkPriv(menuBar) configure -cursor $tkPriv(cursor)
	    set tkPriv(menuBar) {}
	}
      if {[string compare $tcl_platform(platform) "unix"]} {
	    set tkPriv(tearoff) 0
	}
    }
}

# tkMbMotion --
# This procedure handles mouse motion events inside menubuttons, and
# also outside menubuttons when a menubutton has a grab (e.g. when a
# menu selection operation is in progress).
#
# Arguments:
# w -			The name of the menubutton widget.
# upDown - 		"down" means button 1 is pressed, "up" means
#			it isn't.
# rootx, rooty -	Coordinates of mouse, in (virtual?) root window.

proc tkMbMotion {w upDown rootx rooty} {
    global tkPriv

    if {![string compare $tkPriv(inMenubutton) $w]} {
	return
    }
    set new [winfo containing $rootx $rooty]
    if {[string compare $new $tkPriv(inMenubutton)]
          && (![string compare $new ""]
          || ![string compare [winfo toplevel $new] [winfo toplevel $w]])} {
      if {[string compare $tkPriv(inMenubutton) ""]} {
	    tkMbLeave $tkPriv(inMenubutton)
	}
      if {[string compare $new ""]
              && ![string compare [winfo class $new] "Menubutton"]
		&& ([$new cget -indicatoron] == 0)
		&& ([$w cget -indicatoron] == 0)} {
          if {![string compare $upDown "down"]} {
		tkMbPost $new $rootx $rooty
	    } else {
		tkMbEnter $new
	    }
	}
    }
}

# tkMbButtonUp --
# This procedure is invoked to handle button 1 releases for menubuttons.
# If the release happens inside the menubutton then leave its menu
# posted with element 0 activated.  Otherwise, unpost the menu.
#
# Arguments:
# w -			The name of the menubutton widget.

proc tkMbButtonUp w {
    global tkPriv
    global tcl_platform

    set menu [$w cget -menu]
    set tearoff [expr {($tcl_platform(platform) == "unix") \
	    || (($menu != {}) && ([$menu cget -type] == "tearoff"))}]
    if {($tearoff != 0) && ($tkPriv(postedMb) == $w) 
	    && ($tkPriv(inMenubutton) == $w)} {
	tkMenuFirstEntry [$tkPriv(postedMb) cget -menu]
    } else {
	tkMenuUnpost {}
    }
}
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
# menu -		The menu window.
# x -			The x position of the mouse.
# y -			The y position of the mouse.
# state -		Modifier state (tells whether buttons are down).

proc tkMenuMotion {menu x y state} {
    global tkPriv
    if {$menu == $tkPriv(window)} {
	if {[$menu cget -type] == "menubar"} {
	    if {[info exists tkPriv(focus)] && \
		    ([string compare $menu $tkPriv(focus)] != 0)} {
		$menu activate @$x,$y
		tkGenerateMenuSelect $menu
	    }
	} else {
	    $menu activate @$x,$y
	    tkGenerateMenuSelect $menu
	}







|
|

|







516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
# menu -		The menu window.
# x -			The x position of the mouse.
# y -			The y position of the mouse.
# state -		Modifier state (tells whether buttons are down).

proc tkMenuMotion {menu x y state} {
    global tkPriv
    if {![string compare $menu $tkPriv(window)]} {
      if {![string compare [$menu cget -type] "menubar"]} {
	    if {[info exists tkPriv(focus)] && \
                  [string compare $menu $tkPriv(focus)]} {
		$menu activate @$x,$y
		tkGenerateMenuSelect $menu
	    }
	} else {
	    $menu activate @$x,$y
	    tkGenerateMenuSelect $menu
	}
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
# Arguments:
# menu -		The menu window.

proc tkMenuButtonDown menu {
    global tkPriv
    global tcl_platform
    $menu postcascade active
    if {$tkPriv(postedMb) != ""} {
	grab -global $tkPriv(postedMb)
    } else {
	while {([$menu cget -type] == "normal") 
		&& ([winfo class [winfo parent $menu]] == "Menu")
		&& [winfo ismapped [winfo parent $menu]]} {
	    set menu [winfo parent $menu]
	}

	if {$tkPriv(menuBar) == {}} {
	    set tkPriv(menuBar) $menu
	    set tkPriv(cursor) [$menu cget -cursor]
	    $menu configure -cursor arrow
        }

	# Don't update grab information if the grab window isn't changing.
	# Otherwise, we'll get an error when we unpost the menus and
	# restore the grab, since the old grab window will not be viewable
	# anymore.

	if {$menu != [grab current $menu]} {
	    tkSaveGrabInfo $menu
	}

	# Must re-grab even if the grab window hasn't changed, in order
	# to release the implicit grab from the button press.

	if {$tcl_platform(platform) == "unix"} {
	    grab -global $menu
	}
    }
}

# tkMenuLeave --
# This procedure is invoked to handle Leave events for a menu.  It
# deactivates everything unless the active element is a cascade element
# and the mouse is now over the submenu.
#
# Arguments:
# menu -		The menu window.
# rootx, rooty -	Root coordinates of mouse.
# state -		Modifier state.

proc tkMenuLeave {menu rootx rooty state} {
    global tkPriv
    set tkPriv(window) {}
    if {[$menu index active] == "none"} {
	return
    }
    if {([$menu type active] == "cascade")
	    && ([winfo containing $rootx $rooty]
	    == [$menu entrycget active -menu])} {
	return
    }
    $menu activate none
    tkGenerateMenuSelect $menu
}

# tkMenuInvoke --
# This procedure is invoked when button 1 is released over a menu.
# It invokes the appropriate menu action and unposts the menu if
# it came from a menubutton.
#
# Arguments:
# w -			Name of the menu widget.
# buttonRelease -	1 means this procedure is called because of
#			a button release;  0 means because of keystroke.

proc tkMenuInvoke {w buttonRelease} {
    global tkPriv

    if {$buttonRelease && ($tkPriv(window) == "")} {
	# Mouse was pressed over a menu without a menu button, then
	# dragged off the menu (possibly with a cascade posted) and
	# released.  Unpost everything and quit.

	$w postcascade none
	$w activate none
	event generate $w <<MenuSelect>>
	tkMenuUnpost $w
	return
    }
    if {[$w type active] == "cascade"} {
	$w postcascade active
	set menu [$w entrycget active -menu]
	tkMenuFirstEntry $menu
    } elseif {[$w type active] == "tearoff"} {
	tkMenuUnpost $w
	tkTearOffMenu $w
    } elseif {[$w cget -type] == "menubar"} {
	$w postcascade none
	$w activate none
	event generate $w <<MenuSelect>>
	tkMenuUnpost $w
    } else {
	tkMenuUnpost $w
	uplevel #0 [list $w invoke active]
    }
}

# tkMenuEscape --
# This procedure is invoked for the Cancel (or Escape) key.  It unposts
# the given menu and, if it is the top-level menu for a menu button,
# unposts the menu button as well.
#
# Arguments:
# menu -		Name of the menu window.

proc tkMenuEscape menu {
    set parent [winfo parent $menu]
    if {([winfo class $parent] != "Menu")} {
	tkMenuUnpost $menu
    } elseif {([$parent cget -type] == "menubar")} {
	tkMenuUnpost $menu
	tkRestoreOldGrab
    } else {
	tkMenuNextMenu $menu left
    }
}

# The following routines handle arrow keys. Arrow keys behave
# differently depending on whether the menu is a menu bar or not.

proc tkMenuUpArrow {menu} {
    if {[$menu cget -type] == "menubar"} {
	tkMenuNextMenu $menu left
    } else {
	tkMenuNextEntry $menu -1
    }
}

proc tkMenuDownArrow {menu} {
    if {[$menu cget -type] == "menubar"} {
	tkMenuNextMenu $menu right
    } else {
	tkMenuNextEntry $menu 1
    }
}

proc tkMenuLeftArrow {menu} {
    if {[$menu cget -type] == "menubar"} {
	tkMenuNextEntry $menu -1
    } else {
	tkMenuNextMenu $menu left
    }
}

proc tkMenuRightArrow {menu} {
    if {[$menu cget -type] == "menubar"} {
	tkMenuNextEntry $menu 1
    } else {
	tkMenuNextMenu $menu right
    }
}

# tkMenuNextMenu --







|


|
|




|










|






|


















|


|
|
|



















|










|



|


|




















|

|











|







|







|







|







552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
# Arguments:
# menu -		The menu window.

proc tkMenuButtonDown menu {
    global tkPriv
    global tcl_platform
    $menu postcascade active
    if {[string compare $tkPriv(postedMb) ""]} {
	grab -global $tkPriv(postedMb)
    } else {
      while {![string compare [$menu cget -type] "normal"]
              && ![string compare [winfo class [winfo parent $menu]] "Menu"]
		&& [winfo ismapped [winfo parent $menu]]} {
	    set menu [winfo parent $menu]
	}

      if {![string compare $tkPriv(menuBar) {}]} {
	    set tkPriv(menuBar) $menu
	    set tkPriv(cursor) [$menu cget -cursor]
	    $menu configure -cursor arrow
        }

	# Don't update grab information if the grab window isn't changing.
	# Otherwise, we'll get an error when we unpost the menus and
	# restore the grab, since the old grab window will not be viewable
	# anymore.

      if {[string compare $menu [grab current $menu]]} {
	    tkSaveGrabInfo $menu
	}

	# Must re-grab even if the grab window hasn't changed, in order
	# to release the implicit grab from the button press.

      if {![string compare $tcl_platform(platform) "unix"]} {
	    grab -global $menu
	}
    }
}

# tkMenuLeave --
# This procedure is invoked to handle Leave events for a menu.  It
# deactivates everything unless the active element is a cascade element
# and the mouse is now over the submenu.
#
# Arguments:
# menu -		The menu window.
# rootx, rooty -	Root coordinates of mouse.
# state -		Modifier state.

proc tkMenuLeave {menu rootx rooty state} {
    global tkPriv
    set tkPriv(window) {}
    if {![string compare [$menu index active] "none"]} {
	return
    }
    if {![string compare [$menu type active] "cascade"]
          && ![string compare [winfo containing $rootx $rooty] \
                  [$menu entrycget active -menu]]} {
	return
    }
    $menu activate none
    tkGenerateMenuSelect $menu
}

# tkMenuInvoke --
# This procedure is invoked when button 1 is released over a menu.
# It invokes the appropriate menu action and unposts the menu if
# it came from a menubutton.
#
# Arguments:
# w -			Name of the menu widget.
# buttonRelease -	1 means this procedure is called because of
#			a button release;  0 means because of keystroke.

proc tkMenuInvoke {w buttonRelease} {
    global tkPriv

    if {$buttonRelease && ![string compare $tkPriv(window) {}]} {
	# Mouse was pressed over a menu without a menu button, then
	# dragged off the menu (possibly with a cascade posted) and
	# released.  Unpost everything and quit.

	$w postcascade none
	$w activate none
	event generate $w <<MenuSelect>>
	tkMenuUnpost $w
	return
    }
    if {![string compare [$w type active] "cascade"]} {
	$w postcascade active
	set menu [$w entrycget active -menu]
	tkMenuFirstEntry $menu
    } elseif {![string compare [$w type active] "tearoff"]} {
	tkMenuUnpost $w
	tkTearOffMenu $w
    } elseif {![string compare [$w cget -type] "menubar"]} {
	$w postcascade none
	$w activate none
	event generate $w <<MenuSelect>>
	tkMenuUnpost $w
    } else {
	tkMenuUnpost $w
	uplevel #0 [list $w invoke active]
    }
}

# tkMenuEscape --
# This procedure is invoked for the Cancel (or Escape) key.  It unposts
# the given menu and, if it is the top-level menu for a menu button,
# unposts the menu button as well.
#
# Arguments:
# menu -		Name of the menu window.

proc tkMenuEscape menu {
    set parent [winfo parent $menu]
    if {[string compare [winfo class $parent] "Menu"]} {
	tkMenuUnpost $menu
    } elseif {![string compare [$parent cget -type] "menubar"]} {
	tkMenuUnpost $menu
	tkRestoreOldGrab
    } else {
	tkMenuNextMenu $menu left
    }
}

# The following routines handle arrow keys. Arrow keys behave
# differently depending on whether the menu is a menu bar or not.

proc tkMenuUpArrow {menu} {
    if {![string compare [$menu cget -type] "menubar"]} {
	tkMenuNextMenu $menu left
    } else {
	tkMenuNextEntry $menu -1
    }
}

proc tkMenuDownArrow {menu} {
    if {![string compare [$menu cget -type] "menubar"]} {
	tkMenuNextMenu $menu right
    } else {
	tkMenuNextEntry $menu 1
    }
}

proc tkMenuLeftArrow {menu} {
    if {![string compare [$menu cget -type] "menubar"]} {
	tkMenuNextEntry $menu -1
    } else {
	tkMenuNextMenu $menu left
    }
}

proc tkMenuRightArrow {menu} {
    if {![string compare [$menu cget -type] "menubar"]} {
	tkMenuNextEntry $menu 1
    } else {
	tkMenuNextMenu $menu right
    }
}

# tkMenuNextMenu --
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
# direction -		Direction in which to move: "left" or "right"

proc tkMenuNextMenu {menu direction} {
    global tkPriv

    # First handle traversals into and out of cascaded menus.

    if {$direction == "right"} {
	set count 1
	set parent [winfo parent $menu]
	set class [winfo class $parent]
	if {[$menu type active] == "cascade"} {
	    $menu postcascade active
	    set m2 [$menu entrycget active -menu]
	    if {$m2 != ""} {
		tkMenuFirstEntry $m2
	    }
	    return
	} else {
	    set parent [winfo parent $menu]
	    while {($parent != ".")} {
		if {([winfo class $parent] == "Menu")
			&& ([$parent cget -type] == "menubar")} {
		    tk_menuSetFocus $parent
		    tkMenuNextEntry $parent 1
		    return
		}
		set parent [winfo parent $parent]
	    }
	}
    } else {
	set count -1
	set m2 [winfo parent $menu]
	if {[winfo class $m2] == "Menu"} {
	    if {[$m2 cget -type] != "menubar"} {
		$menu activate none
		tkGenerateMenuSelect $menu
		tk_menuSetFocus $m2
		
		# This code unposts any posted submenu in the parent.
		
		set tmp [$m2 index active]
		$m2 activate none
		$m2 activate $tmp
		return
	    }
	}
    }

    # Can't traverse into or out of a cascaded menu.  Go to the next
    # or previous menubutton, if that makes sense.

    set m2 [winfo parent $menu]
    if {[winfo class $m2] == "Menu"} {
	if {[$m2 cget -type] == "menubar"} {
	    tk_menuSetFocus $m2
	    tkMenuNextEntry $m2 -1
	    return
	}
    }

    set w $tkPriv(postedMb)
    if {$w == ""} {
	return
    }
    set buttons [winfo children [winfo parent $w]]
    set length [llength $buttons]
    set i [expr [lsearch -exact $buttons $w] + $count]
    while 1 {
	while {$i < 0} {
	    incr i $length
	}
	while {$i >= $length} {
	    incr i -$length
	}
	set mb [lindex $buttons $i]
	if {([winfo class $mb] == "Menubutton")
		&& ([$mb cget -state] != "disabled")
		&& ([$mb cget -menu] != "")
		&& ([[$mb cget -menu] index last] != "none")} {
	    break
	}
	if {$mb == $w} {
	    return
	}
	incr i $count
    }
    tkMbPost $mb
    tkMenuFirstEntry [$mb cget -menu]
}

# tkMenuNextEntry --
# Activate the next higher or lower entry in the posted menu,
# wrapping around at the ends.  Disabled entries are skipped.
#
# Arguments:
# menu -			Menu window that received the keystroke.
# count -			1 means go to the next lower entry,
#				-1 means go to the next higher entry.

proc tkMenuNextEntry {menu count} {
    global tkPriv

    if {[$menu index last] == "none"} {
	return
    }
    set length [expr [$menu index last]+1]
    set quitAfter $length
    set active [$menu index active]
    if {$active == "none"} {
	set i 0
    } else {
	set i [expr $active + $count]
    }
    while 1 {
	if {$quitAfter <= 0} {
	    # We've tried every entry in the menu.  Either there are
	    # none, or they're all disabled.  Just give up.

	    return







|



|


|





|
|
|










|
|


















|
|







|




|








|
|
|
|


|




















|


|


|


|







722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
# direction -		Direction in which to move: "left" or "right"

proc tkMenuNextMenu {menu direction} {
    global tkPriv

    # First handle traversals into and out of cascaded menus.

    if {![string compare $direction "right"]} {
	set count 1
	set parent [winfo parent $menu]
	set class [winfo class $parent]
      if {![string compare [$menu type active] "cascade"]} {
	    $menu postcascade active
	    set m2 [$menu entrycget active -menu]
          if {[string compare $m2 ""]} {
		tkMenuFirstEntry $m2
	    }
	    return
	} else {
	    set parent [winfo parent $menu]
          while {[string compare $parent "."]} {
              if {![string compare [winfo class $parent] "Menu"]
                      && ![string compare [$parent cget -type] "menubar"]} {
		    tk_menuSetFocus $parent
		    tkMenuNextEntry $parent 1
		    return
		}
		set parent [winfo parent $parent]
	    }
	}
    } else {
	set count -1
	set m2 [winfo parent $menu]
      if {![string compare [winfo class $m2] "Menu"]} {
          if {[string compare [$m2 cget -type] "menubar"]} {
		$menu activate none
		tkGenerateMenuSelect $menu
		tk_menuSetFocus $m2
		
		# This code unposts any posted submenu in the parent.
		
		set tmp [$m2 index active]
		$m2 activate none
		$m2 activate $tmp
		return
	    }
	}
    }

    # Can't traverse into or out of a cascaded menu.  Go to the next
    # or previous menubutton, if that makes sense.

    set m2 [winfo parent $menu]
    if {![string compare [winfo class $m2] "Menu"]} {
      if {![string compare [$m2 cget -type] "menubar"]} {
	    tk_menuSetFocus $m2
	    tkMenuNextEntry $m2 -1
	    return
	}
    }

    set w $tkPriv(postedMb)
    if {![string compare $w ""]} {
	return
    }
    set buttons [winfo children [winfo parent $w]]
    set length [llength $buttons]
    set i [expr {[lsearch -exact $buttons $w] + $count}]
    while 1 {
	while {$i < 0} {
	    incr i $length
	}
	while {$i >= $length} {
	    incr i -$length
	}
	set mb [lindex $buttons $i]
      if {![string compare [winfo class $mb] "Menubutton"]
              && [string compare [$mb cget -state] "disabled"]
              && [string compare [$mb cget -menu] ""]
              && [string compare [[$mb cget -menu] index last] "none"]} {
	    break
	}
      if {![string compare $mb $w]} {
	    return
	}
	incr i $count
    }
    tkMbPost $mb
    tkMenuFirstEntry [$mb cget -menu]
}

# tkMenuNextEntry --
# Activate the next higher or lower entry in the posted menu,
# wrapping around at the ends.  Disabled entries are skipped.
#
# Arguments:
# menu -			Menu window that received the keystroke.
# count -			1 means go to the next lower entry,
#				-1 means go to the next higher entry.

proc tkMenuNextEntry {menu count} {
    global tkPriv

    if {![string compare [$menu index last] "none"]} {
	return
    }
    set length [expr {[$menu index last]+1}]
    set quitAfter $length
    set active [$menu index active]
    if {![string compare $active "none"]} {
	set i 0
    } else {
	set i [expr {$active + $count}]
    }
    while 1 {
	if {$quitAfter <= 0} {
	    # We've tried every entry in the menu.  Either there are
	    # none, or they're all disabled.  Just give up.

	    return
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
	    return
	}
	incr i $count
	incr quitAfter -1
    }
    $menu activate $i
    tkGenerateMenuSelect $menu
    if {[$menu type $i] == "cascade"} {
	set cascade [$menu entrycget $i -menu]
	if {[string compare $cascade ""] != 0} {
	    $menu postcascade $i
	    tkMenuFirstEntry $cascade
	}
    }
}

# tkMenuFind --







|

|







855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
	    return
	}
	incr i $count
	incr quitAfter -1
    }
    $menu activate $i
    tkGenerateMenuSelect $menu
    if {![string compare [$menu type $i] "cascade"]} {
	set cascade [$menu entrycget $i -menu]
      if {[string compare $cascade ""]} {
	    $menu postcascade $i
	    tkMenuFirstEntry $cascade
	}
    }
}

# tkMenuFind --
881
882
883
884
885
886
887




888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913




914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935

proc tkMenuFind {w char} {
    global tkPriv
    set char [string tolower $char]
    set windowlist [winfo child $w]

    foreach child $windowlist {




	switch [winfo class $child] {
	    Menu {
		if {[$child cget -type] == "menubar"} {
		    if {$char == ""} {
			return $child
		    }
		    set last [$child index last]
		    for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
			if {[$child type $i] == "separator"} {
			    continue
			}
			set char2 [string index [$child entrycget $i -label] \
				[$child entrycget $i -underline]]
			if {([string compare $char [string tolower $char2]] \
				== 0) || ($char == "")} {
			    if {[$child entrycget $i -state] != "disabled"} {
				return $child
			    }
			}
		    }
		}
	    }
	}
    }

    foreach child $windowlist {




	switch [winfo class $child] {
	    Menubutton {
		set char2 [string index [$child cget -text] \
			[$child cget -underline]]
		if {([string compare $char [string tolower $char2]] == 0)
			|| ($char == "")} {
		    if {[$child cget -state] != "disabled"} {
			return $child
		    }
		}
	    }

	    default {
		set match [tkMenuFind $child $char]
		if {$match != ""} {
		    return $match
		}
	    }
	}
    }
    return {}
}







>
>
>
>


|
|




|




|
|
|










>
>
>
>




|
|
|







|







886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948

proc tkMenuFind {w char} {
    global tkPriv
    set char [string tolower $char]
    set windowlist [winfo child $w]

    foreach child $windowlist {
	# Don't descend into other toplevels.
        if {[winfo toplevel [focus]] != [winfo toplevel $child] } {
	    continue
	}
	switch [winfo class $child] {
	    Menu {
              if {![string compare [$child cget -type] "menubar"]} {
                  if {![string compare $char ""]} {
			return $child
		    }
		    set last [$child index last]
		    for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
                      if {![string compare [$child type $i] "separator"]} {
			    continue
			}
			set char2 [string index [$child entrycget $i -label] \
				[$child entrycget $i -underline]]
                      if {![string compare $char [string tolower $char2]] \
                              || ![string compare $char ""]} {
                          if {[string compare [$child entrycget $i -state] "disabled"]} {
				return $child
			    }
			}
		    }
		}
	    }
	}
    }

    foreach child $windowlist {
	# Don't descend into other toplevels.
        if {[winfo toplevel [focus]] != [winfo toplevel $child] } {
	    continue
	}
	switch [winfo class $child] {
	    Menubutton {
		set char2 [string index [$child cget -text] \
			[$child cget -underline]]
              if {![string compare $char [string tolower $char2]]
                      || ![string compare $char ""]} {
                  if {[string compare [$child cget $i -state] "disabled"]} {
			return $child
		    }
		}
	    }

	    default {
		set match [tkMenuFind $child $char]
              if {[string compare $match ""]} {
		    return $match
		}
	    }
	}
    }
    return {}
}
944
945
946
947
948
949
950
951
952
953
954

955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
#				a toplevel window).
# char -			Character that selects a menu.  The case
#				is ignored.  If an empty string, nothing
#				happens.

proc tkTraverseToMenu {w char} {
    global tkPriv
    if {$char == ""} {
	return
    }
    while {[winfo class $w] == "Menu"} {

	if {([$w cget -type] != "menubar") && ($tkPriv(postedMb) == "")} {
	    return
	}
	if {[$w cget -type] == "menubar"} {
	    break
	}
	set w [winfo parent $w]
    }
    set w [tkMenuFind [winfo toplevel $w] $char]
    if {$w != ""} {
	if {[winfo class $w] == "Menu"} {
	    tk_menuSetFocus $w
	    set tkPriv(window) $w
	    tkSaveGrabInfo $w
	    grab -global $w
	    tkTraverseWithinMenu $w $char
	} else {
	    tkMbPost $w







|


|
>
|


|





|
|







957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
#				a toplevel window).
# char -			Character that selects a menu.  The case
#				is ignored.  If an empty string, nothing
#				happens.

proc tkTraverseToMenu {w char} {
    global tkPriv
    if {![string compare $char ""]} {
	return
    }
    while {![string compare [winfo class $w] "Menu"]} {
      if {[string compare [$w cget -type] "menubar"]
              && ![string compare $tkPriv(postedMb) ""]} {
	    return
	}
      if {![string compare [$w cget -type] "menubar"]} {
	    break
	}
	set w [winfo parent $w]
    }
    set w [tkMenuFind [winfo toplevel $w] $char]
    if {[string compare $w ""]} {
      if {![string compare [winfo class $w] "Menu"]} {
	    tk_menuSetFocus $w
	    set tkPriv(window) $w
	    tkSaveGrabInfo $w
	    grab -global $w
	    tkTraverseWithinMenu $w $char
	} else {
	    tkMbPost $w
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
#
# Arguments:
# w -				Name of a window.  Selects which toplevel
#				to search for menubuttons.

proc tkFirstMenu w {
    set w [tkMenuFind [winfo toplevel $w] ""]
    if {$w != ""} {
	if {[winfo class $w] == "Menu"} {
	    tk_menuSetFocus $w
	    set tkPriv(window) $w
	    tkSaveGrabInfo $w
	    grab -global $w
	    tkMenuFirstEntry $w
	} else {
	    tkMbPost $w







|
|







995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
#
# Arguments:
# w -				Name of a window.  Selects which toplevel
#				to search for menubuttons.

proc tkFirstMenu w {
    set w [tkMenuFind [winfo toplevel $w] ""]
    if {[string compare $w ""]} {
      if {![string compare [winfo class $w] "Menu"]} {
	    tk_menuSetFocus $w
	    set tkPriv(window) $w
	    tkSaveGrabInfo $w
	    grab -global $w
	    tkMenuFirstEntry $w
	} else {
	    tkMbPost $w
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
# Arguments:
# w -				The name of the menu widget.
# char -			The character to look for;  case is
#				ignored.  If the string is empty then
#				nothing happens.

proc tkTraverseWithinMenu {w char} {
    if {$char == ""} {
	return
    }
    set char [string tolower $char]
    set last [$w index last]
    if {$last == "none"} {
	return
    }
    for {set i 0} {$i <= $last} {incr i} {
	if [catch {set char2 [string index \
		[$w entrycget $i -label] \
		[$w entrycget $i -underline]]}] {
	    continue
	}
	if {[string compare $char [string tolower $char2]] == 0} {
	    if {[$w type $i] == "cascade"} {
		$w activate $i
		$w postcascade active
		event generate $w <<MenuSelect>>
		set m2 [$w entrycget $i -menu]
		if {$m2 != ""} {
		    tkMenuFirstEntry $m2
		}
	    } else {
		tkMenuUnpost $w
		uplevel #0 [list $w invoke $i]
	    }
	    return







|




|



|

|


|
|




|







1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
# Arguments:
# w -				The name of the menu widget.
# char -			The character to look for;  case is
#				ignored.  If the string is empty then
#				nothing happens.

proc tkTraverseWithinMenu {w char} {
    if {![string compare $char ""]} {
	return
    }
    set char [string tolower $char]
    set last [$w index last]
    if {![string compare $last "none"]} {
	return
    }
    for {set i 0} {$i <= $last} {incr i} {
	if {[catch {set char2 [string index \
		[$w entrycget $i -label] \
		[$w entrycget $i -underline]]}]} {
	    continue
	}
      if {![string compare $char [string tolower $char2]]} {
          if {![string compare [$w type $i] "cascade"]} {
		$w activate $i
		$w postcascade active
		event generate $w <<MenuSelect>>
		set m2 [$w entrycget $i -menu]
              if {[string compare $m2 ""]} {
		    tkMenuFirstEntry $m2
		}
	    } else {
		tkMenuUnpost $w
		uplevel #0 [list $w invoke $i]
	    }
	    return
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070

1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
# entry isn't changed.  This procedure also sets the input focus
# to the menu.
#
# Arguments:
# menu -		Name of the menu window (possibly empty).

proc tkMenuFirstEntry menu {
    if {$menu == ""} {
	return
    }
    tk_menuSetFocus $menu
    if {[$menu index active] != "none"} {
	return
    }
    set last [$menu index last]
    if {$last == "none"} {
	return
    }
    for {set i 0} {$i <= $last} {incr i} {
	if {([catch {set state [$menu entrycget $i -state]}] == 0)

		&& ($state != "disabled") && ([$menu type $i] != "tearoff")} {
	    $menu activate $i
	    tkGenerateMenuSelect $menu
	    if {[$menu type $i] == "cascade"} {
		set cascade [$menu entrycget $i -menu]
		if {[string compare $cascade ""] != 0} {
		    $menu postcascade $i
		    tkMenuFirstEntry $cascade
		}
	    }
	    return
	}
    }







|



|



|




>
|


|

|







1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
# entry isn't changed.  This procedure also sets the input focus
# to the menu.
#
# Arguments:
# menu -		Name of the menu window (possibly empty).

proc tkMenuFirstEntry menu {
    if {![string compare $menu ""]} {
	return
    }
    tk_menuSetFocus $menu
    if {[string compare [$menu index active] "none"]} {
	return
    }
    set last [$menu index last]
    if {![string compare $last "none"]} {
	return
    }
    for {set i 0} {$i <= $last} {incr i} {
	if {([catch {set state [$menu entrycget $i -state]}] == 0)
              && [string compare $state "disabled"]
              && [string compare [$menu type $i] "tearoff"]} {
	    $menu activate $i
	    tkGenerateMenuSelect $menu
          if {![string compare [$menu type $i] "cascade"]} {
		set cascade [$menu entrycget $i -menu]
              if {[string compare $cascade ""]} {
		    $menu postcascade $i
		    tkMenuFirstEntry $cascade
		}
	    }
	    return
	}
    }
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
proc tkMenuFindName {menu s} {
    set i ""
    if {![regexp {^active$|^last$|^none$|^[0-9]|^@} $s]} {
	catch {set i [$menu index $s]}
	return $i
    }
    set last [$menu index last]
    if {$last == "none"} {
	return
    }
    for {set i 0} {$i <= $last} {incr i} {
	if ![catch {$menu entrycget $i -label} label] {
	    if {$label == $s} {
		return $i
	    }
	}
    }
    return ""
}








|



|
|







1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
proc tkMenuFindName {menu s} {
    set i ""
    if {![regexp {^active$|^last$|^none$|^[0-9]|^@} $s]} {
	catch {set i [$menu index $s]}
	return $i
    }
    set last [$menu index last]
    if {![string compare $last "none"]} {
	return
    }
    for {set i 0} {$i <= $last} {incr i} {
	if {![catch {$menu entrycget $i -label} label]} {
          if {![string compare $label $s]} {
		return $i
	    }
	}
    }
    return ""
}

1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142

1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
# entry -		Index of entry within menu to center over (x,y).
#			If omitted or specified as {}, then the menu's
#			upper-left corner goes at (x,y).

proc tkPostOverPoint {menu x y {entry {}}}  {
    global tcl_platform
    
    if {$entry != {}} {
	if {$entry == [$menu index last]} {
	    incr y [expr -([$menu yposition $entry] \
		    + [winfo reqheight $menu])/2]
	} else {
	    incr y [expr -([$menu yposition $entry] \
		    + [$menu yposition [expr $entry+1]])/2]
	}
	incr x [expr -[winfo reqwidth $menu]/2]
    }
    $menu post $x $y

    if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {
	$menu activate $entry
	tkGenerateMenuSelect $menu
    }
}

# tkSaveGrabInfo --
# Sets the variables tkPriv(oldGrab) and tkPriv(grabStatus) to record
# the state of any existing grab on the w's display.
#
# Arguments:
# w -			Name of a window;  used to select the display
#			whose grab information is to be recorded.

proc tkSaveGrabInfo w {
    global tkPriv
    set tkPriv(oldGrab) [grab current $w]
    if {$tkPriv(oldGrab) != ""} {
	set tkPriv(grabStatus) [grab status $tkPriv(oldGrab)]
    }
}

# tkRestoreOldGrab --
# Restores the grab to what it was before TkSaveGrabInfo was called.
#

proc tkRestoreOldGrab {} {
    global tkPriv

    if {$tkPriv(oldGrab) != ""} {

    	# Be careful restoring the old grab, since it's window may not
	# be visible anymore.

	catch {
	    if {$tkPriv(grabStatus) == "global"} {
		grab set -global $tkPriv(oldGrab)
	    } else {
		grab set $tkPriv(oldGrab)
	    }
	}
	set tkPriv(oldGrab) ""
    }
}

proc tk_menuSetFocus {menu} {
    global tkPriv
    if {![info exists tkPriv(focus)] || [string length $tkPriv(focus)] == 0} {
	set tkPriv(focus) [focus]
    }
    focus $menu
}
    
proc tkGenerateMenuSelect {menu} {
    global tkPriv

    if {([string compare $tkPriv(activeMenu) $menu] == 0) \
	    && ([string compare $tkPriv(activeItem) [$menu index active]] \
	    == 0)} {
	return
    }

    set tkPriv(activeMenu) $menu
    set tkPriv(activeItem) [$menu index active]
    event generate $menu <<MenuSelect>>
}







|

|
|

|
|

|


>
|
















|











|





|











|








|
|
<







1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216

1217
1218
1219
1220
1221
1222
1223
# entry -		Index of entry within menu to center over (x,y).
#			If omitted or specified as {}, then the menu's
#			upper-left corner goes at (x,y).

proc tkPostOverPoint {menu x y {entry {}}}  {
    global tcl_platform
    
    if {[string compare $entry {}]} {
	if {$entry == [$menu index last]} {
	    incr y [expr {-([$menu yposition $entry] \
		    + [winfo reqheight $menu])/2}]
	} else {
	    incr y [expr {-([$menu yposition $entry] \
		    + [$menu yposition [expr {$entry+1}]])/2}]
	}
	incr x [expr {-[winfo reqwidth $menu]/2}]
    }
    $menu post $x $y
    if {[string compare $entry {}]
          && [string compare [$menu entrycget $entry -state] "disabled"]} {
	$menu activate $entry
	tkGenerateMenuSelect $menu
    }
}

# tkSaveGrabInfo --
# Sets the variables tkPriv(oldGrab) and tkPriv(grabStatus) to record
# the state of any existing grab on the w's display.
#
# Arguments:
# w -			Name of a window;  used to select the display
#			whose grab information is to be recorded.

proc tkSaveGrabInfo w {
    global tkPriv
    set tkPriv(oldGrab) [grab current $w]
    if {[string compare $tkPriv(oldGrab) ""]} {
	set tkPriv(grabStatus) [grab status $tkPriv(oldGrab)]
    }
}

# tkRestoreOldGrab --
# Restores the grab to what it was before TkSaveGrabInfo was called.
#

proc tkRestoreOldGrab {} {
    global tkPriv

    if {[string compare $tkPriv(oldGrab) ""]} {

    	# Be careful restoring the old grab, since it's window may not
	# be visible anymore.

	catch {
          if {![string compare $tkPriv(grabStatus) "global"]} {
		grab set -global $tkPriv(oldGrab)
	    } else {
		grab set $tkPriv(oldGrab)
	    }
	}
	set tkPriv(oldGrab) ""
    }
}

proc tk_menuSetFocus {menu} {
    global tkPriv
    if {![info exists tkPriv(focus)] || ![string compare $tkPriv(focus) {}]} {
	set tkPriv(focus) [focus]
    }
    focus $menu
}
    
proc tkGenerateMenuSelect {menu} {
    global tkPriv

    if {![string compare $tkPriv(activeMenu) $menu] \
          && ![string compare $tkPriv(activeItem) [$menu index active]]} {

	return
    }

    set tkPriv(activeMenu) $menu
    set tkPriv(activeItem) [$menu index active]
    event generate $menu <<MenuSelect>>
}
1218
1219
1220
1221
1222
1223
1224

1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
# entry -		Index of a menu entry to center over (x,y).
#			If omitted or specified as {}, then menu's
#			upper-left corner goes at (x,y).

proc tk_popup {menu x y {entry {}}} {
    global tkPriv
    global tcl_platform

    if {($tkPriv(popup) != "") || ($tkPriv(postedMb) != "")} {
	tkMenuUnpost {}
    }
    tkPostOverPoint $menu $x $y $entry
    if {$tcl_platform(platform) == "unix"} {
	tkSaveGrabInfo $menu
	grab -global $menu
	set tkPriv(popup) $menu
	tk_menuSetFocus $menu
    }
}







>
|



|






1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
# entry -		Index of a menu entry to center over (x,y).
#			If omitted or specified as {}, then menu's
#			upper-left corner goes at (x,y).

proc tk_popup {menu x y {entry {}}} {
    global tkPriv
    global tcl_platform
    if {[string compare $tkPriv(popup) ""]
          || [string compare $tkPriv(postedMb) ""]} {
	tkMenuUnpost {}
    }
    tkPostOverPoint $menu $x $y $entry
    if {![string compare $tcl_platform(platform) "unix"]} {
	tkSaveGrabInfo $menu
	grab -global $menu
	set tkPriv(popup) $menu
	tk_menuSetFocus $menu
    }
}

Changes to library/msgbox.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# msgbox.tcl --
#
#	Implements messageboxes for platforms that do not have native
#	messagebox support.
#
# SCCS: @(#) msgbox.tcl 1.8 97/07/28 17:20:01
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#






|







1
2
3
4
5
6
7
8
9
10
11
12
13
# msgbox.tcl --
#
#	Implements messageboxes for platforms that do not have native
#	messagebox support.
#
# RCS: @(#) $Id: msgbox.tcl,v 1.1.4.4 1999/04/06 03:52:56 stanton Exp $
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

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
        {-title "" "" " "}
        {-type "" "" "ok"}
    }

    tclParseConfigSpec $w $specs "" $args

    if {[lsearch {info warning error question} $data(-icon)] == -1} {
	error "invalid icon \"$data(-icon)\", must be error, info, question or warning"
    }
    if {$tcl_platform(platform) == "macintosh"} {
	if {$data(-icon) == "error"} {
	    set data(-icon) "stop"
	} elseif {$data(-icon) == "warning"} {
	    set data(-icon) "caution"
	} elseif {$data(-icon) == "info"} {
	    set data(-icon) "note"
	}
    }

    if ![winfo exists $data(-parent)] {
	error "bad window path name \"$data(-parent)\""
    }

    case $data(-type) {
	abortretryignore {
	    set buttons {
		{abort  -width 6 -text Abort -under 0}
		{retry  -width 6 -text Retry -under 0}
		{ignore -width 6 -text Ignore -under 0}
	    }
	}
	ok {
	    set buttons {
		{ok -width 6 -text OK -under 0}
	    }
	    if {$data(-default) == ""} {
		set data(-default) "ok"
	    }
	}
	okcancel {
	    set buttons {
		{ok     -width 6 -text OK     -under 0}
		{cancel -width 6 -text Cancel -under 0}







|

|
|
|
<
|
<
|



|



|











|







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
        {-title "" "" " "}
        {-type "" "" "ok"}
    }

    tclParseConfigSpec $w $specs "" $args

    if {[lsearch {info warning error question} $data(-icon)] == -1} {
	error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
    }
    if {![string compare $tcl_platform(platform) "macintosh"]} {
      switch -- $data(-icon) {
          "error"     {set data(-icon) "stop"}

          "warning"   {set data(-icon) "caution"}

          "info"      {set data(-icon) "note"}
	}
    }

    if {![winfo exists $data(-parent)]} {
	error "bad window path name \"$data(-parent)\""
    }

    switch -- $data(-type) {
	abortretryignore {
	    set buttons {
		{abort  -width 6 -text Abort -under 0}
		{retry  -width 6 -text Retry -under 0}
		{ignore -width 6 -text Ignore -under 0}
	    }
	}
	ok {
	    set buttons {
		{ok -width 6 -text OK -under 0}
	    }
          if {![string compare $data(-default) ""]} {
		set data(-default) "ok"
	    }
	}
	okcancel {
	    set buttons {
		{ok     -width 6 -text OK     -under 0}
		{cancel -width 6 -text Cancel -under 0}
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164

165
166


167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
	    set buttons {
		{yes    -width 6 -text Yes -under 0}
		{no     -width 6 -text No  -under 0}
		{cancel -width 6 -text Cancel -under 0}
	    }
	}
	default {
	    error "invalid message box type \"$data(-type)\", must be abortretryignore, ok, okcancel, retrycancel, yesno or yesnocancel"
	}
    }

    if [string compare $data(-default) ""] {
	set valid 0
	foreach btn $buttons {
	    if ![string compare [lindex $btn 0] $data(-default)] {
		set valid 1
		break
	    }
	}
	if !$valid {
	    error "invalid default button \"$data(-default)\""
	}
    }

    # 2. Set the dialog to be a child window of $parent
    #
    #
    if [string compare $data(-parent) .] {
	set w $data(-parent).__tk__messagebox
    } else {
	set w .__tk__messagebox
    }

    # 3. Create the top-level window and divide it into top
    # and bottom parts.

    catch {destroy $w}
    toplevel $w -class Dialog
    wm title $w $data(-title)
    wm iconname $w Dialog
    wm protocol $w WM_DELETE_WINDOW { }
    wm transient $w $data(-parent)
    if {$tcl_platform(platform) == "macintosh"} {
	unsupported1 style $w dBoxProc
    }

    frame $w.bot
    pack $w.bot -side bottom -fill both
    frame $w.top
    pack $w.top -side top -fill both -expand 1
    if {$tcl_platform(platform) != "macintosh"} {
	$w.bot configure -relief raised -bd 1
	$w.top configure -relief raised -bd 1
    }

    # 4. Fill the top part with bitmap and message (use the option
    # database for -wraplength so that it can be overridden by
    # the caller).

    option add *Dialog.msg.wrapLength 3i widgetDefault
    label $w.msg -justify left -text $data(-message)
    catch {$w.msg configure -font \

		-Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
    }


    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
    if {$data(-icon) != ""} {
	label $w.bitmap -bitmap $data(-icon)
	pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
    }

    # 5. Create a row of buttons at the bottom of the dialog.

    set i 0
    foreach but $buttons {
	set name [lindex $but 0]
	set opts [lrange $but 1 end]
	if ![string compare $opts {}] {
	    # Capitalize the first letter of $name
	    set capName \
		[string toupper \
		    [string index $name 0]][string range $name 1 end]
	    set opts [list -text $capName]
	}

	eval button $w.$name $opts -command [list "set tkPriv(button) $name"]

	if ![string compare $name $data(-default)] {
	    $w.$name configure -default active
	}
	pack $w.$name -in $w.bot -side left -expand 1 \
	    -padx 3m -pady 2m

	# create the binding for the key accelerator, based on the underline
	#
	set underIdx [$w.$name cget -under]
	if {$underIdx >= 0} {
	    set key [string index [$w.$name cget -text] $underIdx]
	    bind $w <Alt-[string tolower $key]>  "$w.$name invoke"
	    bind $w <Alt-[string toupper $key]>  "$w.$name invoke"
	}
	incr i
    }

    # 6. Create a binding for <Return> on the dialog if there is a
    # default button.

    if [string compare $data(-default) ""] {
	bind $w <Return> "tkButtonInvoke $w.$data(-default)"
    }

    # 7. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w

    # 8. Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current $w]
    if {$oldGrab != ""} {
	set grabStatus [grab status $oldGrab]
    }
    grab $w
    if [string compare $data(-default) ""] {
	focus $w.$data(-default)
    } else {
	focus $w
    }

    # 9. Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

    tkwait variable tkPriv(button)
    catch {focus $oldFocus}
    destroy $w
    if {$oldGrab != ""} {
	if {$grabStatus == "global"} {
	    grab -global $oldGrab
	} else {
	    grab $oldGrab
	}
    }
    return $tkPriv(button)
}







|



|


|




|







|














|







|





|
|


|
|
>
|

>
>

|










|

|
<




|

|


|
<






|
|







|
|








|
|
|
|







|



|














|
|







101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182

183
184
185
186
187
188
189
190
191
192

193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
	    set buttons {
		{yes    -width 6 -text Yes -under 0}
		{no     -width 6 -text No  -under 0}
		{cancel -width 6 -text Cancel -under 0}
	    }
	}
	default {
	    error "bad -type value \"$data(-type)\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel"
	}
    }

    if {[string compare $data(-default) ""]} {
	set valid 0
	foreach btn $buttons {
	    if {![string compare [lindex $btn 0] $data(-default)]} {
		set valid 1
		break
	    }
	}
	if {!$valid} {
	    error "invalid default button \"$data(-default)\""
	}
    }

    # 2. Set the dialog to be a child window of $parent
    #
    #
    if {[string compare $data(-parent) .]} {
	set w $data(-parent).__tk__messagebox
    } else {
	set w .__tk__messagebox
    }

    # 3. Create the top-level window and divide it into top
    # and bottom parts.

    catch {destroy $w}
    toplevel $w -class Dialog
    wm title $w $data(-title)
    wm iconname $w Dialog
    wm protocol $w WM_DELETE_WINDOW { }
    wm transient $w $data(-parent)
    if {![string compare $tcl_platform(platform) "macintosh"]} {
	unsupported1 style $w dBoxProc
    }

    frame $w.bot
    pack $w.bot -side bottom -fill both
    frame $w.top
    pack $w.top -side top -fill both -expand 1
    if {[string compare $tcl_platform(platform) "macintosh"]} {
	$w.bot configure -relief raised -bd 1
	$w.top configure -relief raised -bd 1
    }

    # 4. Fill the top part with bitmap and message (use the option
    # database for -wraplength and -font so that they can be
    # overridden by the caller).

    option add *Dialog.msg.wrapLength 3i widgetDefault
    if {![string compare $tcl_platform(platform) "macintosh"]} {
	option add *Dialog.msg.font system widgetDefault
    } else {
	option add *Dialog.msg.font {Times 18} widgetDefault
    }

    label $w.msg -justify left -text $data(-message)
    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
    if {[string compare $data(-icon) ""]} {
	label $w.bitmap -bitmap $data(-icon)
	pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
    }

    # 5. Create a row of buttons at the bottom of the dialog.

    set i 0
    foreach but $buttons {
	set name [lindex $but 0]
	set opts [lrange $but 1 end]
      if {![llength $opts]} {
	    # Capitalize the first letter of $name
          set capName [string toupper \

		    [string index $name 0]][string range $name 1 end]
	    set opts [list -text $capName]
	}

      eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]

	if {![string compare $name $data(-default)]} {
	    $w.$name configure -default active
	}
      pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m


	# create the binding for the key accelerator, based on the underline
	#
	set underIdx [$w.$name cget -under]
	if {$underIdx >= 0} {
	    set key [string index [$w.$name cget -text] $underIdx]
          bind $w <Alt-[string tolower $key]>  [list $w.$name invoke]
          bind $w <Alt-[string toupper $key]>  [list $w.$name invoke]
	}
	incr i
    }

    # 6. Create a binding for <Return> on the dialog if there is a
    # default button.

    if {[string compare $data(-default) ""]} {
      bind $w <Return> [list tkButtonInvoke $w.$data(-default)]
    }

    # 7. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]}]
    set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]}]
    wm geom $w +$x+$y
    wm deiconify $w

    # 8. Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current $w]
    if {[string compare $oldGrab ""]} {
	set grabStatus [grab status $oldGrab]
    }
    grab $w
    if {[string compare $data(-default) ""]} {
	focus $w.$data(-default)
    } else {
	focus $w
    }

    # 9. Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

    tkwait variable tkPriv(button)
    catch {focus $oldFocus}
    destroy $w
    if {[string compare $oldGrab ""]} {
      if {![string compare $grabStatus "global"]} {
	    grab -global $oldGrab
	} else {
	    grab $oldGrab
	}
    }
    return $tkPriv(button)
}

Changes to library/obsolete.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# obsolete.tcl --
#
# This file contains obsolete procedures that people really shouldn't
# be using anymore, but which are kept around for backward compatibility.
#
# SCCS: @(#) obsolete.tcl 1.3 96/02/16 10:48:19
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# obsolete.tcl --
#
# This file contains obsolete procedures that people really shouldn't
# be using anymore, but which are kept around for backward compatibility.
#
# RCS: @(#) $Id: obsolete.tcl,v 1.1.4.1 1998/09/30 02:17:34 stanton Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

Changes to library/optMenu.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# optMenu.tcl --
#
# This file defines the procedure tk_optionMenu, which creates
# an option button and its associated menu.
#
# SCCS: @(#) optMenu.tcl 1.11 97/08/22 14:21:13
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#





|







1
2
3
4
5
6
7
8
9
10
11
12
13
# optMenu.tcl --
#
# This file defines the procedure tk_optionMenu, which creates
# an option button and its associated menu.
#
# RCS: @(#) $Id: optMenu.tcl,v 1.1.4.2 1998/09/30 02:17:35 stanton Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
# varName -		Global variable to hold the currently selected value.
# firstValue -		First of legal values for option (must be >= 1).
# args -		Any number of additional values.

proc tk_optionMenu {w varName firstValue args} {
    upvar #0 $varName var

    if ![info exists var] {
	set var $firstValue
    }
    menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu \
	    -relief raised -bd 2 -highlightthickness 2 -anchor c \
	    -direction flush
    menu $w.menu -tearoff 0
    $w.menu add radiobutton -label $firstValue -variable $varName
    foreach i $args {
    	$w.menu add radiobutton -label $i -variable $varName
    }
    return $w.menu
}







|












26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
# varName -		Global variable to hold the currently selected value.
# firstValue -		First of legal values for option (must be >= 1).
# args -		Any number of additional values.

proc tk_optionMenu {w varName firstValue args} {
    upvar #0 $varName var

    if {![info exists var]} {
	set var $firstValue
    }
    menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu \
	    -relief raised -bd 2 -highlightthickness 2 -anchor c \
	    -direction flush
    menu $w.menu -tearoff 0
    $w.menu add radiobutton -label $firstValue -variable $varName
    foreach i $args {
    	$w.menu add radiobutton -label $i -variable $varName
    }
    return $w.menu
}

Changes to library/palette.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# palette.tcl --
#
# This file contains procedures that change the color palette used
# by Tk.
#
# SCCS: @(#) palette.tcl 1.11 97/06/23 20:35:44
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#






|







1
2
3
4
5
6
7
8
9
10
11
12
13
# palette.tcl --
#
# This file contains procedures that change the color palette used
# by Tk.
#
# RCS: @(#) $Id: palette.tcl,v 1.1.4.3 1999/04/06 03:52:57 stanton Exp $
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

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
    # aren't specified, compute them from other colors that are specified.

    if {[llength $args] == 1} {
	set new(background) [lindex $args 0]
    } else {
	array set new $args
    }
    if ![info exists new(background)] {
	error "must specify a background color"
    }
    if ![info exists new(foreground)] {
	set new(foreground) black
    }
    set bg [winfo rgb . $new(background)]
    set fg [winfo rgb . $new(foreground)]
    set darkerBg [format #%02x%02x%02x [expr (9*[lindex $bg 0])/2560] \
	    [expr (9*[lindex $bg 1])/2560] [expr (9*[lindex $bg 2])/2560]]
    foreach i {activeForeground insertBackground selectForeground \
	    highlightColor} {
	if ![info exists new($i)] {
	    set new($i) $new(foreground)
	}
    }
    if ![info exists new(disabledForeground)] {
	set new(disabledForeground) [format #%02x%02x%02x \
		[expr (3*[lindex $bg 0] + [lindex $fg 0])/1024] \
		[expr (3*[lindex $bg 1] + [lindex $fg 1])/1024] \
		[expr (3*[lindex $bg 2] + [lindex $fg 2])/1024]]
    }
    if ![info exists new(highlightBackground)] {
	set new(highlightBackground) $new(background)
    }
    if ![info exists new(activeBackground)] {
	# Pick a default active background that islighter than the
	# normal background.  To do this, round each color component
	# up by 15% or 1/3 of the way to full white, whichever is
	# greater.

	foreach i {0 1 2} {
	    set light($i) [expr [lindex $bg $i]/256]
	    set inc1 [expr ($light($i)*15)/100]
	    set inc2 [expr (255-$light($i))/3]
	    if {$inc1 > $inc2} {
		incr light($i) $inc1
	    } else {
		incr light($i) $inc2
	    }
	    if {$light($i) > 255} {
		set light($i) 255
	    }
	}
	set new(activeBackground) [format #%02x%02x%02x $light(0) \
		$light(1) $light(2)]
    }
    if ![info exists new(selectBackground)] {
	set new(selectBackground) $darkerBg
    }
    if ![info exists new(troughColor)] {
	set new(troughColor) $darkerBg
    }
    if ![info exists new(selectColor)] {
	set new(selectColor) #b03060
    }

    # let's make one of each of the widgets so we know what the 
    # defaults are currently for this platform.
    toplevel .___tk_set_palette
    wm withdraw .___tk_set_palette







|


|




|
|


|



|

|
|
|

|


|






|
|
|












|


|


|







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
    # aren't specified, compute them from other colors that are specified.

    if {[llength $args] == 1} {
	set new(background) [lindex $args 0]
    } else {
	array set new $args
    }
    if {![info exists new(background)]} {
	error "must specify a background color"
    }
    if {![info exists new(foreground)]} {
	set new(foreground) black
    }
    set bg [winfo rgb . $new(background)]
    set fg [winfo rgb . $new(foreground)]
    set darkerBg [format #%02x%02x%02x [expr {(9*[lindex $bg 0])/2560}] \
	    [expr {(9*[lindex $bg 1])/2560}] [expr {(9*[lindex $bg 2])/2560}]]
    foreach i {activeForeground insertBackground selectForeground \
	    highlightColor} {
	if {![info exists new($i)]} {
	    set new($i) $new(foreground)
	}
    }
    if {![info exists new(disabledForeground)]} {
	set new(disabledForeground) [format #%02x%02x%02x \
		[expr {(3*[lindex $bg 0] + [lindex $fg 0])/1024}] \
		[expr {(3*[lindex $bg 1] + [lindex $fg 1])/1024}] \
		[expr {(3*[lindex $bg 2] + [lindex $fg 2])/1024}]]
    }
    if {![info exists new(highlightBackground)]} {
	set new(highlightBackground) $new(background)
    }
    if {![info exists new(activeBackground)]} {
	# Pick a default active background that islighter than the
	# normal background.  To do this, round each color component
	# up by 15% or 1/3 of the way to full white, whichever is
	# greater.

	foreach i {0 1 2} {
	    set light($i) [expr {[lindex $bg $i]/256}]
	    set inc1 [expr {($light($i)*15)/100}]
	    set inc2 [expr {(255-$light($i))/3}]
	    if {$inc1 > $inc2} {
		incr light($i) $inc1
	    } else {
		incr light($i) $inc2
	    }
	    if {$light($i) > 255} {
		set light($i) 255
	    }
	}
	set new(activeBackground) [format #%02x%02x%02x $light(0) \
		$light(1) $light(2)]
    }
    if {![info exists new(selectBackground)]} {
	set new(selectBackground) $darkerBg
    }
    if {![info exists new(troughColor)]} {
	set new(troughColor) $darkerBg
    }
    if {![info exists new(selectColor)]} {
	set new(selectColor) #b03060
    }

    # let's make one of each of the widgets so we know what the 
    # defaults are currently for this platform.
    toplevel .___tk_set_palette
    wm withdraw .___tk_set_palette
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
# Arguments:
# color -	Name of starting color.
# perecent -	Integer telling how much to brighten or darken as a
#		percent: 50 means darken by 50%, 110 means brighten
#		by 10%.

proc tkDarken {color percent} {
    set l [winfo rgb . $color]
    set red [expr [lindex $l 0]/256]
    set green [expr [lindex $l 1]/256]
    set blue [expr [lindex $l 2]/256]
    set red [expr ($red*$percent)/100]

    if {$red > 255} {
	set red 255
    }
    set green [expr ($green*$percent)/100]
    if {$green > 255} {
	set green 255
    }
    set blue [expr ($blue*$percent)/100]
    if {$blue > 255} {
	set blue 255
    }
    format #%02x%02x%02x $red $green $blue
}

# tk_bisque --
# Reset the Tk color palette to the old "bisque" colors.
#
# Arguments:
# None.







|
|
|
|
|
>



<



<



|







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
# Arguments:
# color -	Name of starting color.
# perecent -	Integer telling how much to brighten or darken as a
#		percent: 50 means darken by 50%, 110 means brighten
#		by 10%.

proc tkDarken {color percent} {
    foreach {red green blue} [winfo rgb . $color] {
      set red [expr {($red/256)*$percent/100}]
      set green [expr {($green/256)*$percent/100}]
      set blue [expr {($blue/256)*$percent/100}]
      break
    }
    if {$red > 255} {
	set red 255
    }

    if {$green > 255} {
	set green 255
    }

    if {$blue > 255} {
	set blue 255
    }
    return [format "#%02x%02x%02x" $red $green $blue]
}

# tk_bisque --
# Reset the Tk color palette to the old "bisque" colors.
#
# Arguments:
# None.

Changes to library/prolog.ps.

1
2
3
4
5
6
7
8
9
10
11
12
13
%%BeginProlog
50 dict begin

% This is a standard prolog for Postscript generated by Tk's canvas
% widget.
% SCCS: @(#) prolog.ps 1.7 96/07/08 17:52:14

% The definitions below just define all of the variables used in
% any of the procedures here.  This is needed for obscure reasons
% explained on p. 716 of the Postscript manual (Section H.2.7,
% "Initializing Variables," in the section on Encapsulated Postscript).

/baseline 0 def





|







1
2
3
4
5
6
7
8
9
10
11
12
13
%%BeginProlog
50 dict begin

% This is a standard prolog for Postscript generated by Tk's canvas
% widget.
% RCS: @(#) $Id: prolog.ps,v 1.1.4.2 1999/02/11 04:13:48 stanton Exp $

% The definitions below just define all of the variables used in
% any of the procedures here.  This is needed for obscure reasons
% explained on p. 716 of the Postscript manual (Section H.2.7,
% "Initializing Variables," in the section on Encapsulated Postscript).

/baseline 0 def
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
	stringwidth pop
	dup lineLength gt {/lineLength exch def} {pop} ifelse
	newpath
    } forall

    % Compute the baseline offset and the actual font height.

    0 0 moveto (TXygqPZ) false charpath
    pathbbox dup /baseline exch def
    exch pop exch sub /height exch def pop
    newpath

    % Translate coordinates first so that the origin is at the upper-left
    % corner of the text's bounding box. Remember that x and y for
    % positioning are still on the stack.







|







226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
	stringwidth pop
	dup lineLength gt {/lineLength exch def} {pop} ifelse
	newpath
    } forall

    % Compute the baseline offset and the actual font height.

    0 0 moveto (TXygqPZ) false charpath
    pathbbox dup /baseline exch def
    exch pop exch sub /height exch def pop
    newpath

    % Translate coordinates first so that the origin is at the upper-left
    % corner of the text's bounding box. Remember that x and y for
    % positioning are still on the stack.

Changes to library/safetk.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
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
# safetk.tcl --
#
# Support procs to use Tk in safe interpreters.
#
# SCCS: @(#) safetk.tcl 1.8 97/10/29 14:59:16
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# see safetk.n for documentation

#
#
# Note: It is UNSAFE to let any untrusted code being executed
#       between the creation of the interp and the actual loading
#       of Tk in that interp.
#       You should "loadTk $slave" right after safe::tkInterpCreate
#       Otherwise, if you are using an application with Tk
#       and don't want safe slaves to have access to Tk, potentially
#       in a malevolent way, you should use 
#            ::safe::interpCreate -nostatics -accesspath {directories...}
#       where the directory list does NOT contain any Tk dynamically
#       loadable library
#

# We use opt (optional arguments parsing)
package require opt 0.1;

namespace eval ::safe {

    # counter for safe toplevels
    variable tkSafeId 0;

    #
    # tkInterpInit : prepare the slave interpreter for tk loading
    #
    # returns the slave name (tkInterpInit does)
    #
    proc ::safe::tkInterpInit {slave} {
	global env tk_library
	if {[info exists env(DISPLAY)]} {

	    $slave eval [list set env(DISPLAY) $env(DISPLAY)];
	}
	# there seems to be an obscure case where the tk_library
	# variable value is changed to point to a sym link destination
	# dir instead of the sym link itself, and thus where the $tk_library
	# would then not be anymore one of the auto_path dir, so we use
	# the addToAccessPath which adds if it's not already in instead
	# of the more conventional findInAccessPath

	::interp eval $slave [list set tk_library [::safe::interpAddToAccessPath $slave $tk_library]]
	return $slave;
    }


# tkInterpLoadTk : 
# Do additional configuration as needed (calling tkInterpInit) 
# and actually load Tk into the slave.
# 
# Either contained in the specified windowId (-use) or
# creating a decorated toplevel for it.

# empty definition for auto_mkIndex
proc ::safe::loadTk {} {}
   
    ::tcl::OptProc loadTk {
	{slave -interp "name of the slave interpreter"}
	{-use  -windowId {} "window Id to use (new toplevel otherwise)"}

    } {















	if {![::tcl::OptProcArgGiven "-use"]} {

	    # create a decorated toplevel

	    ::tcl::Lassign [tkTopLevel $slave] w use;

	    # set our delete hook (slave arg is added by interpDelete)

	    Set [DeleteHookName $slave] [list tkDelete {} $w];
	}









































	tkInterpInit $slave;
	::interp eval $slave [list set argv [list "-use" $use]];
	::interp eval $slave [list set argc 2];
	load {} Tk $slave
	# Remove env(DISPLAY) if it's in there (if it has been set by























	# tkInterpInit)



	::interp eval $slave {catch {unset env(DISPLAY)}}



	return $slave
    }






























    proc ::safe::tkDelete {W window slave} {

	# we are going to be called for each widget... skip untill it's
	# top level

	Log $slave "Called tkDelete $W $window" NOTICE;
	if {[::interp exists $slave]} {
	    if {[catch {::safe::interpDelete $slave} msg]} {
		Log $slave "Deletion error : $msg";
	    }
	}
	if {[winfo exists $window]} {
	    Log $slave "Destroy toplevel $window" NOTICE;
	    destroy $window;
	}
    }





proc ::safe::tkTopLevel {slave} {
    variable tkSafeId;
    incr tkSafeId;
    set w ".safe$tkSafeId";
    if {[catch {toplevel $w -class SafeTk} msg]} {
	return -code error "Unable to create toplevel for\
		safe slave \"$slave\" ($msg)";
    }
    Log $slave "New toplevel $w" NOTICE

    set msg "Untrusted Tcl applet ($slave)"
    wm title $w $msg;




|










|

|
<
|
<
|
<
<
|



|








|


|

|
>
|
|





|
>















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

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



|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

19

20


21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137

138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
# safetk.tcl --
#
# Support procs to use Tk in safe interpreters.
#
# RCS: @(#) $Id: safetk.tcl,v 1.1.4.3 1999/04/03 03:07:11 hershey Exp $
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# see safetk.n for documentation

#
#
# Note: It is now ok to let untrusted code being executed
#       between the creation of the interp and the actual loading
#       of Tk in that interp because the C side Tk_Init will

#       now look up the master interp and ask its safe::TkInit

#       for the actual parameters to use for it's initialization (if allowed),


#       not relying on the slave state.
#

# We use opt (optional arguments parsing)
package require opt 0.4.1;

namespace eval ::safe {

    # counter for safe toplevels
    variable tkSafeId 0;

    #
    # tkInterpInit : prepare the slave interpreter for tk loading
    #                most of the real job is done by loadTk
    # returns the slave name (tkInterpInit does)
    #
    proc ::safe::tkInterpInit {slave argv} {
	global env tk_library

	# Clear Tk's access for that interp (path).
	allowTk $slave $argv

	# there seems to be an obscure case where the tk_library
	# variable value is changed to point to a sym link destination
	# dir instead of the sym link itself, and thus where the $tk_library
	# would then not be anymore one of the auto_path dir, so we use
	# the addToAccessPath which adds if it's not already in instead
	# of the more conventional findInAccessPath.
	# Might be usefull for masters without Tk really loaded too.
	::interp eval $slave [list set tk_library [::safe::interpAddToAccessPath $slave $tk_library]]
	return $slave;
    }


# tkInterpLoadTk : 
# Do additional configuration as needed (calling tkInterpInit) 
# and actually load Tk into the slave.
# 
# Either contained in the specified windowId (-use) or
# creating a decorated toplevel for it.

# empty definition for auto_mkIndex
proc ::safe::loadTk {} {}
   
::tcl::OptProc loadTk {
    {slave -interp "name of the slave interpreter"}
    {-use  -windowId {} "window Id to use (new toplevel otherwise)"}
    {-display -displayName {} "display name to use (current one otherwise)"}
} {
    set displayGiven [::tcl::OptProcArgGiven "-display"]
    if {!$displayGiven} {
	
	# Try to get the current display from "."
	# (which might not exist if the master is tk-less)
	
	if {[catch {set display [winfo screen .]}]} {
	    if {[info exists ::env(DISPLAY)]} {
		set display $::env(DISPLAY)
	    } else {
		Log $slave "no winfo screen . nor env(DISPLAY)" WARNING
		set display ":0.0"
	    }
	}
    }
    if {![::tcl::OptProcArgGiven "-use"]} {
	
	# create a decorated toplevel
	
	::tcl::Lassign [tkTopLevel $slave $display] w use;
	
	# set our delete hook (slave arg is added by interpDelete)
	# to clean up both window related code and tkInit(slave)
	Set [DeleteHookName $slave] [list tkDelete {} $w];

    } else {

	# set our delete hook (slave arg is added by interpDelete)
	# to clean up tkInit(slave)
	    
	Set [DeleteHookName $slave] [list disallowTk]

	# Let's be nice and also accept tk window names instead of ids
	
	if {[string match ".*" $use]} {
	    set windowName $use
	    set use [winfo id $windowName]
	    set nDisplay [winfo screen $windowName]
	} else {

	    # Check for a better -display value
	    # (works only for multi screens on single host, but not
	    #  cross hosts, for that a tk window name would be better
	    #  but embeding is also usefull for non tk names)
	    
	    if {![catch {winfo pathname $use} name]} {
		set nDisplay [winfo screen $name]
	    } else {

		# Can't have a better one
		
		set nDisplay $display
	    }
	}
	if {[string compare $nDisplay $display]} {
	    if {$displayGiven} {
		error "conflicting -display $display and -use\
			$use -> $nDisplay"
	    } else {
		set display $nDisplay
	    }
	}
    }

    # Prepares the slave for tk with those parameters
    
    tkInterpInit $slave [list "-use" $use "-display" $display]
    

    load {} Tk $slave

    return $slave
}

proc ::safe::TkInit {interpPath} {
    variable tkInit
    if {[info exists tkInit($interpPath)]} {
	set value $tkInit($interpPath)
	Log $interpPath "TkInit called, returning \"$value\"" NOTICE
	return $value
    } else {
	Log $interpPath "TkInit called for interp with clearance:\
		preventing Tk init" ERROR
	error "not allowed"
    }
}

# safe::allowTk --
#
#	Set tkInit(interpPath) to allow Tk to be initialized in
#	safe::TkInit.
#
# Arguments:
#	interpPath	slave interpreter handle
#	argv		arguments passed to safe::TkInterpInit
#
# Results:
#	none.

proc ::safe::allowTk {interpPath argv} {
    variable tkInit
    set tkInit($interpPath) $argv
    return
}


# safe::disallowTk --
#
#	Unset tkInit(interpPath) to disallow Tk from getting initialized
#	in safe::TkInit.
#
# Arguments:
#	interpPath	slave interpreter handle
#
# Results:
#	none.

proc ::safe::disallowTk {interpPath} {
    variable tkInit
    unset tkInit($interpPath)
    none
}


# safe::disallowTk --
#
#	Clean up the window associated with the interp being deleted.
#
# Arguments:
#	interpPath	slave interpreter handle
#
# Results:
#	none.

proc ::safe::tkDelete {W window slave} {

    # we are going to be called for each widget... skip untill it's
    # top level

    Log $slave "Called tkDelete $W $window" NOTICE;
    if {[::interp exists $slave]} {
	if {[catch {::safe::interpDelete $slave} msg]} {
	    Log $slave "Deletion error : $msg";
	}
    }
    if {[winfo exists $window]} {
	Log $slave "Destroy toplevel $window" NOTICE;
	destroy $window;
    }
    
    # clean up tkInit(slave)
    disallowTk $slave
    return
}

proc ::safe::tkTopLevel {slave display} {
    variable tkSafeId;
    incr tkSafeId;
    set w ".safe$tkSafeId";
    if {[catch {toplevel $w -screen $display -class SafeTk} msg]} {
	return -code error "Unable to create toplevel for\
		safe slave \"$slave\" ($msg)";
    }
    Log $slave "New toplevel $w" NOTICE

    set msg "Untrusted Tcl applet ($slave)"
    wm title $w $msg;

Changes to library/scale.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
# scale.tcl --
#
# This file defines the default bindings for Tk scale widgets and provides
# procedures that help in implementing the bindings.
#
# SCCS: @(#) scale.tcl 1.12 96/04/16 11:42:25
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# The code below creates the default class bindings for entries.
#-------------------------------------------------------------------------

# Standard Motif bindings:

bind Scale <Enter> {
    if $tk_strictMotif {
	set tkPriv(activeBg) [%W cget -activebackground]
	%W config -activebackground [%W cget -background]
    }
    tkScaleActivate %W %x %y
}
bind Scale <Motion> {
    tkScaleActivate %W %x %y
}
bind Scale <Leave> {
    if $tk_strictMotif {
	%W config -activebackground $tkPriv(activeBg)
    }
    if {[%W cget -state] == "active"} {
	%W configure -state normal
    }
}
bind Scale <1> {
    tkScaleButtonDown %W %x %y
}
bind Scale <B1-Motion> {





|















|









|


|







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
# scale.tcl --
#
# This file defines the default bindings for Tk scale widgets and provides
# procedures that help in implementing the bindings.
#
# RCS: @(#) $Id: scale.tcl,v 1.1.4.3 1999/04/06 03:52:57 stanton Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# The code below creates the default class bindings for entries.
#-------------------------------------------------------------------------

# Standard Motif bindings:

bind Scale <Enter> {
    if {$tk_strictMotif} {
	set tkPriv(activeBg) [%W cget -activebackground]
	%W config -activebackground [%W cget -background]
    }
    tkScaleActivate %W %x %y
}
bind Scale <Motion> {
    tkScaleActivate %W %x %y
}
bind Scale <Leave> {
    if {$tk_strictMotif} {
	%W config -activebackground $tkPriv(activeBg)
    }
    if {![string compare [%W cget -state] "active"]} {
	%W configure -state normal
    }
}
bind Scale <1> {
    tkScaleButtonDown %W %x %y
}
bind Scale <B1-Motion> {
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
#
# Arguments:
# w -		The scale widget.
# x, y -	Mouse coordinates.

proc tkScaleActivate {w x y} {
    global tkPriv
    if {[$w cget -state] == "disabled"} {
	return;
    }
    if {[$w identify $x $y] == "slider"} {
	$w configure -state active
    } else {
	$w configure -state normal
    }
}

# tkScaleButtonDown --
# This procedure is invoked when a button is pressed in a scale.  It
# takes different actions depending on where the button was pressed.
#
# Arguments:
# w -		The scale widget.
# x, y -	Mouse coordinates of button press.

proc tkScaleButtonDown {w x y} {
    global tkPriv
    set tkPriv(dragging) 0
    set el [$w identify $x $y]
    if {$el == "trough1"} {
	tkScaleIncrement $w up little initial
    } elseif {$el == "trough2"} {
	tkScaleIncrement $w down little initial
    } elseif {$el == "slider"} {
	set tkPriv(dragging) 1
	set tkPriv(initValue) [$w get]
	set coords [$w coords]
	set tkPriv(deltaX) [expr $x - [lindex $coords 0]]
	set tkPriv(deltaY) [expr $y - [lindex $coords 1]]
	$w configure -sliderrelief sunken
    }
}

# tkScaleDrag --
# This procedure is called when the mouse is dragged with
# mouse button 1 down.  If the drag started inside the slider
# (i.e. the scale is active) then the scale's value is adjusted
# to reflect the mouse's position.
#
# Arguments:
# w -		The scale widget.
# x, y -	Mouse coordinates.

proc tkScaleDrag {w x y} {
    global tkPriv
    if !$tkPriv(dragging) {
	return
    }
    $w set [$w get [expr $x - $tkPriv(deltaX)] \
	    [expr $y - $tkPriv(deltaY)]]
}

# tkScaleEndDrag --
# This procedure is called to end an interactive drag of the
# slider.  It just marks the drag as over.
#
# Arguments:







|
|

|


















|

|

|



|
|
















|


|
|







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
#
# Arguments:
# w -		The scale widget.
# x, y -	Mouse coordinates.

proc tkScaleActivate {w x y} {
    global tkPriv
    if {![string compare [$w cget -state] "disabled"]} {
      return
    }
    if {![string compare [$w identify $x $y] "slider"]} {
	$w configure -state active
    } else {
	$w configure -state normal
    }
}

# tkScaleButtonDown --
# This procedure is invoked when a button is pressed in a scale.  It
# takes different actions depending on where the button was pressed.
#
# Arguments:
# w -		The scale widget.
# x, y -	Mouse coordinates of button press.

proc tkScaleButtonDown {w x y} {
    global tkPriv
    set tkPriv(dragging) 0
    set el [$w identify $x $y]
    if {![string compare $el "trough1"]} {
	tkScaleIncrement $w up little initial
    } elseif {![string compare $el "trough2"]} {
	tkScaleIncrement $w down little initial
    } elseif {![string compare $el "slider"]} {
	set tkPriv(dragging) 1
	set tkPriv(initValue) [$w get]
	set coords [$w coords]
	set tkPriv(deltaX) [expr {$x - [lindex $coords 0]}]
	set tkPriv(deltaY) [expr {$y - [lindex $coords 1]}]
	$w configure -sliderrelief sunken
    }
}

# tkScaleDrag --
# This procedure is called when the mouse is dragged with
# mouse button 1 down.  If the drag started inside the slider
# (i.e. the scale is active) then the scale's value is adjusted
# to reflect the mouse's position.
#
# Arguments:
# w -		The scale widget.
# x, y -	Mouse coordinates.

proc tkScaleDrag {w x y} {
    global tkPriv
    if {!$tkPriv(dragging)} {
	return
    }
    $w set [$w get [expr {$x - $tkPriv(deltaX)}] \
	    [expr {$y - $tkPriv(deltaY)}]]
}

# tkScaleEndDrag --
# This procedure is called to end an interactive drag of the
# slider.  It just marks the drag as over.
#
# Arguments:
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
#		means don't auto-repeat, "initial" means this is the
#		first action in an auto-repeat sequence, and "again"
#		means this is the second repetition or later.

proc tkScaleIncrement {w dir big repeat} {
    global tkPriv
    if {![winfo exists $w]} return
    if {$big == "big"} {
	set inc [$w cget -bigincrement]
	if {$inc == 0} {
	    set inc [expr abs([$w cget -to] - [$w cget -from])/10.0]
	}
	if {$inc < [$w cget -resolution]} {
	    set inc [$w cget -resolution]
	}
    } else {
	set inc [$w cget -resolution]
    }
    if {([$w cget -from] > [$w cget -to]) ^ ($dir == "up")} {
	set inc [expr -$inc]
    }
    $w set [expr [$w get] + $inc]

    if {$repeat == "again"} {
	set tkPriv(afterId) [after [$w cget -repeatinterval] \
		tkScaleIncrement $w $dir $big again]
    } elseif {$repeat == "initial"} {
	set delay [$w cget -repeatdelay]
	if {$delay > 0} {
	    set tkPriv(afterId) [after $delay \
		    tkScaleIncrement $w $dir $big again]
	}
    }
}

# tkScaleControlPress --
# This procedure handles button presses that are made with the Control
# key down.  Depending on the mouse position, it adjusts the scale
# value to one end of the range or the other.
#
# Arguments:
# w -		The scale widget.
# x, y -	Mouse coordinates where the button was pressed.

proc tkScaleControlPress {w x y} {
    set el [$w identify $x $y]
    if {$el == "trough1"} {
	$w set [$w cget -from]
    } elseif {$el == "trough2"} {
	$w set [$w cget -to]
    }
}

# tkScaleButton2Down
# This procedure is invoked when button 2 is pressed over a scale.
# It sets the value to correspond to the mouse position and starts
# a slider drag.
#
# Arguments:
# w -		The scrollbar widget.
# x, y -	Mouse coordinates within the widget.

proc tkScaleButton2Down {w x y} {
    global tkPriv

    if {[$w cget -state] == "disabled"} {
	return;
    }
    $w configure -state active
    $w set [$w get $x $y]
    set tkPriv(dragging) 1
    set tkPriv(initValue) [$w get]
    set coords "$x $y"
    set tkPriv(deltaX) 0
    set tkPriv(deltaY) 0
}







|


|







|
|

|

|


|



















|

|
















|
|









190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
#		means don't auto-repeat, "initial" means this is the
#		first action in an auto-repeat sequence, and "again"
#		means this is the second repetition or later.

proc tkScaleIncrement {w dir big repeat} {
    global tkPriv
    if {![winfo exists $w]} return
    if {![string compare $big "big"]} {
	set inc [$w cget -bigincrement]
	if {$inc == 0} {
	    set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]
	}
	if {$inc < [$w cget -resolution]} {
	    set inc [$w cget -resolution]
	}
    } else {
	set inc [$w cget -resolution]
    }
    if {([$w cget -from] > [$w cget -to]) ^ ![string compare $dir "up"]} {
	set inc [expr {-$inc}]
    }
    $w set [expr {[$w get] + $inc}]

    if {![string compare $repeat "again"]} {
	set tkPriv(afterId) [after [$w cget -repeatinterval] \
		tkScaleIncrement $w $dir $big again]
    } elseif {![string compare $repeat "initial"]} {
	set delay [$w cget -repeatdelay]
	if {$delay > 0} {
	    set tkPriv(afterId) [after $delay \
		    tkScaleIncrement $w $dir $big again]
	}
    }
}

# tkScaleControlPress --
# This procedure handles button presses that are made with the Control
# key down.  Depending on the mouse position, it adjusts the scale
# value to one end of the range or the other.
#
# Arguments:
# w -		The scale widget.
# x, y -	Mouse coordinates where the button was pressed.

proc tkScaleControlPress {w x y} {
    set el [$w identify $x $y]
    if {![string compare $el "trough1"]} {
	$w set [$w cget -from]
    } elseif {![string compare $el "trough2"]} {
	$w set [$w cget -to]
    }
}

# tkScaleButton2Down
# This procedure is invoked when button 2 is pressed over a scale.
# It sets the value to correspond to the mouse position and starts
# a slider drag.
#
# Arguments:
# w -		The scrollbar widget.
# x, y -	Mouse coordinates within the widget.

proc tkScaleButton2Down {w x y} {
    global tkPriv

    if {![string compare [$w cget -state] "disabled"]} {
      return
    }
    $w configure -state active
    $w set [$w get $x $y]
    set tkPriv(dragging) 1
    set tkPriv(initValue) [$w get]
    set coords "$x $y"
    set tkPriv(deltaX) 0
    set tkPriv(deltaY) 0
}

Changes to library/scrlbar.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
# scrlbar.tcl --
#
# This file defines the default bindings for Tk scrollbar widgets.
# It also provides procedures that help in implementing the bindings.
#
# SCCS: @(#) scrlbar.tcl 1.26 96/11/30 17:19:16
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# The code below creates the default class bindings for scrollbars.
#-------------------------------------------------------------------------

# Standard Motif bindings:
if {($tcl_platform(platform) != "windows") &&
    ($tcl_platform(platform) != "macintosh")} {
bind Scrollbar <Enter> {
    if $tk_strictMotif {
	set tkPriv(activeBg) [%W cget -activebackground]
	%W config -activebackground [%W cget -background]
    }
    %W activate [%W identify %x %y]
}
bind Scrollbar <Motion> {
    %W activate [%W identify %x %y]





|













|
|

|







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
# scrlbar.tcl --
#
# This file defines the default bindings for Tk scrollbar widgets.
# It also provides procedures that help in implementing the bindings.
#
# RCS: @(#) $Id: scrlbar.tcl,v 1.1.4.4 1999/04/06 03:52:58 stanton Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# The code below creates the default class bindings for scrollbars.
#-------------------------------------------------------------------------

# Standard Motif bindings:
if {[string compare $tcl_platform(platform) "windows"] &&
    [string compare $tcl_platform(platform) "macintosh"]} {
bind Scrollbar <Enter> {
    if {$tk_strictMotif} {
	set tkPriv(activeBg) [%W cget -activebackground]
	%W config -activebackground [%W cget -background]
    }
    %W activate [%W identify %x %y]
}
bind Scrollbar <Motion> {
    %W activate [%W identify %x %y]
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
# x, y -	Mouse coordinates.

proc tkScrollButtonDown {w x y} {
    global tkPriv
    set tkPriv(relief) [$w cget -activerelief]
    $w configure -activerelief sunken
    set element [$w identify $x $y]
    if {$element == "slider"} {
	tkScrollStartDrag $w $x $y
    } else {
	tkScrollSelect $w $element initial
    }
}

# tkScrollButtonUp --







|







140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
# x, y -	Mouse coordinates.

proc tkScrollButtonDown {w x y} {
    global tkPriv
    set tkPriv(relief) [$w cget -activerelief]
    $w configure -activerelief sunken
    set element [$w identify $x $y]
    if {![string compare $element "slider"]} {
	tkScrollStartDrag $w $x $y
    } else {
	tkScrollSelect $w $element initial
    }
}

# tkScrollButtonUp --
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
#		means don't auto-repeat, "initial" means this is the
#		first action in an auto-repeat sequence, and "again"
#		means this is the second repetition or later.

proc tkScrollSelect {w element repeat} {
    global tkPriv
    if {![winfo exists $w]} return
    if {$element == "arrow1"} {
	tkScrollByUnits $w hv -1
    } elseif {$element == "trough1"} {
	tkScrollByPages $w hv -1
    } elseif {$element == "trough2"} {
	tkScrollByPages $w hv 1
    } elseif {$element == "arrow2"} {
	tkScrollByUnits $w hv 1
    } else {
	return
    }
    if {$repeat == "again"} {
	set tkPriv(afterId) [after [$w cget -repeatinterval] \
		tkScrollSelect $w $element again]
    } elseif {$repeat == "initial"} {
	set delay [$w cget -repeatdelay]
	if {$delay > 0} {
	    set tkPriv(afterId) [after $delay tkScrollSelect $w $element again]
	}
    }
}

# tkScrollStartDrag --
# This procedure is called to initiate a drag of the slider.  It just
# remembers the starting position of the mouse and slider.
#
# Arguments:
# w -		The scrollbar widget.
# x, y -	The mouse position at the start of the drag operation.

proc tkScrollStartDrag {w x y} {
    global tkPriv

    if {[$w cget -command] == ""} {
	return
    }
    set tkPriv(pressX) $x
    set tkPriv(pressY) $y
    set tkPriv(initValues) [$w get]
    set iv0 [lindex $tkPriv(initValues) 0]
    if {[llength $tkPriv(initValues)] == 2} {
	set tkPriv(initPos) $iv0
    } else {
	if {$iv0 == 0} {
	    set tkPriv(initPos) 0.0
	} else {
	    set tkPriv(initPos) [expr (double([lindex $tkPriv(initValues) 2])) \
		    / [lindex $tkPriv(initValues) 0]]
	}
    }
}

# tkScrollDrag --
# This procedure is called for each mouse motion even when the slider
# is being dragged.  It notifies the associated widget if we're not
# jump scrolling, and it just updates the scrollbar if we are jump
# scrolling.
#
# Arguments:
# w -		The scrollbar widget.
# x, y -	The current mouse position.

proc tkScrollDrag {w x y} {
    global tkPriv

    if {$tkPriv(initPos) == ""} {
	return
    }
    set delta [$w delta [expr $x - $tkPriv(pressX)] [expr $y - $tkPriv(pressY)]]
    if [$w cget -jump] {
	if {[llength $tkPriv(initValues)] == 2} {
	    $w set [expr [lindex $tkPriv(initValues) 0] + $delta] \
		    [expr [lindex $tkPriv(initValues) 1] + $delta]
	} else {
	    set delta [expr round($delta * [lindex $tkPriv(initValues) 0])]
	    eval $w set [lreplace $tkPriv(initValues) 2 3 \
		    [expr [lindex $tkPriv(initValues) 2] + $delta] \
		    [expr [lindex $tkPriv(initValues) 3] + $delta]]
	}
    } else {
	tkScrollToPos $w [expr $tkPriv(initPos) + $delta]
    }
}

# tkScrollEndDrag --
# This procedure is called to end an interactive drag of the slider.
# It scrolls the window if we're in jump mode, otherwise it does nothing.
#
# Arguments:
# w -		The scrollbar widget.
# x, y -	The mouse position at the end of the drag operation.

proc tkScrollEndDrag {w x y} {
    global tkPriv

    if {$tkPriv(initPos) == ""} {
	return
    }
    if [$w cget -jump] {
	set delta [$w delta [expr $x - $tkPriv(pressX)] \
		[expr $y - $tkPriv(pressY)]]
	tkScrollToPos $w [expr $tkPriv(initPos) + $delta]
    }
    set tkPriv(initPos) ""
}

# tkScrollByUnits --
# This procedure tells the scrollbar's associated widget to scroll up
# or down by a given number of units.  It notifies the associated widget
# in different ways for old and new command syntaxes.
#
# Arguments:
# w -		The scrollbar widget.
# orient -	Which kinds of scrollbars this applies to:  "h" for
#		horizontal, "v" for vertical, "hv" for both.
# amount -	How many units to scroll:  typically 1 or -1.

proc tkScrollByUnits {w orient amount} {
    set cmd [$w cget -command]
    if {($cmd == "") || ([string first \
	    [string index [$w cget -orient] 0] $orient] < 0)} {
	return
    }
    set info [$w get]
    if {[llength $info] == 2} {
	uplevel #0 $cmd scroll $amount units
    } else {
	uplevel #0 $cmd [expr [lindex $info 2] + $amount]
    }
}

# tkScrollByPages --
# This procedure tells the scrollbar's associated widget to scroll up
# or down by a given number of screenfuls.  It notifies the associated
# widget in different ways for old and new command syntaxes.
#
# Arguments:
# w -		The scrollbar widget.
# orient -	Which kinds of scrollbars this applies to:  "h" for
#		horizontal, "v" for vertical, "hv" for both.
# amount -	How many screens to scroll:  typically 1 or -1.

proc tkScrollByPages {w orient amount} {
    set cmd [$w cget -command]
    if {($cmd == "") || ([string first \
	    [string index [$w cget -orient] 0] $orient] < 0)} {
	return
    }
    set info [$w get]
    if {[llength $info] == 2} {
	uplevel #0 $cmd scroll $amount pages
    } else {
	uplevel #0 $cmd [expr [lindex $info 2] + $amount*([lindex $info 1] - 1)]
    }
}

# tkScrollToPos --
# This procedure tells the scrollbar's associated widget to scroll to
# a particular location, given by a fraction between 0 and 1.  It notifies
# the associated widget in different ways for old and new command syntaxes.
#
# Arguments:
# w -		The scrollbar widget.
# pos -		A fraction between 0 and 1 indicating a desired position
#		in the document.

proc tkScrollToPos {w pos} {
    set cmd [$w cget -command]
    if {($cmd == "")} {
	return
    }
    set info [$w get]
    if {[llength $info] == 2} {
	uplevel #0 $cmd moveto $pos
    } else {
	uplevel #0 $cmd [expr round([lindex $info 0]*$pos)]
    }
}

# tkScrollTopBottom
# Scroll to the top or bottom of the document, depending on the mouse
# position.
#
# Arguments:
# w -		The scrollbar widget.
# x, y -	Mouse coordinates within the widget.

proc tkScrollTopBottom {w x y} {
    global tkPriv
    set element [$w identify $x $y]
    if [string match *1 $element] {
	tkScrollToPos $w 0
    } elseif [string match *2 $element] {
	tkScrollToPos $w 1
    }

    # Set tkPriv(relief), since it's needed by tkScrollButtonUp.

    set tkPriv(relief) [$w cget -activerelief]
}







|
|
<
|
<
|
<
|
<
|

|


|


















|












|
|

















|


|
|

|
|

|

|
|


|














|


|
|
|
|

















|







|
















|







|















|






|














|

|







181
182
183
184
185
186
187
188
189

190

191

192

193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
#		means don't auto-repeat, "initial" means this is the
#		first action in an auto-repeat sequence, and "again"
#		means this is the second repetition or later.

proc tkScrollSelect {w element repeat} {
    global tkPriv
    if {![winfo exists $w]} return
    switch -- $element {
      "arrow1"        {tkScrollByUnits $w hv -1}

      "trough1"       {tkScrollByPages $w hv -1}

      "trough2"       {tkScrollByPages $w hv 1}

      "arrow2"        {tkScrollByUnits $w hv 1}

      default         {return}
    }
    if {![string compare $repeat "again"]} {
	set tkPriv(afterId) [after [$w cget -repeatinterval] \
		tkScrollSelect $w $element again]
    } elseif {![string compare $repeat "initial"]} {
	set delay [$w cget -repeatdelay]
	if {$delay > 0} {
	    set tkPriv(afterId) [after $delay tkScrollSelect $w $element again]
	}
    }
}

# tkScrollStartDrag --
# This procedure is called to initiate a drag of the slider.  It just
# remembers the starting position of the mouse and slider.
#
# Arguments:
# w -		The scrollbar widget.
# x, y -	The mouse position at the start of the drag operation.

proc tkScrollStartDrag {w x y} {
    global tkPriv

    if {![string compare [$w cget -command] ""]} {
	return
    }
    set tkPriv(pressX) $x
    set tkPriv(pressY) $y
    set tkPriv(initValues) [$w get]
    set iv0 [lindex $tkPriv(initValues) 0]
    if {[llength $tkPriv(initValues)] == 2} {
	set tkPriv(initPos) $iv0
    } else {
	if {$iv0 == 0} {
	    set tkPriv(initPos) 0.0
	} else {
	    set tkPriv(initPos) [expr {(double([lindex $tkPriv(initValues) 2])) \
		    / [lindex $tkPriv(initValues) 0]}]
	}
    }
}

# tkScrollDrag --
# This procedure is called for each mouse motion even when the slider
# is being dragged.  It notifies the associated widget if we're not
# jump scrolling, and it just updates the scrollbar if we are jump
# scrolling.
#
# Arguments:
# w -		The scrollbar widget.
# x, y -	The current mouse position.

proc tkScrollDrag {w x y} {
    global tkPriv

    if {![string compare $tkPriv(initPos) ""]} {
	return
    }
    set delta [$w delta [expr {$x - $tkPriv(pressX)}] [expr {$y - $tkPriv(pressY)}]]
    if {[$w cget -jump]} {
	if {[llength $tkPriv(initValues)] == 2} {
	    $w set [expr {[lindex $tkPriv(initValues) 0] + $delta}] \
		    [expr {[lindex $tkPriv(initValues) 1] + $delta}]
	} else {
	    set delta [expr {round($delta * [lindex $tkPriv(initValues) 0])}]
	    eval $w set [lreplace $tkPriv(initValues) 2 3 \
		    [expr {[lindex $tkPriv(initValues) 2] + $delta}] \
		    [expr {[lindex $tkPriv(initValues) 3] + $delta}]]
	}
    } else {
	tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}]
    }
}

# tkScrollEndDrag --
# This procedure is called to end an interactive drag of the slider.
# It scrolls the window if we're in jump mode, otherwise it does nothing.
#
# Arguments:
# w -		The scrollbar widget.
# x, y -	The mouse position at the end of the drag operation.

proc tkScrollEndDrag {w x y} {
    global tkPriv

    if {![string compare $tkPriv(initPos) ""]} {
	return
    }
    if {[$w cget -jump]} {
	set delta [$w delta [expr {$x - $tkPriv(pressX)}] \
		[expr {$y - $tkPriv(pressY)}]]
	tkScrollToPos $w [expr {$tkPriv(initPos) + $delta}]
    }
    set tkPriv(initPos) ""
}

# tkScrollByUnits --
# This procedure tells the scrollbar's associated widget to scroll up
# or down by a given number of units.  It notifies the associated widget
# in different ways for old and new command syntaxes.
#
# Arguments:
# w -		The scrollbar widget.
# orient -	Which kinds of scrollbars this applies to:  "h" for
#		horizontal, "v" for vertical, "hv" for both.
# amount -	How many units to scroll:  typically 1 or -1.

proc tkScrollByUnits {w orient amount} {
    set cmd [$w cget -command]
    if {![string compare $cmd ""] || ([string first \
	    [string index [$w cget -orient] 0] $orient] < 0)} {
	return
    }
    set info [$w get]
    if {[llength $info] == 2} {
	uplevel #0 $cmd scroll $amount units
    } else {
	uplevel #0 $cmd [expr {[lindex $info 2] + $amount}]
    }
}

# tkScrollByPages --
# This procedure tells the scrollbar's associated widget to scroll up
# or down by a given number of screenfuls.  It notifies the associated
# widget in different ways for old and new command syntaxes.
#
# Arguments:
# w -		The scrollbar widget.
# orient -	Which kinds of scrollbars this applies to:  "h" for
#		horizontal, "v" for vertical, "hv" for both.
# amount -	How many screens to scroll:  typically 1 or -1.

proc tkScrollByPages {w orient amount} {
    set cmd [$w cget -command]
    if {![string compare $cmd ""] || ([string first \
	    [string index [$w cget -orient] 0] $orient] < 0)} {
	return
    }
    set info [$w get]
    if {[llength $info] == 2} {
	uplevel #0 $cmd scroll $amount pages
    } else {
	uplevel #0 $cmd [expr {[lindex $info 2] + $amount*([lindex $info 1] - 1)}]
    }
}

# tkScrollToPos --
# This procedure tells the scrollbar's associated widget to scroll to
# a particular location, given by a fraction between 0 and 1.  It notifies
# the associated widget in different ways for old and new command syntaxes.
#
# Arguments:
# w -		The scrollbar widget.
# pos -		A fraction between 0 and 1 indicating a desired position
#		in the document.

proc tkScrollToPos {w pos} {
    set cmd [$w cget -command]
    if {![string compare $cmd ""]} {
	return
    }
    set info [$w get]
    if {[llength $info] == 2} {
	uplevel #0 $cmd moveto $pos
    } else {
	uplevel #0 $cmd [expr {round([lindex $info 0]*$pos)}]
    }
}

# tkScrollTopBottom
# Scroll to the top or bottom of the document, depending on the mouse
# position.
#
# Arguments:
# w -		The scrollbar widget.
# x, y -	Mouse coordinates within the widget.

proc tkScrollTopBottom {w x y} {
    global tkPriv
    set element [$w identify $x $y]
    if {[string match *1 $element]} {
	tkScrollToPos $w 0
    } elseif {[string match *2 $element]} {
	tkScrollToPos $w 1
    }

    # Set tkPriv(relief), since it's needed by tkScrollButtonUp.

    set tkPriv(relief) [$w cget -activerelief]
}
395
396
397
398
399
400
401
402

403
404
405
406
407
408
409
# Arguments:
# w -		The scrollbar widget.
# x, y -	Mouse coordinates within the widget.

proc tkScrollButton2Down {w x y} {
    global tkPriv
    set element [$w identify $x $y]
    if {($element == "arrow1") || ($element == "arrow2")} {

	tkScrollButtonDown $w $x $y
	return
    }
    tkScrollToPos $w [$w fraction $x $y]
    set tkPriv(relief) [$w cget -activerelief]

    # Need the "update idletasks" below so that the widget calls us







|
>







391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
# Arguments:
# w -		The scrollbar widget.
# x, y -	Mouse coordinates within the widget.

proc tkScrollButton2Down {w x y} {
    global tkPriv
    set element [$w identify $x $y]
    if {![string compare $element "arrow1"]
          || ![string compare $element "arrow2"]} {
	tkScrollButtonDown $w $x $y
	return
    }
    tkScrollToPos $w [$w fraction $x $y]
    set tkPriv(relief) [$w cget -activerelief]

    # Need the "update idletasks" below so that the widget calls us

Changes to library/tclIndex.

68
69
70
71
72
73
74

75
76
77
78
79
80
81
set auto_index(tkTraverseWithinMenu) [list source [file join $dir menu.tcl]]
set auto_index(tkMenuFirstEntry) [list source [file join $dir menu.tcl]]
set auto_index(tkMenuFindName) [list source [file join $dir menu.tcl]]
set auto_index(tkPostOverPoint) [list source [file join $dir menu.tcl]]
set auto_index(tkSaveGrabInfo) [list source [file join $dir menu.tcl]]
set auto_index(tkRestoreOldGrab) [list source [file join $dir menu.tcl]]
set auto_index(tk_menuSetFocus) [list source [file join $dir menu.tcl]]

set auto_index(tk_popup) [list source [file join $dir menu.tcl]]
set auto_index(tkScrollButtonDown) [list source [file join $dir scrlbar.tcl]]
set auto_index(tkScrollButtonUp) [list source [file join $dir scrlbar.tcl]]
set auto_index(tkScrollSelect) [list source [file join $dir scrlbar.tcl]]
set auto_index(tkScrollStartDrag) [list source [file join $dir scrlbar.tcl]]
set auto_index(tkScrollDrag) [list source [file join $dir scrlbar.tcl]]
set auto_index(tkScrollEndDrag) [list source [file join $dir scrlbar.tcl]]







>







68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
set auto_index(tkTraverseWithinMenu) [list source [file join $dir menu.tcl]]
set auto_index(tkMenuFirstEntry) [list source [file join $dir menu.tcl]]
set auto_index(tkMenuFindName) [list source [file join $dir menu.tcl]]
set auto_index(tkPostOverPoint) [list source [file join $dir menu.tcl]]
set auto_index(tkSaveGrabInfo) [list source [file join $dir menu.tcl]]
set auto_index(tkRestoreOldGrab) [list source [file join $dir menu.tcl]]
set auto_index(tk_menuSetFocus) [list source [file join $dir menu.tcl]]
set auto_index(tkGenerateMenuSelect) [list source [file join $dir menu.tcl]]
set auto_index(tk_popup) [list source [file join $dir menu.tcl]]
set auto_index(tkScrollButtonDown) [list source [file join $dir scrlbar.tcl]]
set auto_index(tkScrollButtonUp) [list source [file join $dir scrlbar.tcl]]
set auto_index(tkScrollSelect) [list source [file join $dir scrlbar.tcl]]
set auto_index(tkScrollStartDrag) [list source [file join $dir scrlbar.tcl]]
set auto_index(tkScrollDrag) [list source [file join $dir scrlbar.tcl]]
set auto_index(tkScrollEndDrag) [list source [file join $dir scrlbar.tcl]]
168
169
170
171
172
173
174


175
176
177
178
179
180
181
set auto_index(tkFocusGroup_BindIn) [list source [file join $dir comdlg.tcl]]
set auto_index(tkFocusGroup_BindOut) [list source [file join $dir comdlg.tcl]]
set auto_index(tkFocusGroup_Destroy) [list source [file join $dir comdlg.tcl]]
set auto_index(tkFocusGroup_In) [list source [file join $dir comdlg.tcl]]
set auto_index(tkFocusGroup_Out) [list source [file join $dir comdlg.tcl]]
set auto_index(tkFDGetFileTypes) [list source [file join $dir comdlg.tcl]]
set auto_index(::safe::loadTk) [list source [file join $dir safetk.tcl]]


set auto_index(::safe::tkTopLevel) [list source [file join $dir safetk.tcl]]
set auto_index(tkMessageBox) [list source [file join $dir msgbox.tcl]]
set auto_index(tkIconList) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkIconList_Config) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkIconList_Create) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkIconList_AutoScan) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkIconList_DeleteAll) [list source [file join $dir tkfbox.tcl]]







>
>







169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
set auto_index(tkFocusGroup_BindIn) [list source [file join $dir comdlg.tcl]]
set auto_index(tkFocusGroup_BindOut) [list source [file join $dir comdlg.tcl]]
set auto_index(tkFocusGroup_Destroy) [list source [file join $dir comdlg.tcl]]
set auto_index(tkFocusGroup_In) [list source [file join $dir comdlg.tcl]]
set auto_index(tkFocusGroup_Out) [list source [file join $dir comdlg.tcl]]
set auto_index(tkFDGetFileTypes) [list source [file join $dir comdlg.tcl]]
set auto_index(::safe::loadTk) [list source [file join $dir safetk.tcl]]
set auto_index(::safe::TkInit) [list source [file join $dir safetk.tcl]]
set auto_index(::safe::allowTk) [list source [file join $dir safetk.tcl]]
set auto_index(::safe::tkTopLevel) [list source [file join $dir safetk.tcl]]
set auto_index(tkMessageBox) [list source [file join $dir msgbox.tcl]]
set auto_index(tkIconList) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkIconList_Config) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkIconList_Create) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkIconList_AutoScan) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkIconList_DeleteAll) [list source [file join $dir tkfbox.tcl]]

Changes to library/tearoff.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# tearoff.tcl --
#
# This file contains procedures that implement tear-off menus.
#
# SCCS: @(#) tearoff.tcl 1.20 97/08/21 14:49:27
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#




|







1
2
3
4
5
6
7
8
9
10
11
12
# tearoff.tcl --
#
# This file contains procedures that implement tear-off menus.
#
# RCS: @(#) $Id: tearoff.tcl,v 1.1.4.3 1999/04/06 03:52:59 stanton Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
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
    	set x [winfo rootx $w]
    }
    if {$y == 0} {
    	set y [winfo rooty $w]
    }

    set parent [winfo parent $w]
    while {([winfo toplevel $parent] != $parent)
	    || ([winfo class $parent] == "Menu")} {
	set parent [winfo parent $parent]
    }
    if {$parent == "."} {
	set parent ""
    }
    for {set i 1} 1 {incr i} {
	set menu $parent.tearoff$i
	if ![winfo exists $menu] {
	    break
	}
    }

    $w clone $menu tearoff

    # Pick a title for the new menu by looking at the parent of the
    # original: if the parent is a menu, then use the text of the active
    # entry.  If it's a menubutton then use its text.

    set parent [winfo parent $w]
    if {[$menu cget -title] != ""} {
    	wm title $menu [$menu cget -title]
    } else {
    	switch [winfo class $parent] {
	    Menubutton {
	    	wm title $menu [$parent cget -text]
	    }
	    Menu {







|
|


|




|











|







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
    	set x [winfo rootx $w]
    }
    if {$y == 0} {
    	set y [winfo rooty $w]
    }

    set parent [winfo parent $w]
    while {[string compare [winfo toplevel $parent] $parent]
          || ![string compare [winfo class $parent] "Menu"]} {
	set parent [winfo parent $parent]
    }
    if {![string compare $parent "."]} {
	set parent ""
    }
    for {set i 1} 1 {incr i} {
	set menu $parent.tearoff$i
	if {![winfo exists $menu]} {
	    break
	}
    }

    $w clone $menu tearoff

    # Pick a title for the new menu by looking at the parent of the
    # original: if the parent is a menu, then use the text of the active
    # entry.  If it's a menubutton then use its text.

    set parent [winfo parent $w]
    if {[string compare [$menu cget -title] ""]} {
    	wm title $menu [$menu cget -title]
    } else {
    	switch [winfo class $parent] {
	    Menubutton {
	    	wm title $menu [$parent cget -text]
	    }
	    Menu {
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
	set tkPriv(focus) %W
    }

    # If there is a -tearoffcommand option for the menu, invoke it
    # now.

    set cmd [$w cget -tearoffcommand]
    if {$cmd != ""} {
	uplevel #0 $cmd $w $menu
    }
    return $menu
}

# tkMenuDup --
# Given a menu (hierarchy), create a duplicate menu (hierarchy)







|







88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
	set tkPriv(focus) %W
    }

    # If there is a -tearoffcommand option for the menu, invoke it
    # now.

    set cmd [$w cget -tearoffcommand]
    if {[string compare $cmd ""]} {
	uplevel #0 $cmd $w $menu
    }
    return $menu
}

# tkMenuDup --
# Given a menu (hierarchy), create a duplicate menu (hierarchy)
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
	if {[string compare [lindex $option 0] "-type"] == 0} {
	    continue
	}
	lappend cmd [lindex $option 0] [lindex $option 4]
    }
    eval $cmd
    set last [$src index last]
    if {$last == "none"} {
	return
    }
    for {set i [$src cget -tearoff]} {$i <= $last} {incr i} {
	set cmd [list $dst add [$src type $i]]
	foreach option [$src entryconfigure $i]  {
	    lappend cmd [lindex $option 0] [lindex $option 4]
	}
	eval $cmd
    }

    # Duplicate the binding tags and bindings from the source menu.



    regsub -all . $src {\\&} quotedSrc

    regsub -all . $dst {\\&} quotedDst





    regsub -all $quotedSrc [bindtags $src] $dst x
    bindtags $dst $x

    foreach event [bind $src] {

	regsub -all $quotedSrc [bind $src $event] $dst x











	bind $dst $event $x
    }
}







|












>
>
|
>
|
>
>
>
>
>
|

>

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



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
	if {[string compare [lindex $option 0] "-type"] == 0} {
	    continue
	}
	lappend cmd [lindex $option 0] [lindex $option 4]
    }
    eval $cmd
    set last [$src index last]
    if {![string compare $last "none"]} {
	return
    }
    for {set i [$src cget -tearoff]} {$i <= $last} {incr i} {
	set cmd [list $dst add [$src type $i]]
	foreach option [$src entryconfigure $i]  {
	    lappend cmd [lindex $option 0] [lindex $option 4]
	}
	eval $cmd
    }

    # Duplicate the binding tags and bindings from the source menu.

    set tags [bindtags $src]
    set srcLen [string length $src]
 
    # Copy tags to x, replacing each substring of src with dst.

    while {[set index [string first $src $tags]] != -1} {
      append x [string range $tags 0 [expr {$index - 1}]]$dst
      set tags [string range $tags [expr {$index + $srcLen}] end]
    }
    append x $tags

    bindtags $dst $x

    foreach event [bind $src] {
	unset x
	set script [bind $src $event]
	set eventLen [string length $event]

	# Copy script to x, replacing each substring of event with dst.

	while {[set index [string first $event $script]] != -1} {
          append x [string range $script 0 [expr {$index - 1}]]
	    append x $dst
          set script [string range $script [expr {$index + $eventLen}] end]
	}
	append x $script

	bind $dst $event $x
    }
}

Changes to library/text.tcl.

1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
# text.tcl --
#
# This file defines the default bindings for Tk text widgets and provides
# procedures that help in implementing the bindings.
#
# SCCS: @(#) text.tcl 1.58 97/09/17 18:54:56
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.

#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# Elements of tkPriv that are used in this file:





|



>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
# text.tcl --
#
# This file defines the default bindings for Tk text widgets and provides
# procedures that help in implementing the bindings.
#
# RCS: @(#) $Id: text.tcl,v 1.1.4.4 1999/04/06 03:53:00 stanton Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# Elements of tkPriv that are used in this file:
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
}
bind Text <ButtonRelease-1> {
    tkCancelRepeat
}
bind Text <Control-1> {
    %W mark set insert @%x,%y
}
bind Text <ButtonRelease-2> {
    if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
	tkTextPaste %W %x %y
    }
}
bind Text <Left> {
    tkTextSetCursor %W insert-1c
}
bind Text <Right> {
    tkTextSetCursor %W insert+1c
}
bind Text <Up> {







<
<
<
<
<







83
84
85
86
87
88
89





90
91
92
93
94
95
96
}
bind Text <ButtonRelease-1> {
    tkCancelRepeat
}
bind Text <Control-1> {
    %W mark set insert @%x,%y
}





bind Text <Left> {
    tkTextSetCursor %W insert-1c
}
bind Text <Right> {
    tkTextSetCursor %W insert+1c
}
bind Text <Up> {
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
bind Text <Control-i> {
    tkTextInsert %W \t
}
bind Text <Return> {
    tkTextInsert %W \n
}
bind Text <Delete> {
    if {[%W tag nextrange sel 1.0 end] != ""} {
	%W delete sel.first sel.last
    } else {
	%W delete insert
	%W see insert
    }
}
bind Text <BackSpace> {
    if {[%W tag nextrange sel 1.0 end] != ""} {
	%W delete sel.first sel.last
    } elseif [%W compare insert != 1.0] {
	%W delete insert-1c
	%W see insert
    }
}

bind Text <Control-space> {
    %W mark set anchor insert







|







|

|







198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
bind Text <Control-i> {
    tkTextInsert %W \t
}
bind Text <Return> {
    tkTextInsert %W \n
}
bind Text <Delete> {
    if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
	%W delete sel.first sel.last
    } else {
	%W delete insert
	%W see insert
    }
}
bind Text <BackSpace> {
    if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
	%W delete sel.first sel.last
    } elseif {[%W compare insert != 1.0]} {
	%W delete insert-1c
	%W see insert
    }
}

bind Text <Control-space> {
    %W mark set anchor insert
249
250
251
252
253
254
255





256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
    tk_textCopy %W
}
bind Text <<Paste>> {
    tk_textPaste %W
}
bind Text <<Clear>> {
    catch {%W delete sel.first sel.last}





}
bind Text <Insert> {
    catch {tkTextInsert %W [selection get -displayof %W]}
}
bind Text <KeyPress> {
    tkTextInsert %W %A
}

# Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
# Otherwise, if a widget binding for one of these is defined, the
# <KeyPress> class binding will also fire and insert the character,
# which is wrong.  Ditto for <Escape>.

bind Text <Alt-KeyPress> {# nothing }
bind Text <Meta-KeyPress> {# nothing}
bind Text <Control-KeyPress> {# nothing}
bind Text <Escape> {# nothing}
bind Text <KP_Enter> {# nothing}
if {$tcl_platform(platform) == "macintosh"} {
	bind Text <Command-KeyPress> {# nothing}
}

# Additional emacs-like bindings:

bind Text <Control-a> {
    if !$tk_strictMotif {
	tkTextSetCursor %W {insert linestart}
    }
}
bind Text <Control-b> {
    if !$tk_strictMotif {
	tkTextSetCursor %W insert-1c
    }
}
bind Text <Control-d> {
    if !$tk_strictMotif {
	%W delete insert
    }
}
bind Text <Control-e> {
    if !$tk_strictMotif {
	tkTextSetCursor %W {insert lineend}
    }
}
bind Text <Control-f> {
    if !$tk_strictMotif {
	tkTextSetCursor %W insert+1c
    }
}
bind Text <Control-k> {
    if !$tk_strictMotif {
	if [%W compare insert == {insert lineend}] {
	    %W delete insert
	} else {
	    %W delete insert {insert lineend}
	}
    }
}
bind Text <Control-n> {
    if !$tk_strictMotif {
	tkTextSetCursor %W [tkTextUpDownLine %W 1]
    }
}
bind Text <Control-o> {
    if !$tk_strictMotif {
	%W insert insert \n
	%W mark set insert insert-1c
    }
}
bind Text <Control-p> {
    if !$tk_strictMotif {
	tkTextSetCursor %W [tkTextUpDownLine %W -1]
    }
}
bind Text <Control-t> {
    if !$tk_strictMotif {
	tkTextTranspose %W
    }
}

if {$tcl_platform(platform) != "windows"} {
bind Text <Control-v> {
    if !$tk_strictMotif {
	tkTextScrollPages %W 1
    }
}
}

bind Text <Meta-b> {
    if !$tk_strictMotif {
	tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
    }
}
bind Text <Meta-d> {
    if !$tk_strictMotif {
	%W delete insert [tkTextNextWord %W insert]
    }
}
bind Text <Meta-f> {
    if !$tk_strictMotif {
	tkTextSetCursor %W [tkTextNextWord %W insert]
    }
}
bind Text <Meta-less> {
    if !$tk_strictMotif {
	tkTextSetCursor %W 1.0
    }
}
bind Text <Meta-greater> {
    if !$tk_strictMotif {
	tkTextSetCursor %W end-1c
    }
}
bind Text <Meta-BackSpace> {
    if !$tk_strictMotif {
	%W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert
    }
}
bind Text <Meta-Delete> {
    if !$tk_strictMotif {
	%W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert
    }
}

# Macintosh only bindings:

# if text black & highlight black -> text white, other text the same
if {$tcl_platform(platform) == "macintosh"} {
bind Text <FocusIn> {
    %W tag configure sel -borderwidth 0
    %W configure -selectbackground systemHighlight -selectforeground systemHighlightText
}
bind Text <FocusOut> {
    %W tag configure sel -borderwidth 1
    %W configure -selectbackground white -selectforeground black







>
>
>
>
>


















|






|




|




|




|




|




|
|







|




|





|




|




|

|






|




|




|




|




|




|




|







|







245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
    tk_textCopy %W
}
bind Text <<Paste>> {
    tk_textPaste %W
}
bind Text <<Clear>> {
    catch {%W delete sel.first sel.last}
}
bind Text <<PasteSelection>> {
    if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
	tkTextPaste %W %x %y
    }
}
bind Text <Insert> {
    catch {tkTextInsert %W [selection get -displayof %W]}
}
bind Text <KeyPress> {
    tkTextInsert %W %A
}

# Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
# Otherwise, if a widget binding for one of these is defined, the
# <KeyPress> class binding will also fire and insert the character,
# which is wrong.  Ditto for <Escape>.

bind Text <Alt-KeyPress> {# nothing }
bind Text <Meta-KeyPress> {# nothing}
bind Text <Control-KeyPress> {# nothing}
bind Text <Escape> {# nothing}
bind Text <KP_Enter> {# nothing}
if {![string compare $tcl_platform(platform) "macintosh"]} {
	bind Text <Command-KeyPress> {# nothing}
}

# Additional emacs-like bindings:

bind Text <Control-a> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W {insert linestart}
    }
}
bind Text <Control-b> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W insert-1c
    }
}
bind Text <Control-d> {
    if {!$tk_strictMotif} {
	%W delete insert
    }
}
bind Text <Control-e> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W {insert lineend}
    }
}
bind Text <Control-f> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W insert+1c
    }
}
bind Text <Control-k> {
    if {!$tk_strictMotif} {
	if {[%W compare insert == {insert lineend}]} {
	    %W delete insert
	} else {
	    %W delete insert {insert lineend}
	}
    }
}
bind Text <Control-n> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W [tkTextUpDownLine %W 1]
    }
}
bind Text <Control-o> {
    if {!$tk_strictMotif} {
	%W insert insert \n
	%W mark set insert insert-1c
    }
}
bind Text <Control-p> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W [tkTextUpDownLine %W -1]
    }
}
bind Text <Control-t> {
    if {!$tk_strictMotif} {
	tkTextTranspose %W
    }
}

if {[string compare $tcl_platform(platform) "windows"]} {
bind Text <Control-v> {
    if {!$tk_strictMotif} {
	tkTextScrollPages %W 1
    }
}
}

bind Text <Meta-b> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
    }
}
bind Text <Meta-d> {
    if {!$tk_strictMotif} {
	%W delete insert [tkTextNextWord %W insert]
    }
}
bind Text <Meta-f> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W [tkTextNextWord %W insert]
    }
}
bind Text <Meta-less> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W 1.0
    }
}
bind Text <Meta-greater> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W end-1c
    }
}
bind Text <Meta-BackSpace> {
    if {!$tk_strictMotif} {
	%W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert
    }
}
bind Text <Meta-Delete> {
    if {!$tk_strictMotif} {
	%W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert
    }
}

# Macintosh only bindings:

# if text black & highlight black -> text white, other text the same
if {![string compare $tcl_platform(platform) "macintosh"]} {
bind Text <FocusIn> {
    %W tag configure sel -borderwidth 0
    %W configure -selectbackground systemHighlight -selectforeground systemHighlightText
}
bind Text <FocusOut> {
    %W tag configure sel -borderwidth 1
    %W configure -selectbackground white -selectforeground black
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

# End of Mac only bindings
}

# A few additional bindings of my own.

bind Text <Control-h> {
    if !$tk_strictMotif {
	if [%W compare insert != 1.0] {
	    %W delete insert-1c
	    %W see insert
	}
    }
}
bind Text <2> {
    if !$tk_strictMotif {
	%W scan mark %x %y
	set tkPriv(x) %x
	set tkPriv(y) %y
	set tkPriv(mouseMoved) 0
    }
}
bind Text <B2-Motion> {
    if !$tk_strictMotif {
	if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} {
	    set tkPriv(mouseMoved) 1
	}
	if $tkPriv(mouseMoved) {
	    %W scan dragto %x %y
	}
    }
}
set tkPriv(prevPos) {}









# tkTextClosestGap --
# Given x and y coordinates, this procedure finds the closest boundary
# between characters to the given coordinates and returns the index
# of the character just after the boundary.
#
# Arguments:
# w -		The text window.
# x -		X-coordinate within the window.
# y -		Y-coordinate within the window.

proc tkTextClosestGap {w x y} {
    set pos [$w index @$x,$y]
    set bbox [$w bbox $pos]
    if ![string compare $bbox ""] {
	return $pos
    }
    if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
	return $pos
    }
    $w index "$pos + 1 char"
}







|
|






|







|



|





>
>
>
>
>
>
>
>














|







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

# End of Mac only bindings
}

# A few additional bindings of my own.

bind Text <Control-h> {
    if {!$tk_strictMotif} {
	if {[%W compare insert != 1.0]} {
	    %W delete insert-1c
	    %W see insert
	}
    }
}
bind Text <2> {
    if {!$tk_strictMotif} {
	%W scan mark %x %y
	set tkPriv(x) %x
	set tkPriv(y) %y
	set tkPriv(mouseMoved) 0
    }
}
bind Text <B2-Motion> {
    if {!$tk_strictMotif} {
	if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} {
	    set tkPriv(mouseMoved) 1
	}
	if {$tkPriv(mouseMoved)} {
	    %W scan dragto %x %y
	}
    }
}
set tkPriv(prevPos) {}

# The MouseWheel will typically only fire on Windows.  However,
# someone could use the "event generate" command to produce one
# on other platforms.

bind Text <MouseWheel> {
    %W yview scroll [expr {- (%D / 120) * 4}] units
}

# tkTextClosestGap --
# Given x and y coordinates, this procedure finds the closest boundary
# between characters to the given coordinates and returns the index
# of the character just after the boundary.
#
# Arguments:
# w -		The text window.
# x -		X-coordinate within the window.
# y -		Y-coordinate within the window.

proc tkTextClosestGap {w x y} {
    set pos [$w index @$x,$y]
    set bbox [$w bbox $pos]
    if {![string compare $bbox ""]} {
	return $pos
    }
    if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
	return $pos
    }
    $w index "$pos + 1 char"
}
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545

546
547
548
549
550
551
552
553
    global tkPriv

    set tkPriv(selectMode) char
    set tkPriv(mouseMoved) 0
    set tkPriv(pressX) $x
    $w mark set insert [tkTextClosestGap $w $x $y]
    $w mark set anchor insert
    if {[$w cget -state] == "normal"} {focus $w}
}

# tkTextSelectTo --
# This procedure is invoked to extend the selection, typically when
# dragging it with the mouse.  Depending on the selection mode (character,
# word, line) it selects in different-sized units.  This procedure
# ignores mouse motions initially until the mouse has moved from
# one character to another or until there have been multiple clicks.
#
# Arguments:
# w -		The text window in which the button was pressed.
# x -		Mouse x position.
# y - 		Mouse y position.

proc tkTextSelectTo {w x y} {
    global tkPriv tcl_platform

    set cur [tkTextClosestGap $w $x $y]
    if [catch {$w index anchor}] {
	$w mark set anchor $cur
    }
    set anchor [$w index anchor]
    if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} {
	set tkPriv(mouseMoved) 1
    }
    switch $tkPriv(selectMode) {
	char {
	    if [$w compare $cur < anchor] {
		set first $cur
		set last anchor
	    } else {
		set first anchor
		set last $cur
	    }
	}
	word {
	    if [$w compare $cur < anchor] {
		set first [tkTextPrevPos $w "$cur + 1c" tcl_wordBreakBefore]
		set last [tkTextNextPos $w "anchor" tcl_wordBreakAfter]
	    } else {
		set first [tkTextPrevPos $w anchor tcl_wordBreakBefore]
		set last [tkTextNextPos $w "$cur - 1c" tcl_wordBreakAfter]
	    }
	}
	line {
	    if [$w compare $cur < anchor] {
		set first [$w index "$cur linestart"]
		set last [$w index "anchor - 1c lineend + 1c"]
	    } else {
		set first [$w index "anchor linestart"]
		set last [$w index "$cur lineend + 1c"]
	    }
	}
    }
    if {$tkPriv(mouseMoved) || ($tkPriv(selectMode) != "char")} {

	if {$tcl_platform(platform) != "unix" && [$w compare $cur < anchor]} {
	    $w mark set insert $first
	} else {
	    $w mark set insert $last
	}
	$w tag remove sel 0.0 $first
	$w tag add sel $first $last
	$w tag remove sel $last end







|


















|








|








|








|








|
>
|







492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
    global tkPriv

    set tkPriv(selectMode) char
    set tkPriv(mouseMoved) 0
    set tkPriv(pressX) $x
    $w mark set insert [tkTextClosestGap $w $x $y]
    $w mark set anchor insert
    if {![string compare [$w cget -state] "normal"]} {focus $w}
}

# tkTextSelectTo --
# This procedure is invoked to extend the selection, typically when
# dragging it with the mouse.  Depending on the selection mode (character,
# word, line) it selects in different-sized units.  This procedure
# ignores mouse motions initially until the mouse has moved from
# one character to another or until there have been multiple clicks.
#
# Arguments:
# w -		The text window in which the button was pressed.
# x -		Mouse x position.
# y - 		Mouse y position.

proc tkTextSelectTo {w x y} {
    global tkPriv tcl_platform

    set cur [tkTextClosestGap $w $x $y]
    if {[catch {$w index anchor}]} {
	$w mark set anchor $cur
    }
    set anchor [$w index anchor]
    if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} {
	set tkPriv(mouseMoved) 1
    }
    switch $tkPriv(selectMode) {
	char {
	    if {[$w compare $cur < anchor]} {
		set first $cur
		set last anchor
	    } else {
		set first anchor
		set last $cur
	    }
	}
	word {
	    if {[$w compare $cur < anchor]} {
		set first [tkTextPrevPos $w "$cur + 1c" tcl_wordBreakBefore]
		set last [tkTextNextPos $w "anchor" tcl_wordBreakAfter]
	    } else {
		set first [tkTextPrevPos $w anchor tcl_wordBreakBefore]
		set last [tkTextNextPos $w "$cur - 1c" tcl_wordBreakAfter]
	    }
	}
	line {
	    if {[$w compare $cur < anchor]} {
		set first [$w index "$cur linestart"]
		set last [$w index "anchor - 1c lineend + 1c"]
	    } else {
		set first [$w index "anchor linestart"]
		set last [$w index "$cur lineend + 1c"]
	    }
	}
    }
    if {$tkPriv(mouseMoved) || [string compare $tkPriv(selectMode) "char"]} {
      if {[string compare $tcl_platform(platform) "unix"]
              && [$w compare $cur < anchor]} {
	    $w mark set insert $first
	} else {
	    $w mark set insert $last
	}
	$w tag remove sel 0.0 $first
	$w tag add sel $first $last
	$w tag remove sel $last end
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
# w -		The text window.
# index -	The point to which the selection is to be extended.

proc tkTextKeyExtend {w index} {
    global tkPriv

    set cur [$w index $index]
    if [catch {$w index anchor}] {
	$w mark set anchor $cur
    }
    set anchor [$w index anchor]
    if [$w compare $cur < anchor] {
	set first $cur
	set last anchor
    } else {
	set first anchor
	set last $cur
    }
    $w tag remove sel 0.0 $first







|



|







574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
# w -		The text window.
# index -	The point to which the selection is to be extended.

proc tkTextKeyExtend {w index} {
    global tkPriv

    set cur [$w index $index]
    if {[catch {$w index anchor}]} {
	$w mark set anchor $cur
    }
    set anchor [$w index anchor]
    if {[$w compare $cur < anchor]} {
	set first $cur
	set last anchor
    } else {
	set first anchor
	set last $cur
    }
    $w tag remove sel 0.0 $first
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
# Arguments:
# w -		The text window.
# x, y - 	Position of the mouse.

proc tkTextPaste {w x y} {
    $w mark set insert [tkTextClosestGap $w $x $y]
    catch {$w insert insert [selection get -displayof $w]}
    if {[$w cget -state] == "normal"} {focus $w}
}

# tkTextAutoScan --
# This procedure is invoked when the mouse leaves a text window
# with button 1 down.  It scrolls the window up, down, left, or right,
# depending on where the mouse is (this information was saved in
# tkPriv(x) and tkPriv(y)), and reschedules itself as an "after"







|







601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
# Arguments:
# w -		The text window.
# x, y - 	Position of the mouse.

proc tkTextPaste {w x y} {
    $w mark set insert [tkTextClosestGap $w $x $y]
    catch {$w insert insert [selection get -displayof $w]}
    if {![string compare [$w cget -state] "normal"]} {focus $w}
}

# tkTextAutoScan --
# This procedure is invoked when the mouse leaves a text window
# with button 1 down.  It scrolls the window up, down, left, or right,
# depending on where the mouse is (this information was saved in
# tkPriv(x) and tkPriv(y)), and reschedules itself as an "after"
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
# Arguments:
# w -		The text window.
# pos -		The desired new position for the cursor in the window.

proc tkTextSetCursor {w pos} {
    global tkPriv

    if [$w compare $pos == end] {
	set pos {end - 1 chars}
    }
    $w mark set insert $pos
    $w tag remove sel 1.0 end
    $w see insert
}

# tkTextKeySelect
# This procedure is invoked when stroking out selections using the
# keyboard.  It moves the cursor to a new position, then extends
# the selection to that position.
#
# Arguments:
# w -		The text window.
# new -		A new position for the insertion cursor (the cursor hasn't
#		actually been moved to this position yet).

proc tkTextKeySelect {w new} {
    global tkPriv

    if {[$w tag nextrange sel 1.0 end] == ""} {
	if [$w compare $new < insert] {
	    $w tag add sel $new insert
	} else {
	    $w tag add sel insert $new
	}
	$w mark set anchor insert
    } else {
	if [$w compare $new < anchor] {
	    set first $new
	    set last anchor
	} else {
	    set first anchor
	    set last $new
	}
	$w tag remove sel 1.0 $first







|




















|
|






|







646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
# Arguments:
# w -		The text window.
# pos -		The desired new position for the cursor in the window.

proc tkTextSetCursor {w pos} {
    global tkPriv

    if {[$w compare $pos == end]} {
	set pos {end - 1 chars}
    }
    $w mark set insert $pos
    $w tag remove sel 1.0 end
    $w see insert
}

# tkTextKeySelect
# This procedure is invoked when stroking out selections using the
# keyboard.  It moves the cursor to a new position, then extends
# the selection to that position.
#
# Arguments:
# w -		The text window.
# new -		A new position for the insertion cursor (the cursor hasn't
#		actually been moved to this position yet).

proc tkTextKeySelect {w new} {
    global tkPriv

    if {![string compare [$w tag nextrange sel 1.0 end] ""]} {
	if {[$w compare $new < insert]} {
	    $w tag add sel $new insert
	} else {
	    $w tag add sel insert $new
	}
	$w mark set anchor insert
    } else {
	if {[$w compare $new < anchor]} {
	    set first $new
	    set last anchor
	} else {
	    set first anchor
	    set last $new
	}
	$w tag remove sel 1.0 $first
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
# w -		The text widget.
# index -	Position at which mouse button was pressed, which determines
#		which end of selection should be used as anchor point.

proc tkTextResetAnchor {w index} {
    global tkPriv

    if {[$w tag ranges sel] == ""} {
	$w mark set anchor $index
	return
    }
    set a [$w index $index]
    set b [$w index sel.first]
    set c [$w index sel.last]
    if [$w compare $a < $b] {
	$w mark set anchor sel.last
	return
    }
    if [$w compare $a > $c] {
	$w mark set anchor sel.first
	return
    }
    scan $a "%d.%d" lineA chA
    scan $b "%d.%d" lineB chB
    scan $c "%d.%d" lineC chC
    if {$lineB < $lineC+2} {







|






|



|







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
# w -		The text widget.
# index -	Position at which mouse button was pressed, which determines
#		which end of selection should be used as anchor point.

proc tkTextResetAnchor {w index} {
    global tkPriv

    if {![string compare [$w tag ranges sel] ""]} {
	$w mark set anchor $index
	return
    }
    set a [$w index $index]
    set b [$w index sel.first]
    set c [$w index sel.last]
    if {[$w compare $a < $b]} {
	$w mark set anchor sel.last
	return
    }
    if {[$w compare $a > $c]} {
	$w mark set anchor sel.first
	return
    }
    scan $a "%d.%d" lineA chA
    scan $b "%d.%d" lineB chB
    scan $c "%d.%d" lineC chC
    if {$lineB < $lineC+2} {
745
746
747
748
749
750
751

752
753
754
755
756
757
758
759
# insertion cursor, then delete the selection before inserting.
#
# Arguments:
# w -		The text window in which to insert the string
# s -		The string to insert (usually just a single character)

proc tkTextInsert {w s} {

    if {($s == "") || ([$w cget -state] == "disabled")} {
	return
    }
    catch {
	if {[$w compare sel.first <= insert]
		&& [$w compare sel.last >= insert]} {
	    $w delete sel.first sel.last
	}







>
|







755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
# insertion cursor, then delete the selection before inserting.
#
# Arguments:
# w -		The text window in which to insert the string
# s -		The string to insert (usually just a single character)

proc tkTextInsert {w s} {
    if {![string compare $s ""] ||
          ![string compare [$w cget -state] "disabled"]} {
	return
    }
    catch {
	if {[$w compare sel.first <= insert]
		&& [$w compare sel.last >= insert]} {
	    $w delete sel.first sel.last
	}
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806

807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
    global tkPriv

    set i [$w index insert]
    scan $i "%d.%d" line char
    if {[string compare $tkPriv(prevPos) $i] != 0} {
	set tkPriv(char) $char
    }
    set new [$w index [expr $line + $n].$tkPriv(char)]
    if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
	set new $i
    }
    set tkPriv(prevPos) $new
    return $new
}

# tkTextPrevPara --
# Returns the index of the beginning of the paragraph just before a given
# position in the text (the beginning of a paragraph is the first non-blank
# character after a blank line).
#
# Arguments:
# w -		The text window in which the cursor is to move.
# pos -		Position at which to start search.

proc tkTextPrevPara {w pos} {
    set pos [$w index "$pos linestart"]
    while 1 {
	if {(([$w get "$pos - 1 line"] == "\n") && ([$w get $pos] != "\n"))

		|| ($pos == "1.0")} {
	    if [regexp -indices {^[ 	]+(.)} [$w get $pos "$pos lineend"] \
		    dummy index] {
		set pos [$w index "$pos + [lindex $index 0] chars"]
	    }
	    if {[$w compare $pos != insert] || ($pos == "1.0")} {
		return $pos
	    }
	}
	set pos [$w index "$pos - 1 line"]
    }
}

# tkTextNextPara --
# Returns the index of the beginning of the paragraph just after a given
# position in the text (the beginning of a paragraph is the first non-blank
# character after a blank line).
#
# Arguments:
# w -		The text window in which the cursor is to move.
# start -	Position at which to start search.

proc tkTextNextPara {w start} {
    set pos [$w index "$start linestart + 1 line"]
    while {[$w get $pos] != "\n"} {
	if [$w compare $pos == end] {
	    return [$w index "end - 1c"]
	}
	set pos [$w index "$pos + 1 line"]
    }
    while {[$w get $pos] == "\n"} {
	set pos [$w index "$pos + 1 line"]
	if [$w compare $pos == end] {
	    return [$w index "end - 1c"]
	}
    }
    if [regexp -indices {^[ 	]+(.)} [$w get $pos "$pos lineend"] \
	    dummy index] {
	return [$w index "$pos + [lindex $index 0] chars"]
    }
    return $pos
}

# tkTextScrollPages --
# This is a utility procedure used in bindings for moving up and down
# pages and possibly extending the selection along the way.  It scrolls
# the view in the widget by the number of pages, and it returns the
# index of the character that is at the same position in the new view
# as the insertion cursor used to be in the old view.
#
# Arguments:
# w -		The text window in which the cursor is to move.
# count -	Number of pages forward to scroll;  may be negative
#		to scroll backwards.

proc tkTextScrollPages {w count} {
    set bbox [$w bbox insert]
    $w yview scroll $count pages
    if {$bbox == ""} {
	return [$w index @[expr [winfo height $w]/2],0]
    }
    return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
}

# tkTextTranspose --
# This procedure implements the "transpose" function for text widgets.
# It tranposes the characters on either side of the insertion cursor,
# unless the cursor is at the end of the line.  In this case it
# transposes the two characters to the left of the cursor.  In either
# case, the cursor ends up to the right of the transposed characters.
#
# Arguments:
# w -		Text window in which to transpose.

proc tkTextTranspose w {
    set pos insert
    if [$w compare $pos != "$pos lineend"] {
	set pos [$w index "$pos + 1 char"]
    }
    set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
    if [$w compare "$pos - 1 char" == 1.0] {
	return
    }
    $w delete "$pos - 2 char" $pos
    $w insert insert $new
    $w see insert
}








|



















|
>
|
|
|


|


















|
|




|

|



|
|




















|
|
















|



|







790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
    global tkPriv

    set i [$w index insert]
    scan $i "%d.%d" line char
    if {[string compare $tkPriv(prevPos) $i] != 0} {
	set tkPriv(char) $char
    }
    set new [$w index [expr {$line + $n}].$tkPriv(char)]
    if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
	set new $i
    }
    set tkPriv(prevPos) $new
    return $new
}

# tkTextPrevPara --
# Returns the index of the beginning of the paragraph just before a given
# position in the text (the beginning of a paragraph is the first non-blank
# character after a blank line).
#
# Arguments:
# w -		The text window in which the cursor is to move.
# pos -		Position at which to start search.

proc tkTextPrevPara {w pos} {
    set pos [$w index "$pos linestart"]
    while 1 {
      if {(![string compare [$w get "$pos - 1 line"] "\n"]
              && [string compare [$w get $pos] "\n"])
              || ![string compare $pos "1.0"]} {
	    if {[regexp -indices {^[ 	]+(.)} [$w get $pos "$pos lineend"] \
		    dummy index]} {
		set pos [$w index "$pos + [lindex $index 0] chars"]
	    }
          if {[$w compare $pos != insert] || ![string compare $pos 1.0]} {
		return $pos
	    }
	}
	set pos [$w index "$pos - 1 line"]
    }
}

# tkTextNextPara --
# Returns the index of the beginning of the paragraph just after a given
# position in the text (the beginning of a paragraph is the first non-blank
# character after a blank line).
#
# Arguments:
# w -		The text window in which the cursor is to move.
# start -	Position at which to start search.

proc tkTextNextPara {w start} {
    set pos [$w index "$start linestart + 1 line"]
    while {[string compare [$w get $pos] "\n"]} {
	if {[$w compare $pos == end]} {
	    return [$w index "end - 1c"]
	}
	set pos [$w index "$pos + 1 line"]
    }
    while {![string compare [$w get $pos] "\n"]} {
	set pos [$w index "$pos + 1 line"]
	if {[$w compare $pos == end]} {
	    return [$w index "end - 1c"]
	}
    }
    if {[regexp -indices {^[ 	]+(.)} [$w get $pos "$pos lineend"] \
	    dummy index]} {
	return [$w index "$pos + [lindex $index 0] chars"]
    }
    return $pos
}

# tkTextScrollPages --
# This is a utility procedure used in bindings for moving up and down
# pages and possibly extending the selection along the way.  It scrolls
# the view in the widget by the number of pages, and it returns the
# index of the character that is at the same position in the new view
# as the insertion cursor used to be in the old view.
#
# Arguments:
# w -		The text window in which the cursor is to move.
# count -	Number of pages forward to scroll;  may be negative
#		to scroll backwards.

proc tkTextScrollPages {w count} {
    set bbox [$w bbox insert]
    $w yview scroll $count pages
    if {![string compare $bbox ""]} {
	return [$w index @[expr {[winfo height $w]/2}],0]
    }
    return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
}

# tkTextTranspose --
# This procedure implements the "transpose" function for text widgets.
# It tranposes the characters on either side of the insertion cursor,
# unless the cursor is at the end of the line.  In this case it
# transposes the two characters to the left of the cursor.  In either
# case, the cursor ends up to the right of the transposed characters.
#
# Arguments:
# w -		Text window in which to transpose.

proc tkTextTranspose w {
    set pos insert
    if {[$w compare $pos != "$pos lineend"]} {
	set pos [$w index "$pos + 1 char"]
    }
    set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
    if {[$w compare "$pos - 1 char" == 1.0]} {
	return
    }
    $w delete "$pos - 2 char" $pos
    $w insert insert $new
    $w see insert
}

928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
#
# Arguments:
# w -		Name of a text widget.

proc tk_textPaste w {
    global tcl_platform
    catch {
	if {"$tcl_platform(platform)" != "unix"} {
	    catch {
		$w delete sel.first sel.last
	    }
	}
	$w insert insert [selection get -displayof $w -selection CLIPBOARD]
    }
}

# tkTextNextWord --
# Returns the index of the next word position after a given position in the
# text.  The next word is platform dependent and may be either the next
# end-of-word position or the next start-of-word position after the next
# end-of-word position.
#
# Arguments:
# w -		The text window in which the cursor is to move.
# start -	Position at which to start search.

if {$tcl_platform(platform) == "windows"}  {
    proc tkTextNextWord {w start} {
	tkTextNextPos $w [tkTextNextPos $w $start tcl_endOfWord] \
	    tcl_startOfNextWord
    }
} else {
    proc tkTextNextWord {w start} {
	tkTextNextPos $w $start tcl_endOfWord







|


















|







940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
#
# Arguments:
# w -		Name of a text widget.

proc tk_textPaste w {
    global tcl_platform
    catch {
      if {[string compare $tcl_platform(platform) "unix"]} {
	    catch {
		$w delete sel.first sel.last
	    }
	}
	$w insert insert [selection get -displayof $w -selection CLIPBOARD]
    }
}

# tkTextNextWord --
# Returns the index of the next word position after a given position in the
# text.  The next word is platform dependent and may be either the next
# end-of-word position or the next start-of-word position after the next
# end-of-word position.
#
# Arguments:
# w -		The text window in which the cursor is to move.
# start -	Position at which to start search.

if {![string compare $tcl_platform(platform) "windows"]}  {
    proc tkTextNextWord {w start} {
	tkTextNextPos $w [tkTextNextPos $w $start tcl_endOfWord] \
	    tcl_startOfNextWord
    }
} else {
    proc tkTextNextWord {w start} {
	tkTextNextPos $w $start tcl_endOfWord

Changes to library/tk.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
# tk.tcl --
#
# Initialization script normally executed in the interpreter for each
# Tk-based application.  Arranges class bindings for widgets.
#
# SCCS: @(#) tk.tcl 1.98 97/10/28 15:21:04
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.

#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Insist on running with compatible versions of Tcl and Tk.

package require -exact Tk 8.0
package require -exact Tcl 8.0

# Add Tk's directory to the end of the auto-load search path, if it
# isn't already on the path:

if {[info exists auto_path]} {
    if {[lsearch -exact $auto_path $tk_library] < 0} {
	lappend auto_path $tk_library





|



>






|
|







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
# tk.tcl --
#
# Initialization script normally executed in the interpreter for each
# Tk-based application.  Arranges class bindings for widgets.
#
# RCS: @(#) $Id: tk.tcl,v 1.1.4.5 1999/04/06 03:53:00 stanton Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Insist on running with compatible versions of Tcl and Tk.

package require -exact Tk 8.1
package require -exact Tcl 8.1

# Add Tk's directory to the end of the auto-load search path, if it
# isn't already on the path:

if {[info exists auto_path]} {
    if {[lsearch -exact $auto_path $tk_library] < 0} {
	lappend auto_path $tk_library
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
#
# Arguments:
# screen -		The name of the new screen.

proc tkScreenChanged screen {
    set x [string last . $screen]
    if {$x > 0} {
	set disp [string range $screen 0 [expr $x - 1]]
    } else {
	set disp $screen
    }

    uplevel #0 upvar #0 tkPriv.$disp tkPriv
    global tkPriv
    global tcl_platform

    if [info exists tkPriv] {
	set tkPriv(screen) $screen
	return
    }
    set tkPriv(activeMenu) {}

    set tkPriv(activeItem) {}
    set tkPriv(afterId) {}
    set tkPriv(buttons) 0
    set tkPriv(buttonWindow) {}
    set tkPriv(dragging) 0
    set tkPriv(focus) {}
    set tkPriv(grab) {}
    set tkPriv(initPos) {}
    set tkPriv(inMenubutton) {}
    set tkPriv(listboxPrev) {}
    set tkPriv(menuBar) {}
    set tkPriv(mouseMoved) 0
    set tkPriv(oldGrab) {}
    set tkPriv(popup) {}
    set tkPriv(postedMb) {}
    set tkPriv(pressX) 0
    set tkPriv(pressY) 0
    set tkPriv(prevPos) 0


    set tkPriv(screen) $screen
    set tkPriv(selectMode) char
    if {[string compare $tcl_platform(platform) "unix"] == 0} {
	set tkPriv(tearoff) 1
    } else {
	set tkPriv(tearoff) 0
    }
    set tkPriv(window) {}
}







|








|



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

<







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
#
# Arguments:
# screen -		The name of the new screen.

proc tkScreenChanged screen {
    set x [string last . $screen]
    if {$x > 0} {
	set disp [string range $screen 0 [expr {$x - 1}]]
    } else {
	set disp $screen
    }

    uplevel #0 upvar #0 tkPriv.$disp tkPriv
    global tkPriv
    global tcl_platform

    if {[info exists tkPriv]} {
	set tkPriv(screen) $screen
	return
    }
    array set tkPriv {
      activeMenu      {}
      activeItem      {}
      afterId         {}
      buttons         0
      buttonWindow    {}
      dragging        0
      focus           {}
      grab            {}
      initPos         {}
      inMenubutton    {}
      listboxPrev     {}
      menuBar         {}
      mouseMoved      0
      oldGrab         {}
      popup           {}
      postedMb        {}
      pressX          0
      pressY          0
      prevPos         0
      selectMode      char
    }
    set tkPriv(screen) $screen

    if {[string compare $tcl_platform(platform) "unix"] == 0} {
	set tkPriv(tearoff) 1
    } else {
	set tkPriv(tearoff) 0
    }
    set tkPriv(window) {}
}
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
#
# Arguments:
# n1 - the name of the variable being changed ("tk_strictMotif").

proc tkEventMotifBindings {n1 dummy dummy} {
    upvar $n1 name
    
    if $name {
	set op delete
    } else {
	set op add
    }

    event $op <<Cut>> <Control-Key-w>
    event $op <<Copy>> <Meta-Key-w> 
    event $op <<Paste>> <Control-Key-y>
}



































#----------------------------------------------------------------------
# Define the set of common virtual events.
#----------------------------------------------------------------------

switch $tcl_platform(platform) {
    "unix" {
	event add <<Cut>> <Control-Key-x> <Key-F20> 
	event add <<Copy>> <Control-Key-c> <Key-F16>
	event add <<Paste>> <Control-Key-v> <Key-F18>

	trace variable tk_strictMotif w tkEventMotifBindings
	set tk_strictMotif $tk_strictMotif
    }
    "windows" {
	event add <<Cut>> <Control-Key-x> <Shift-Key-Delete>
	event add <<Copy>> <Control-Key-c> <Control-Key-Insert>
	event add <<Paste>> <Control-Key-v> <Shift-Key-Insert>

    }
    "macintosh" {
	event add <<Cut>> <Control-Key-x> <Key-F2> 
	event add <<Copy>> <Control-Key-c> <Key-F3>
	event add <<Paste>> <Control-Key-v> <Key-F4>

	event add <<Clear>> <Clear>
    }
}

# ----------------------------------------------------------------------
# Read in files that define all of the class bindings.
# ----------------------------------------------------------------------

if {$tcl_platform(platform) != "macintosh"} {
    source $tk_library/button.tcl
    source $tk_library/entry.tcl
    source $tk_library/listbox.tcl
    source $tk_library/menu.tcl
    source $tk_library/scale.tcl
    source $tk_library/scrlbar.tcl
    source $tk_library/text.tcl
}

# ----------------------------------------------------------------------
# Default bindings for keyboard traversal.
# ----------------------------------------------------------------------

bind all <Tab> {tkTabToWindow [tk_focusNext %W]}







|










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









>







>





>








|
|
|
|
|
|
|
|







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
#
# Arguments:
# n1 - the name of the variable being changed ("tk_strictMotif").

proc tkEventMotifBindings {n1 dummy dummy} {
    upvar $n1 name
    
    if {$name} {
	set op delete
    } else {
	set op add
    }

    event $op <<Cut>> <Control-Key-w>
    event $op <<Copy>> <Meta-Key-w> 
    event $op <<Paste>> <Control-Key-y>
}

#----------------------------------------------------------------------
# Define common dialogs on platforms where they are not implemented 
# using compiled code.
#----------------------------------------------------------------------

if {![string compare [info commands tk_chooseColor] ""]} {
    proc tk_chooseColor {args} {
	return [eval tkColorDialog $args]
    }
}
if {![string compare [info commands tk_getOpenFile] ""]} {
    proc tk_getOpenFile {args} {
	if {$::tk_strictMotif} {
	    return [eval tkMotifFDialog open $args]
	} else {
	    return [eval tkFDialog open $args]
	}
    }
}
if {![string compare [info commands tk_getSaveFile] ""]} {
    proc tk_getSaveFile {args} {
	if {$::tk_strictMotif} {
	    return [eval tkMotifFDialog save $args]
	} else {
	    return [eval tkFDialog save $args]
	}
    }
}
if {![string compare [info commands tk_messageBox] ""]} {
    proc tk_messageBox {args} {
	return [eval tkMessageBox $args]
    }
}
	
#----------------------------------------------------------------------
# Define the set of common virtual events.
#----------------------------------------------------------------------

switch $tcl_platform(platform) {
    "unix" {
	event add <<Cut>> <Control-Key-x> <Key-F20> 
	event add <<Copy>> <Control-Key-c> <Key-F16>
	event add <<Paste>> <Control-Key-v> <Key-F18>
	event add <<PasteSelection>> <ButtonRelease-2>
	trace variable tk_strictMotif w tkEventMotifBindings
	set tk_strictMotif $tk_strictMotif
    }
    "windows" {
	event add <<Cut>> <Control-Key-x> <Shift-Key-Delete>
	event add <<Copy>> <Control-Key-c> <Control-Key-Insert>
	event add <<Paste>> <Control-Key-v> <Shift-Key-Insert>
	event add <<PasteSelection>> <ButtonRelease-2>
    }
    "macintosh" {
	event add <<Cut>> <Control-Key-x> <Key-F2> 
	event add <<Copy>> <Control-Key-c> <Key-F3>
	event add <<Paste>> <Control-Key-v> <Key-F4>
	event add <<PasteSelection>> <ButtonRelease-2>
	event add <<Clear>> <Clear>
    }
}

# ----------------------------------------------------------------------
# Read in files that define all of the class bindings.
# ----------------------------------------------------------------------

if {[string compare $tcl_platform(platform) "macintosh"]} {
    source [file join $tk_library button.tcl]
    source [file join $tk_library entry.tcl]
    source [file join $tk_library listbox.tcl]
    source [file join $tk_library menu.tcl]
    source [file join $tk_library scale.tcl]
    source [file join $tk_library scrlbar.tcl]
    source [file join $tk_library text.tcl]
}

# ----------------------------------------------------------------------
# Default bindings for keyboard traversal.
# ----------------------------------------------------------------------

bind all <Tab> {tkTabToWindow [tk_focusNext %W]}
177
178
179
180
181
182
183
184
185
186
187
188
189
# This procedure moves the focus to the given widget.  If the widget
# is an entry, it selects the entire contents of the widget.
#
# Arguments:
# w - Window to which focus should be set.

proc tkTabToWindow {w} {
    if {"[winfo class $w]" == "Entry"} {
	$w select range 0 end
	$w icur end
    }
    focus $w
}







|





217
218
219
220
221
222
223
224
225
226
227
228
229
# This procedure moves the focus to the given widget.  If the widget
# is an entry, it selects the entire contents of the widget.
#
# Arguments:
# w - Window to which focus should be set.

proc tkTabToWindow {w} {
    if {![string compare [winfo class $w] Entry]} {
	$w select range 0 end
	$w icur end
    }
    focus $w
}

Changes to library/tkfbox.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
# tkfbox.tcl --
#
#	Implements the "TK" standard file selection dialog box. This
#	dialog box is used on the Unix platforms whenever the tk_strictMotif
#	flag is not set.
#
#	The "TK" standard file selection dialog box is similar to the
#	file selection dialog box on Win95(TM). The user can navigate
#	the directories by clicking on the folder icons or by
#	selectinf the "Directory" option menu. The user can select
#	files by clicking on the file icons or by entering a filename
#	in the "Filename:" entry.
#
# SCCS: @(#) tkfbox.tcl 1.13 97/10/01 14:51:01
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#----------------------------------------------------------------------
#













|

|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
# tkfbox.tcl --
#
#	Implements the "TK" standard file selection dialog box. This
#	dialog box is used on the Unix platforms whenever the tk_strictMotif
#	flag is not set.
#
#	The "TK" standard file selection dialog box is similar to the
#	file selection dialog box on Win95(TM). The user can navigate
#	the directories by clicking on the folder icons or by
#	selectinf the "Directory" option menu. The user can select
#	files by clicking on the file icons or by entering a filename
#	in the "Filename:" entry.
#
# RCS: @(#) $Id: tkfbox.tcl,v 1.1.4.4 1999/04/06 03:17:12 stanton Exp $
#
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#----------------------------------------------------------------------
#
91
92
93
94
95
96
97
98
99
100
101


102
103
104
105
106
107
108

    # Creates the event bindings.
    #
    bind $data(canvas) <Configure> "tkIconList_Arrange $w"

    bind $data(canvas) <1>         "tkIconList_Btn1 $w %x %y"
    bind $data(canvas) <B1-Motion> "tkIconList_Motion1 $w %x %y"
    bind $data(canvas) <Double-1>  "tkIconList_Double1 $w %x %y"
    bind $data(canvas) <ButtonRelease-1> "tkCancelRepeat"
    bind $data(canvas) <B1-Leave>  "tkIconList_Leave1 $w %x %y"
    bind $data(canvas) <B1-Enter>  "tkCancelRepeat"



    bind $data(canvas) <Up>        "tkIconList_UpDown $w -1"
    bind $data(canvas) <Down>      "tkIconList_UpDown $w  1"
    bind $data(canvas) <Left>      "tkIconList_LeftRight $w -1"
    bind $data(canvas) <Right>     "tkIconList_LeftRight $w  1"
    bind $data(canvas) <Return>    "tkIconList_ReturnKey $w"
    bind $data(canvas) <KeyPress>  "tkIconList_KeyPress $w %A"







<
<


>
>







91
92
93
94
95
96
97


98
99
100
101
102
103
104
105
106
107
108

    # Creates the event bindings.
    #
    bind $data(canvas) <Configure> "tkIconList_Arrange $w"

    bind $data(canvas) <1>         "tkIconList_Btn1 $w %x %y"
    bind $data(canvas) <B1-Motion> "tkIconList_Motion1 $w %x %y"


    bind $data(canvas) <B1-Leave>  "tkIconList_Leave1 $w %x %y"
    bind $data(canvas) <B1-Enter>  "tkCancelRepeat"
    bind $data(canvas) <ButtonRelease-1> "tkCancelRepeat"
    bind $data(canvas) <Double-ButtonRelease-1> "tkIconList_Double1 $w %x %y"

    bind $data(canvas) <Up>        "tkIconList_UpDown $w -1"
    bind $data(canvas) <Down>      "tkIconList_UpDown $w  1"
    bind $data(canvas) <Left>      "tkIconList_LeftRight $w -1"
    bind $data(canvas) <Right>     "tkIconList_LeftRight $w  1"
    bind $data(canvas) <Return>    "tkIconList_ReturnKey $w"
    bind $data(canvas) <KeyPress>  "tkIconList_KeyPress $w %A"
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
    upvar #0 $w data
    global tkPriv

    if {![winfo exists $w]} return
    set x $tkPriv(x)
    set y $tkPriv(y)

    if $data(noScroll) {
	return
    }
    if {$x >= [winfo width $data(canvas)]} {
	$data(canvas) xview scroll 1 units
    } elseif {$x < 0} {
	$data(canvas) xview scroll -1 units
    } elseif {$y >= [winfo height $data(canvas)]} {







|







129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
    upvar #0 $w data
    global tkPriv

    if {![winfo exists $w]} return
    set x $tkPriv(x)
    set y $tkPriv(y)

    if {$data(noScroll)} {
	return
    }
    if {$x >= [winfo width $data(canvas)]} {
	$data(canvas) xview scroll 1 units
    } elseif {$x < 0} {
	$data(canvas) xview scroll -1 units
    } elseif {$y >= [winfo height $data(canvas)]} {
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431

    set iTag [$data(canvas) create image 0 0 -image $image -anchor nw]
    set tTag [$data(canvas) create text  0 0 -text  $text  -anchor nw \
	-font $data(font)]
    set rTag [$data(canvas) create rect  0 0 0 0 -fill "" -outline ""]
    
    set b [$data(canvas) bbox $iTag]
    set iW [expr [lindex $b 2]-[lindex $b 0]]
    set iH [expr [lindex $b 3]-[lindex $b 1]]
    if {$data(maxIW) < $iW} {
	set data(maxIW) $iW
    }
    if {$data(maxIH) < $iH} {
	set data(maxIH) $iH
    }
    
    set b [$data(canvas) bbox $tTag]
    set tW [expr [lindex $b 2]-[lindex $b 0]]
    set tH [expr [lindex $b 3]-[lindex $b 1]]
    if {$data(maxTW) < $tW} {
	set data(maxTW) $tW
    }
    if {$data(maxTH) < $tH} {
	set data(maxTH) $tH
    }
    
    lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW $tH $data(numItems)]
    set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
    set textList($data(numItems)) [string tolower $text]
    incr data(numItems)
}

# Places the icons in a column-major arrangement.
#
proc tkIconList_Arrange {w} {
    upvar #0 $w data

    if ![info exists data(list)] {
	if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {
	    set data(noScroll) 1
	    $data(sbar) config -command ""
	}
	return
    }

    set W [winfo width  $data(canvas)]
    set H [winfo height $data(canvas)]
    set pad [expr [$data(canvas) cget -highlightthickness] + \
	[$data(canvas) cget -bd]]
    if {$pad < 2} {
	set pad 2
    }

    incr W -[expr $pad*2]
    incr H -[expr $pad*2]

    set dx [expr $data(maxIW) + $data(maxTW) + 8]
    if {$data(maxTH) > $data(maxIH)} {
	set dy $data(maxTH)
    } else {
	set dy $data(maxIH)
    }
    incr dy 2
    set shift [expr $data(maxIW) + 4]

    set x [expr $pad * 2]
    set y [expr $pad * 1]
    set usedColumn 0
    foreach sublist $data(list) {
	set usedColumn 1
	set iTag [lindex $sublist 0]
	set tTag [lindex $sublist 1]
	set rTag [lindex $sublist 2]
	set iW   [lindex $sublist 3]
	set iH   [lindex $sublist 4]
	set tW   [lindex $sublist 5]
	set tH   [lindex $sublist 6]

	set i_dy [expr ($dy - $iH)/2]
	set t_dy [expr ($dy - $tH)/2]

	$data(canvas) coords $iTag $x                 [expr $y + $i_dy]
	$data(canvas) coords $tTag [expr $x + $shift] [expr $y + $t_dy]
	$data(canvas) coords $tTag [expr $x + $shift] [expr $y + $t_dy]
	$data(canvas) coords $rTag $x $y [expr $x+$dx] [expr $y+$dy]

	incr y $dy
	if {[expr $y + $dy] > $H} {
	    set y [expr $pad * 1]
	    incr x $dx
	    set usedColumn 0
	}
    }

    if {$usedColumn} {
	set sW [expr $x + $dx]
    } else {
	set sW $x
    }

    if {$sW < $W} {
	$data(canvas) config -scrollregion "$pad $pad $sW $H"
	$data(sbar) config -command ""
	$data(canvas) xview moveto 0
	set data(noScroll) 1
    } else {
	$data(canvas) config -scrollregion "$pad $pad $sW $H"
	$data(sbar) config -command "$data(canvas) xview"
	set data(noScroll) 0
    }

    set data(itemsPerColumn) [expr ($H-$pad)/$dy]
    if {$data(itemsPerColumn) < 1} {
	set data(itemsPerColumn) 1
    }

    if {$data(curItem) != {}} {
	tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0
    }
}

# Gets called when the user invokes the IconList (usually by double-clicking
# or pressing the Return key).
#
proc tkIconList_Invoke {w} {
    upvar #0 $w data

    if {[string compare $data(-command) ""] && [info exists data(selected)]} {
	eval $data(-command) [list $data(selected)]
    }
}

# tkIconList_See --
#
#	If the item is not (completely) visible, scroll the canvas so that
#	it becomes visible.
proc tkIconList_See {w rTag} {
    upvar #0 $w data
    upvar #0 $w:itemList itemList

    if $data(noScroll) {
	return
    }
    set sRegion [$data(canvas) cget -scrollregion]
    if ![string compare $sRegion {}] {
	return
    }

    if ![info exists itemList($rTag)] {
	return
    }


    set bbox [$data(canvas) bbox $rTag]
    set pad [expr [$data(canvas) cget -highlightthickness] + \
	[$data(canvas) cget -bd]]

    set x1 [lindex $bbox 0]
    set x2 [lindex $bbox 2]
    incr x1 -[expr $pad * 2]
    incr x2 -[expr $pad * 1]

    set cW [expr [winfo width $data(canvas)] - $pad*2]

    set scrollW [expr [lindex $sRegion 2]-[lindex $sRegion 0]+1]
    set dispX [expr int([lindex [$data(canvas) xview] 0]*$scrollW)]
    set oldDispX $dispX

    # check if out of the right edge
    #
    if {[expr $x2 - $dispX] >= $cW} {
	set dispX [expr $x2 - $cW]
    }
    # check if out of the left edge
    #
    if {[expr $x1 - $dispX] < 0} {
	set dispX $x1
    }

    if {$oldDispX != $dispX} {
	set fraction [expr double($dispX)/double($scrollW)]
	$data(canvas) xview moveto $fraction
    }
}

proc tkIconList_SelectAtXY {w x y} {
    upvar #0 $w data

    tkIconList_Select $w [$data(canvas) find closest \
	[$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
}

proc tkIconList_Select {w rTag {callBrowse 1}} {
    upvar #0 $w data
    upvar #0 $w:itemList itemList

    if ![info exists itemList($rTag)] {
	return
    }
    set iTag   [lindex $itemList($rTag) 0]
    set tTag   [lindex $itemList($rTag) 1]
    set text   [lindex $itemList($rTag) 2]
    set serial [lindex $itemList($rTag) 3]

    if ![info exists data(rect)] {
        set data(rect) [$data(canvas) create rect 0 0 0 0 \
	    -fill #a0a0ff -outline #a0a0ff]
    }
    $data(canvas) lower $data(rect)
    set bbox [$data(canvas) bbox $tTag]
    eval $data(canvas) coords $data(rect) $bbox

    set data(curItem) $serial
    set data(selected) $text
    
    if {$callBrowse} {
	if [string compare $data(-browsecmd) ""] {
	    eval $data(-browsecmd) [list $text]
	}
    }
}

proc tkIconList_Unselect {w} {
    upvar #0 $w data

    if [info exists data(rect)] {
	$data(canvas) delete $data(rect)
	unset data(rect)
    }
    if [info exists data(selected)] {
	unset data(selected)
    }
    set data(curItem)  {}
}

# Returns the selected item
#
proc tkIconList_Get {w} {
    upvar #0 $w data

    if [info exists data(selected)] {
	return $data(selected)
    } else {
	return ""
    }
}









|
|








|
|


















|









|
|




|
|

|






|

|
|











|
|

|
|
|
|


|
|






|















|
















|











|



|



|





|
|



|
|

|

|
|




|
|



|




|















|







|











|








|



|










|







184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431

    set iTag [$data(canvas) create image 0 0 -image $image -anchor nw]
    set tTag [$data(canvas) create text  0 0 -text  $text  -anchor nw \
	-font $data(font)]
    set rTag [$data(canvas) create rect  0 0 0 0 -fill "" -outline ""]
    
    set b [$data(canvas) bbox $iTag]
    set iW [expr {[lindex $b 2]-[lindex $b 0]}]
    set iH [expr {[lindex $b 3]-[lindex $b 1]}]
    if {$data(maxIW) < $iW} {
	set data(maxIW) $iW
    }
    if {$data(maxIH) < $iH} {
	set data(maxIH) $iH
    }
    
    set b [$data(canvas) bbox $tTag]
    set tW [expr {[lindex $b 2]-[lindex $b 0]}]
    set tH [expr {[lindex $b 3]-[lindex $b 1]}]
    if {$data(maxTW) < $tW} {
	set data(maxTW) $tW
    }
    if {$data(maxTH) < $tH} {
	set data(maxTH) $tH
    }
    
    lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW $tH $data(numItems)]
    set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
    set textList($data(numItems)) [string tolower $text]
    incr data(numItems)
}

# Places the icons in a column-major arrangement.
#
proc tkIconList_Arrange {w} {
    upvar #0 $w data

    if {![info exists data(list)]} {
	if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {
	    set data(noScroll) 1
	    $data(sbar) config -command ""
	}
	return
    }

    set W [winfo width  $data(canvas)]
    set H [winfo height $data(canvas)]
    set pad [expr {[$data(canvas) cget -highlightthickness] + \
	    [$data(canvas) cget -bd]}]
    if {$pad < 2} {
	set pad 2
    }

    incr W -[expr {$pad*2}]
    incr H -[expr {$pad*2}]

    set dx [expr {$data(maxIW) + $data(maxTW) + 8}]
    if {$data(maxTH) > $data(maxIH)} {
	set dy $data(maxTH)
    } else {
	set dy $data(maxIH)
    }
    incr dy 2
    set shift [expr {$data(maxIW) + 4}]

    set x [expr {$pad * 2}]
    set y [expr {$pad * 1}] ; # Why * 1 ?
    set usedColumn 0
    foreach sublist $data(list) {
	set usedColumn 1
	set iTag [lindex $sublist 0]
	set tTag [lindex $sublist 1]
	set rTag [lindex $sublist 2]
	set iW   [lindex $sublist 3]
	set iH   [lindex $sublist 4]
	set tW   [lindex $sublist 5]
	set tH   [lindex $sublist 6]

	set i_dy [expr {($dy - $iH)/2}]
	set t_dy [expr {($dy - $tH)/2}]

	$data(canvas) coords $iTag $x                    [expr {$y + $i_dy}]
	$data(canvas) coords $tTag [expr {$x + $shift}]  [expr {$y + $t_dy}]
	$data(canvas) coords $tTag [expr {$x + $shift}]  [expr {$y + $t_dy}]
	$data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]

	incr y $dy
	if {($y + $dy) > $H} {
	    set y [expr {$pad * 1}] ; # *1 ?
	    incr x $dx
	    set usedColumn 0
	}
    }

    if {$usedColumn} {
	set sW [expr {$x + $dx}]
    } else {
	set sW $x
    }

    if {$sW < $W} {
	$data(canvas) config -scrollregion "$pad $pad $sW $H"
	$data(sbar) config -command ""
	$data(canvas) xview moveto 0
	set data(noScroll) 1
    } else {
	$data(canvas) config -scrollregion "$pad $pad $sW $H"
	$data(sbar) config -command "$data(canvas) xview"
	set data(noScroll) 0
    }

    set data(itemsPerColumn) [expr {($H-$pad)/$dy}]
    if {$data(itemsPerColumn) < 1} {
	set data(itemsPerColumn) 1
    }

    if {$data(curItem) != {}} {
	tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0
    }
}

# Gets called when the user invokes the IconList (usually by double-clicking
# or pressing the Return key).
#
proc tkIconList_Invoke {w} {
    upvar #0 $w data

    if {[string compare $data(-command) ""] && [info exists data(selected)]} {
	eval $data(-command)
    }
}

# tkIconList_See --
#
#	If the item is not (completely) visible, scroll the canvas so that
#	it becomes visible.
proc tkIconList_See {w rTag} {
    upvar #0 $w data
    upvar #0 $w:itemList itemList

    if {$data(noScroll)} {
	return
    }
    set sRegion [$data(canvas) cget -scrollregion]
    if {![string compare $sRegion {}]} {
	return
    }

    if {![info exists itemList($rTag)]} {
	return
    }


    set bbox [$data(canvas) bbox $rTag]
    set pad [expr {[$data(canvas) cget -highlightthickness] + \
	    [$data(canvas) cget -bd]}]

    set x1 [lindex $bbox 0]
    set x2 [lindex $bbox 2]
    incr x1 -[expr {$pad * 2}]
    incr x2 -[expr {$pad * 1}] ; # *1 ?

    set cW [expr {[winfo width $data(canvas)] - $pad*2}]

    set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
    set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]
    set oldDispX $dispX

    # check if out of the right edge
    #
    if {($x2 - $dispX) >= $cW} {
	set dispX [expr {$x2 - $cW}]
    }
    # check if out of the left edge
    #
    if {($x1 - $dispX) < 0} {
	set dispX $x1
    }

    if {$oldDispX != $dispX} {
	set fraction [expr {double($dispX)/double($scrollW)}]
	$data(canvas) xview moveto $fraction
    }
}

proc tkIconList_SelectAtXY {w x y} {
    upvar #0 $w data

    tkIconList_Select $w [$data(canvas) find closest \
	[$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
}

proc tkIconList_Select {w rTag {callBrowse 1}} {
    upvar #0 $w data
    upvar #0 $w:itemList itemList

    if {![info exists itemList($rTag)]} {
	return
    }
    set iTag   [lindex $itemList($rTag) 0]
    set tTag   [lindex $itemList($rTag) 1]
    set text   [lindex $itemList($rTag) 2]
    set serial [lindex $itemList($rTag) 3]

    if {![info exists data(rect)]} {
        set data(rect) [$data(canvas) create rect 0 0 0 0 \
	    -fill #a0a0ff -outline #a0a0ff]
    }
    $data(canvas) lower $data(rect)
    set bbox [$data(canvas) bbox $tTag]
    eval $data(canvas) coords $data(rect) $bbox

    set data(curItem) $serial
    set data(selected) $text
    
    if {$callBrowse} {
	if {[string compare $data(-browsecmd) ""]} {
	    eval $data(-browsecmd) [list $text]
	}
    }
}

proc tkIconList_Unselect {w} {
    upvar #0 $w data

    if {[info exists data(rect)]} {
	$data(canvas) delete $data(rect)
	unset data(rect)
    }
    if {[info exists data(selected)]} {
	unset data(selected)
    }
    set data(curItem)  {}
}

# Returns the selected item
#
proc tkIconList_Get {w} {
    upvar #0 $w data

    if {[info exists data(selected)]} {
	return $data(selected)
    } else {
	return ""
    }
}


465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
    set tkPriv(y) $y
    tkIconList_AutoScan $w
}

proc tkIconList_FocusIn {w} {
    upvar #0 $w data

    if ![info exists data(list)] {
	return
    }

    if {$data(curItem) == {}} {
	set rTag [lindex [lindex $data(list) 0] 2]
	tkIconList_Select $w $rTag
    }
}

# tkIconList_UpDown --
#
# Moves the active element up or down by one element
#
# Arguments:
# w -		The IconList widget.
# amount -	+1 to move down one item, -1 to move back one item.
#
proc tkIconList_UpDown {w amount} {
    upvar #0 $w data

    if ![info exists data(list)] {
	return
    }

    if {$data(curItem) == {}} {
	set rTag [lindex [lindex $data(list) 0] 2]
    } else {
	set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
	set rTag [lindex [lindex $data(list) [expr $data(curItem)+$amount]] 2]
	if ![string compare $rTag ""] {
	    set rTag $oldRTag
	}
    }

    if [string compare $rTag ""] {
	tkIconList_Select $w $rTag
	tkIconList_See $w $rTag
    }
}

# tkIconList_LeftRight --
#
# Moves the active element left or right by one column
#
# Arguments:
# w -		The IconList widget.
# amount -	+1 to move right one column, -1 to move left one column.
#
proc tkIconList_LeftRight {w amount} {
    upvar #0 $w data

    if ![info exists data(list)] {
	return
    }
    if {$data(curItem) == {}} {
	set rTag [lindex [lindex $data(list) 0] 2]
    } else {
	set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
	set newItem [expr $data(curItem)+($amount*$data(itemsPerColumn))]
	set rTag [lindex [lindex $data(list) $newItem] 2]
	if ![string compare $rTag ""] {
	    set rTag $oldRTag
	}
    }

    if [string compare $rTag ""] {
	tkIconList_Select $w $rTag
	tkIconList_See $w $rTag
    }
}

#----------------------------------------------------------------------
#		Accelerator key bindings







|




















|







|
|




|
















|






|

|




|







465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
    set tkPriv(y) $y
    tkIconList_AutoScan $w
}

proc tkIconList_FocusIn {w} {
    upvar #0 $w data

    if {![info exists data(list)]} {
	return
    }

    if {$data(curItem) == {}} {
	set rTag [lindex [lindex $data(list) 0] 2]
	tkIconList_Select $w $rTag
    }
}

# tkIconList_UpDown --
#
# Moves the active element up or down by one element
#
# Arguments:
# w -		The IconList widget.
# amount -	+1 to move down one item, -1 to move back one item.
#
proc tkIconList_UpDown {w amount} {
    upvar #0 $w data

    if {![info exists data(list)]} {
	return
    }

    if {$data(curItem) == {}} {
	set rTag [lindex [lindex $data(list) 0] 2]
    } else {
	set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
	set rTag [lindex [lindex $data(list) [expr {$data(curItem)+$amount}]] 2]
	if {![string compare $rTag ""]} {
	    set rTag $oldRTag
	}
    }

    if {[string compare $rTag ""]} {
	tkIconList_Select $w $rTag
	tkIconList_See $w $rTag
    }
}

# tkIconList_LeftRight --
#
# Moves the active element left or right by one column
#
# Arguments:
# w -		The IconList widget.
# amount -	+1 to move right one column, -1 to move left one column.
#
proc tkIconList_LeftRight {w amount} {
    upvar #0 $w data

    if {![info exists data(list)]} {
	return
    }
    if {$data(curItem) == {}} {
	set rTag [lindex [lindex $data(list) 0] 2]
    } else {
	set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
	set newItem [expr {$data(curItem)+($amount*$data(itemsPerColumn))}]
	set rTag [lindex [lindex $data(list) $newItem] 2]
	if {![string compare $rTag ""]} {
	    set rTag $oldRTag
	}
    }

    if {[string compare $rTag ""]} {
	tkIconList_Select $w $rTag
	tkIconList_See $w $rTag
    }
}

#----------------------------------------------------------------------
#		Accelerator key bindings
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
}

proc tkIconList_Goto {w text} {
    upvar #0 $w data
    upvar #0 $w:textList textList
    global tkPriv
    
    if ![info exists data(list)] {
	return
    }

    if {[string length $text] == 0} {
	return
    }

    if {$data(curItem) == {} || $data(curItem) == 0} {
	set start  0
    } else {
	set start  $data(curItem)
    }

    set text [string tolower $text]
    set theIndex -1
    set less 0
    set len [string length $text]
    set len0 [expr $len-1]
    set i $start

    # Search forward until we find a filename whose prefix is an exact match
    # with $text
    while 1 {
	set sub [string range $textList($i) 0 $len0]
	if {[string compare $text $sub] == 0} {







|

















|







561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
}

proc tkIconList_Goto {w text} {
    upvar #0 $w data
    upvar #0 $w:textList textList
    global tkPriv
    
    if {![info exists data(list)]} {
	return
    }

    if {[string length $text] == 0} {
	return
    }

    if {$data(curItem) == {} || $data(curItem) == 0} {
	set start  0
    } else {
	set start  $data(curItem)
    }

    set text [string tolower $text]
    set theIndex -1
    set less 0
    set len [string length $text]
    set len0 [expr {$len-1}]
    set i $start

    # Search forward until we find a filename whose prefix is an exact match
    # with $text
    while 1 {
	set sub [string range $textList($i) 0 $len0]
	if {[string compare $text $sub] == 0} {
624
625
626
627
628
629
630





631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656











657
658
659


660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726

727
728
729
730
731
732
733
734
735
736
737








738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776


777

778




779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812

# tkFDialog --
#
#	Implements the TK file selection dialog. This dialog is used when
#	the tk_strictMotif flag is set to false. This procedure shouldn't
#	be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
#





proc tkFDialog {args} {
    global tkPriv
    set w __tk_filedialog
    upvar #0 $w data

    if ![string compare [lindex [info level 0] 0] tk_getOpenFile] {
	set type open
    } else {
	set type save
    }

    tkFDialog_Config $w $type $args

    if {![string compare $data(-parent) .]} {
        set w .$w
    } else {
        set w $data(-parent).$w
    }

    # (re)create the dialog box if necessary
    #
    if {![winfo exists $w]} {
	tkFDialog_Create $w
    } elseif {[string compare [winfo class $w] TkFDialog]} {
	destroy $w
	tkFDialog_Create $w











    }
    wm transient $w $data(-parent)



    # 5. Initialize the file types menu
    #
    if {$data(-filetypes) != {}} {
	$data(typeMenu) delete 0 end
	foreach type $data(-filetypes) {
	    set title  [lindex $type 0]
	    set filter [lindex $type 1]
	    $data(typeMenu) add command -label $title \
		-command [list tkFDialog_SetFilter $w $type]
	}
	tkFDialog_SetFilter $w [lindex $data(-filetypes) 0]
	$data(typeMenuBtn) config -state normal
	$data(typeMenuLab) config -state normal
    } else {
	set data(filter) "*"
	$data(typeMenuBtn) config -state disabled -takefocus 0
	$data(typeMenuLab) config -state disabled
    }

    tkFDialog_UpdateWhenIdle $w

    # 6. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]]
    wm geom $w [winfo reqwidth $w]x[winfo reqheight $w]+$x+$y
    wm deiconify $w
    wm title $w $data(-title)

    # 7. Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current $w]
    if {$oldGrab != ""} {
	set grabStatus [grab status $oldGrab]
    }
    grab $w
    focus $data(ent)
    $data(ent) delete 0 end
    $data(ent) insert 0 $data(selectFile)
    $data(ent) select from 0
    $data(ent) select to   end
    $data(ent) icursor end

    # 8. Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

    tkwait variable tkPriv(selectFilePath)
    catch {focus $oldFocus}
    grab release $w
    wm withdraw $w
    if {$oldGrab != ""} {
	if {$grabStatus == "global"} {
	    grab -global $oldGrab
	} else {
	    grab $oldGrab
	}
    }

    return $tkPriv(selectFilePath)
}

# tkFDialog_Config --
#
#	Configures the TK filedialog according to the argument list
#
proc tkFDialog_Config {w type argList} {
    upvar #0 $w data

    set data(type) $type









    # 1: the configuration specs
    #
    set specs {
	{-defaultextension "" "" ""}
	{-filetypes "" "" ""}
	{-initialdir "" "" ""}
	{-initialfile "" "" ""}
	{-parent "" "" "."}
	{-title "" "" ""}
    }

    # 2: default values depending on the type of the dialog
    #
    if ![info exists data(selectPath)] {
	# first time the dialog has been popped up
	set data(selectPath) [pwd]
	set data(selectFile) ""
    }

    # 3: parse the arguments
    #
    tclParseConfigSpec $w $specs "" $argList

    if ![string compare $data(-title) ""] {
	if ![string compare $type "open"] {
	    set data(-title) "Open"
	} else {
	    set data(-title) "Save As"
	}
    }

    # 4: set the default directory and selection according to the -initial
    #    settings
    #
    if [string compare $data(-initialdir) ""] {
	if [file isdirectory $data(-initialdir)] {
	    set data(selectPath) [glob $data(-initialdir)]
	} else {


	    error "\"$data(-initialdir)\" is not a valid directory"

	}




    }
    set data(selectFile) $data(-initialfile)

    # 5. Parse the -filetypes option
    #
    set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]

    if ![winfo exists $data(-parent)] {
	error "bad window path name \"$data(-parent)\""
    }
}

proc tkFDialog_Create {w} {
    set dataName [lindex [split $w .] end]
    upvar #0 $dataName data
    global tk_library

    toplevel $w -class TkFDialog

    # f1: the frame with the directory option menu
    #
    set f1 [frame $w.f1]
    label $f1.lab -text "Directory:" -under 0
    set data(dirMenuBtn) $f1.menu
    set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) $dataName] ""]
    set data(upBtn) [button $f1.up]
    if ![info exists tkPriv(updirImage)] {
	set tkPriv(updirImage) [image create bitmap -data {
#define updir_width 28
#define updir_height 16
static char updir_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,







>
>
>
>
>
|

|
|

<
<
<
<
<
<
|


|

|









>
>
>
>
>
>
>
>
>
>
>



>
>
|




















|





|
|
|
|




|














|
















>







|
|


>
>
>
>
>
>
>
>














|







|

|
|









|
|
|

>
>
|
>
|
>
>
>
>







|


















|







624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640






641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840

# tkFDialog --
#
#	Implements the TK file selection dialog. This dialog is used when
#	the tk_strictMotif flag is set to false. This procedure shouldn't
#	be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
#
# Arguments:
#	type		"open" or "save"
#	args		Options parsed by the procedure.
#

proc tkFDialog {type args} {
    global tkPriv
    set dataName __tk_filedialog
    upvar #0 $dataName data







    tkFDialog_Config $dataName $type $args

    if {![string compare $data(-parent) .]} {
        set w .$dataName
    } else {
        set w $data(-parent).$dataName
    }

    # (re)create the dialog box if necessary
    #
    if {![winfo exists $w]} {
	tkFDialog_Create $w
    } elseif {[string compare [winfo class $w] TkFDialog]} {
	destroy $w
	tkFDialog_Create $w
    } else {
	set data(dirMenuBtn) $w.f1.menu
	set data(dirMenu) $w.f1.menu.menu
	set data(upBtn) $w.f1.up
	set data(icons) $w.icons
	set data(ent) $w.f2.ent
	set data(typeMenuLab) $w.f3.lab
	set data(typeMenuBtn) $w.f3.menu
	set data(typeMenu) $data(typeMenuBtn).m
	set data(okBtn) $w.f2.ok
	set data(cancelBtn) $w.f3.cancel
    }
    wm transient $w $data(-parent)

    trace variable data(selectPath) w "tkFDialog_SetPath $w"

    # Initialize the file types menu
    #
    if {$data(-filetypes) != {}} {
	$data(typeMenu) delete 0 end
	foreach type $data(-filetypes) {
	    set title  [lindex $type 0]
	    set filter [lindex $type 1]
	    $data(typeMenu) add command -label $title \
		-command [list tkFDialog_SetFilter $w $type]
	}
	tkFDialog_SetFilter $w [lindex $data(-filetypes) 0]
	$data(typeMenuBtn) config -state normal
	$data(typeMenuLab) config -state normal
    } else {
	set data(filter) "*"
	$data(typeMenuBtn) config -state disabled -takefocus 0
	$data(typeMenuLab) config -state disabled
    }

    tkFDialog_UpdateWhenIdle $w

    # Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]}]
    set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]}]
    wm geom $w [winfo reqwidth $w]x[winfo reqheight $w]+$x+$y
    wm deiconify $w
    wm title $w $data(-title)

    # Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current $w]
    if {$oldGrab != ""} {
	set grabStatus [grab status $oldGrab]
    }
    grab $w
    focus $data(ent)
    $data(ent) delete 0 end
    $data(ent) insert 0 $data(selectFile)
    $data(ent) select from 0
    $data(ent) select to   end
    $data(ent) icursor end

    # Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

    tkwait variable tkPriv(selectFilePath)
    catch {focus $oldFocus}
    grab release $w
    wm withdraw $w
    if {$oldGrab != ""} {
	if {$grabStatus == "global"} {
	    grab -global $oldGrab
	} else {
	    grab $oldGrab
	}
    }

    return $tkPriv(selectFilePath)
}

# tkFDialog_Config --
#
#	Configures the TK filedialog according to the argument list
#
proc tkFDialog_Config {dataName type argList} {
    upvar #0 $dataName data

    set data(type) $type

    # 0: Delete all variable that were set on data(selectPath) the
    # last time the file dialog is used. The traces may cause troubles
    # if the dialog is now used with a different -parent option.

    foreach trace [trace vinfo data(selectPath)] {
	trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
    }

    # 1: the configuration specs
    #
    set specs {
	{-defaultextension "" "" ""}
	{-filetypes "" "" ""}
	{-initialdir "" "" ""}
	{-initialfile "" "" ""}
	{-parent "" "" "."}
	{-title "" "" ""}
    }

    # 2: default values depending on the type of the dialog
    #
    if {![info exists data(selectPath)]} {
	# first time the dialog has been popped up
	set data(selectPath) [pwd]
	set data(selectFile) ""
    }

    # 3: parse the arguments
    #
    tclParseConfigSpec $dataName $specs "" $argList

    if {![string compare $data(-title) ""]} {
	if {![string compare $type "open"]} {
	    set data(-title) "Open"
	} else {
	    set data(-title) "Save As"
	}
    }

    # 4: set the default directory and selection according to the -initial
    #    settings
    #
    if {[string compare $data(-initialdir) ""]} {
	if {[file isdirectory $data(-initialdir)]} {
	    set data(selectPath) [lindex [glob $data(-initialdir)] 0]
	} else {
	    set data(selectPath) [pwd]
	}

	# Convert the initialdir to an absolute path name.

	set old [pwd]
	cd $data(selectPath)
	set data(selectPath) [pwd]
	cd $old
    }
    set data(selectFile) $data(-initialfile)

    # 5. Parse the -filetypes option
    #
    set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]

    if {![winfo exists $data(-parent)]} {
	error "bad window path name \"$data(-parent)\""
    }
}

proc tkFDialog_Create {w} {
    set dataName [lindex [split $w .] end]
    upvar #0 $dataName data
    global tk_library

    toplevel $w -class TkFDialog

    # f1: the frame with the directory option menu
    #
    set f1 [frame $w.f1]
    label $f1.lab -text "Directory:" -under 0
    set data(dirMenuBtn) $f1.menu
    set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) $dataName] ""]
    set data(upBtn) [button $f1.up]
    if {![info exists tkPriv(updirImage)]} {
	set tkPriv(updirImage) [image create bitmap -data {
#define updir_width 28
#define updir_height 16
static char updir_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
    pack $f1.lab -side left -padx 4 -fill both
    pack $f1.menu -expand yes -fill both -padx 4

    # data(icons): the IconList that list the files and directories.
    #
    set data(icons) [tkIconList $w.icons \
	-browsecmd "tkFDialog_ListBrowse $w" \
	-command   "tkFDialog_ListInvoke $w"]

    # f2: the frame with the OK button and the "file name" field
    #
    set f2 [frame $w.f2 -bd 0]
    label $f2.lab -text "File name:" -anchor e -width 14 -under 5 -pady 0
    set data(ent) [entry $f2.ent]








|







850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
    pack $f1.lab -side left -padx 4 -fill both
    pack $f1.menu -expand yes -fill both -padx 4

    # data(icons): the IconList that list the files and directories.
    #
    set data(icons) [tkIconList $w.icons \
	-browsecmd "tkFDialog_ListBrowse $w" \
	-command   "tkFDialog_OkCmd $w"]

    # f2: the frame with the OK button and the "file name" field
    #
    set f2 [frame $w.f2 -bd 0]
    label $f2.lab -text "File name:" -anchor e -width 14 -under 5 -pady 0
    set data(ent) [entry $f2.ent]

892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
    #
    bind $data(ent) <Return>  "tkFDialog_ActivateEnt $w"
    
    $data(upBtn)     config -command "tkFDialog_UpDirCmd $w"
    $data(okBtn)     config -command "tkFDialog_OkCmd $w"
    $data(cancelBtn) config -command "tkFDialog_CancelCmd $w"

    trace variable data(selectPath) w "tkFDialog_SetPath $w"

    bind $w <Alt-d> "focus $data(dirMenuBtn)"
    bind $w <Alt-t> [format {
	if {"[%s cget -state]" == "normal"} {
	    focus %s
	}
    } $data(typeMenuBtn) $data(typeMenuBtn)]
    bind $w <Alt-n> "focus $data(ent)"







<
<







920
921
922
923
924
925
926


927
928
929
930
931
932
933
    #
    bind $data(ent) <Return>  "tkFDialog_ActivateEnt $w"
    
    $data(upBtn)     config -command "tkFDialog_UpDirCmd $w"
    $data(okBtn)     config -command "tkFDialog_OkCmd $w"
    $data(cancelBtn) config -command "tkFDialog_CancelCmd $w"



    bind $w <Alt-d> "focus $data(dirMenuBtn)"
    bind $w <Alt-t> [format {
	if {"[%s cget -state]" == "normal"} {
	    focus %s
	}
    } $data(typeMenuBtn) $data(typeMenuBtn)]
    bind $w <Alt-n> "focus $data(ent)"
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953

954



955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
#	time. This is important because loading the directory may take a long
#	time and we don't want to load the same directory for multiple times
#	due to multiple concurrent events.
#
proc tkFDialog_UpdateWhenIdle {w} {
    upvar #0 [winfo name $w] data

    if [info exists data(updateId)] {
	return
    } else {
	set data(updateId) [after idle tkFDialog_Update $w]
    }
}

# tkFDialog_Update --
#
#	Loads the files and directories into the IconList widget. Also
#	sets up the directory option menu for quick access to parent
#	directories.
#
proc tkFDialog_Update {w} {
    set dataName [winfo name $w]
    upvar #0 $dataName data
    global tk_library tkPriv

    # This proc may be called within an idle handler. Make sure that the
    # window has not been destroyed before this proc is called
    if {![winfo exists $w] || [string compare [winfo class $w] TkFDialog]} {
	return

    } else {



	catch {unset data(updateId)}
    }

    set TRANSPARENT_GIF_COLOR [$w cget -bg]
    if ![info exists tkPriv(folderImage)] {
	set tkPriv(folderImage) [image create photo -data {
R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
	set tkPriv(fileImage)   [image create photo -data {
R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
    }
    set folder $tkPriv(folderImage)
    set file   $tkPriv(fileImage)

    set appPWD [pwd]
    if [catch {
	cd $data(selectPath)
    }] {
	# We cannot change directory to $data(selectPath). $data(selectPath)
	# should have been checked before tkFDialog_Update is called, so
	# we normally won't come to here. Anyways, give an error and abort
	# action.
	tk_messageBox -type ok -parent $data(-parent) -message \
	    "Cannot change to the directory \"$data(selectPath)\".\nPermission denied."\
	    -icon warning







|













<
<
<





>
|
>
>
>
|
|
<
<
|











|

|







951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971



972
973
974
975
976
977
978
979
980
981
982
983


984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
#	time. This is important because loading the directory may take a long
#	time and we don't want to load the same directory for multiple times
#	due to multiple concurrent events.
#
proc tkFDialog_UpdateWhenIdle {w} {
    upvar #0 [winfo name $w] data

    if {[info exists data(updateId)]} {
	return
    } else {
	set data(updateId) [after idle tkFDialog_Update $w]
    }
}

# tkFDialog_Update --
#
#	Loads the files and directories into the IconList widget. Also
#	sets up the directory option menu for quick access to parent
#	directories.
#
proc tkFDialog_Update {w} {




    # This proc may be called within an idle handler. Make sure that the
    # window has not been destroyed before this proc is called
    if {![winfo exists $w] || [string compare [winfo class $w] TkFDialog]} {
	return
    }

    set dataName [winfo name $w]
    upvar #0 $dataName data
    global tk_library tkPriv
    catch {unset data(updateId)}



    if {![info exists tkPriv(folderImage)]} {
	set tkPriv(folderImage) [image create photo -data {
R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
	set tkPriv(fileImage)   [image create photo -data {
R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
    }
    set folder $tkPriv(folderImage)
    set file   $tkPriv(fileImage)

    set appPWD [pwd]
    if {[catch {
	cd $data(selectPath)
    }]} {
	# We cannot change directory to $data(selectPath). $data(selectPath)
	# should have been checked before tkFDialog_Update is called, so
	# we normally won't come to here. Anyways, give an error and abort
	# action.
	tk_messageBox -type ok -parent $data(-parent) -message \
	    "Cannot change to the directory \"$data(selectPath)\".\nPermission denied."\
	    -icon warning
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
    update idletasks
    
    tkIconList_DeleteAll $data(icons)

    # Make the dir list
    #
    foreach f [lsort -dictionary [glob -nocomplain .* *]] {
	if ![string compare $f .] {
	    continue
	}
	if ![string compare $f ..] {
	    continue
	}
	if [file isdir ./$f] {
	    if ![info exists hasDoneDir($f)] {
		tkIconList_Add $data(icons) $folder $f
		set hasDoneDir($f) 1
	    }
	}
    }
    # Make the file list
    #
    if ![string compare $data(filter) *] {
	set files [lsort -dictionary \
	    [glob -nocomplain .* *]]
    } else {
	set files [lsort -dictionary \
	    [eval glob -nocomplain $data(filter)]]
    }

    set top 0
    foreach f $files {
	if ![file isdir ./$f] {
	    if ![info exists hasDoneFile($f)] {
		tkIconList_Add $data(icons) $file $f
		set hasDoneFile($f) 1
	    }
	}
    }

    tkIconList_Arrange $data(icons)







|


|


|
|







|









|
|







1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
    update idletasks
    
    tkIconList_DeleteAll $data(icons)

    # Make the dir list
    #
    foreach f [lsort -dictionary [glob -nocomplain .* *]] {
	if {![string compare $f .]} {
	    continue
	}
	if {![string compare $f ..]} {
	    continue
	}
	if {[file isdir ./$f]} {
	    if {![info exists hasDoneDir($f)]} {
		tkIconList_Add $data(icons) $folder $f
		set hasDoneDir($f) 1
	    }
	}
    }
    # Make the file list
    #
    if {![string compare $data(filter) *]} {
	set files [lsort -dictionary \
	    [glob -nocomplain .* *]]
    } else {
	set files [lsort -dictionary \
	    [eval glob -nocomplain $data(filter)]]
    }

    set top 0
    foreach f $files {
	if {![file isdir ./$f]} {
	    if {![info exists hasDoneFile($f)]} {
		tkIconList_Add $data(icons) $file $f
		set hasDoneFile($f) 1
	    }
	}
    }

    tkIconList_Arrange $data(icons)
1045
1046
1047
1048
1049
1050
1051








1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074

1075
1076

1077
1078
1079
1080
1081
1082
1083
    foreach path $list {
	$data(dirMenu) add command -label $path -command [list set $var $path]
    }

    # Restore the PWD to the application's PWD
    #
    cd $appPWD









    # turn off the busy cursor.
    #
    $data(ent) config -cursor $entCursor
    $w         config -cursor $dlgCursor
}

# tkFDialog_SetPathSilently --
#
# 	Sets data(selectPath) without invoking the trace procedure
#
proc tkFDialog_SetPathSilently {w path} {
    upvar #0 [winfo name $w] data

    trace vdelete  data(selectPath) w "tkFDialog_SetPath $w"
    set data(selectPath) $path
    trace variable data(selectPath) w "tkFDialog_SetPath $w"
}


# This proc gets called whenever data(selectPath) is set
#
proc tkFDialog_SetPath {w name1 name2 op} {

    upvar #0 [winfo name $w] data
    tkFDialog_UpdateWhenIdle $w

}

# This proc gets called whenever data(filter) is set
#
proc tkFDialog_SetFilter {w type} {
    upvar #0 [winfo name $w] data
    upvar \#0 $data(icons) icons







>
>
>
>
>
>
>
>













|









>
|
|
>







1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
    foreach path $list {
	$data(dirMenu) add command -label $path -command [list set $var $path]
    }

    # Restore the PWD to the application's PWD
    #
    cd $appPWD

    # Restore the Open/Save Button
    #
    if {![string compare $data(type) open]} {
        $data(okBtn) config -text "Open"
    } else {
        $data(okBtn) config -text "Save"
    }

    # turn off the busy cursor.
    #
    $data(ent) config -cursor $entCursor
    $w         config -cursor $dlgCursor
}

# tkFDialog_SetPathSilently --
#
# 	Sets data(selectPath) without invoking the trace procedure
#
proc tkFDialog_SetPathSilently {w path} {
    upvar #0 [winfo name $w] data
    
    trace vdelete  data(selectPath) w "tkFDialog_SetPath $w"
    set data(selectPath) $path
    trace variable data(selectPath) w "tkFDialog_SetPath $w"
}


# This proc gets called whenever data(selectPath) is set
#
proc tkFDialog_SetPath {w name1 name2 op} {
    if {[winfo exists $w]} {
	upvar #0 [winfo name $w] data
	tkFDialog_UpdateWhenIdle $w
    }
}

# This proc gets called whenever data(filter) is set
#
proc tkFDialog_SetFilter {w type} {
    upvar #0 [winfo name $w] data
    upvar \#0 $data(icons) icons
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141

1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187

    set path [tkFDialog_JoinFile $context $text]

    if {[file ext $path] == ""} {
	set path "$path$defaultext"
    }

    if [catch {file exists $path}] {
	return [list ERROR $path ""]
    }

    if [catch {if [file exists $path] {}}] {
	# This "if" block can be safely removed if the following code returns
	# an error. It currently (7/22/97) doesn't

	#
	#	file exists ~nonsuchuser
	#
	return [list ERROR $path ""]
    }

    if [file exists $path] {
	if [file isdirectory $path] {
	    if [catch {
		cd $path
	    }] {
		return [list CHDIR $path ""]
	    }
	    set directory [pwd]
	    set file ""
	    set flag OK
	    cd $appPWD
	} else {
	    if [catch {
		cd [file dirname $path]
	    }] {
		return [list CHDIR [file dirname $path] ""]
	    }
	    set directory [pwd]
	    set file [file tail $path]
	    set flag OK
	    cd $appPWD
	}
    } else {
	set dirname [file dirname $path]
	if [file exists $dirname] {
	    if [catch {
		cd $dirname
	    }] {
		return [list CHDIR $dirname ""]
	    }
	    set directory [pwd]
	    set file [file tail $path]
	    if [regexp {[*]|[?]} $file] {
		set flag PATTERN
	    } else {
		set flag FILE
	    }
	    cd $appPWD
	} else {
	    set directory $dirname







<
<
|
<
|
|
<
>






|
|
|

|







|

|









|
|

|




|







1163
1164
1165
1166
1167
1168
1169


1170

1171
1172

1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219

    set path [tkFDialog_JoinFile $context $text]

    if {[file ext $path] == ""} {
	set path "$path$defaultext"
    }





    if {[catch {file exists $path}]} {
	# This "if" block can be safely removed if the following code

	# stop generating errors.
	#
	#	file exists ~nonsuchuser
	#
	return [list ERROR $path ""]
    }

    if {[file exists $path]} {
	if {[file isdirectory $path]} {
	    if {[catch {
		cd $path
	    }]} {
		return [list CHDIR $path ""]
	    }
	    set directory [pwd]
	    set file ""
	    set flag OK
	    cd $appPWD
	} else {
	    if {[catch {
		cd [file dirname $path]
	    }]} {
		return [list CHDIR [file dirname $path] ""]
	    }
	    set directory [pwd]
	    set file [file tail $path]
	    set flag OK
	    cd $appPWD
	}
    } else {
	set dirname [file dirname $path]
	if {[file exists $dirname]} {
	    if {[catch {
		cd $dirname
	    }]} {
		return [list CHDIR $dirname ""]
	    }
	    set directory [pwd]
	    set file [file tail $path]
	    if {[regexp {[*]|[?]} $file]} {
		set flag PATTERN
	    } else {
		set flag FILE
	    }
	    cd $appPWD
	} else {
	    set directory $dirname
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
# Gets called when the entry box gets keyboard focus. We clear the selection
# from the icon list . This way the user can be certain that the input in the 
# entry box is the selection.
#
proc tkFDialog_EntFocusIn {w} {
    upvar #0 [winfo name $w] data

    if [string compare [$data(ent) get] ""] {
	$data(ent) selection from 0
	$data(ent) selection to   end
	$data(ent) icursor end
    } else {
	$data(ent) selection clear
    }

    tkIconList_Unselect $data(icons)

    if ![string compare $data(type) open] {
	$data(okBtn) config -text "Open"
    } else {
	$data(okBtn) config -text "Save"
    }
}

proc tkFDialog_EntFocusOut {w} {







|









|







1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
# Gets called when the entry box gets keyboard focus. We clear the selection
# from the icon list . This way the user can be certain that the input in the 
# entry box is the selection.
#
proc tkFDialog_EntFocusIn {w} {
    upvar #0 [winfo name $w] data

    if {[string compare [$data(ent) get] ""]} {
	$data(ent) selection from 0
	$data(ent) selection to   end
	$data(ent) icursor end
    } else {
	$data(ent) selection clear
    }

    tkIconList_Unselect $data(icons)

    if {![string compare $data(type) open]} {
	$data(okBtn) config -text "Open"
    } else {
	$data(okBtn) config -text "Save"
    }
}

proc tkFDialog_EntFocusOut {w} {
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
    set text [string trim [$data(ent) get]]
    set list [tkFDialogResolveFile $data(selectPath) $text \
		  $data(-defaultextension)]
    set flag [lindex $list 0]
    set path [lindex $list 1]
    set file [lindex $list 2]

    case $flag {
	OK {
	    if ![string compare $file ""] {
		# user has entered an existing (sub)directory
		set data(selectPath) $path
		$data(ent) delete 0 end
	    } else {
		tkFDialog_SetPathSilently $w $path
		set data(selectFile) $file
		tkFDialog_Done $w
	    }
	}
	PATTERN {
	    set data(selectPath) $path
	    set data(filter) $file
	}
	FILE {
	    if ![string compare $data(type) open] {
		tk_messageBox -icon warning -type ok -parent $data(-parent) \
		    -message "File \"[file join $path $file]\" does not exist."
		$data(ent) select from 0
		$data(ent) select to   end
		$data(ent) icursor end
	    } else {
		tkFDialog_SetPathSilently $w $path







|

|














|







1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
    set text [string trim [$data(ent) get]]
    set list [tkFDialogResolveFile $data(selectPath) $text \
		  $data(-defaultextension)]
    set flag [lindex $list 0]
    set path [lindex $list 1]
    set file [lindex $list 2]

    switch -- $flag {
	OK {
	    if {![string compare $file ""]} {
		# user has entered an existing (sub)directory
		set data(selectPath) $path
		$data(ent) delete 0 end
	    } else {
		tkFDialog_SetPathSilently $w $path
		set data(selectFile) $file
		tkFDialog_Done $w
	    }
	}
	PATTERN {
	    set data(selectPath) $path
	    set data(filter) $file
	}
	FILE {
	    if {![string compare $data(type) open]} {
		tk_messageBox -icon warning -type ok -parent $data(-parent) \
		    -message "File \"[file join $path $file]\" does not exist."
		$data(ent) select from 0
		$data(ent) select to   end
		$data(ent) icursor end
	    } else {
		tkFDialog_SetPathSilently $w $path
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
}

# Gets called when user presses the Alt-s or Alt-o keys.
#
proc tkFDialog_InvokeBtn {w key} {
    upvar #0 [winfo name $w] data

    if ![string compare [$data(okBtn) cget -text] $key] {
	tkButtonInvoke $data(okBtn)
    }
}

# Gets called when user presses the "parent directory" button
#
proc tkFDialog_UpDirCmd {w} {
    upvar #0 [winfo name $w] data

    if [string compare $data(selectPath) "/"] {
	set data(selectPath) [file dirname $data(selectPath)]
    }
}

# Join a file name to a path name. The "file join" command will break
# if the filename begins with ~
#







|









|







1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
}

# Gets called when user presses the Alt-s or Alt-o keys.
#
proc tkFDialog_InvokeBtn {w key} {
    upvar #0 [winfo name $w] data

    if {![string compare [$data(okBtn) cget -text] $key]} {
	tkButtonInvoke $data(okBtn)
    }
}

# Gets called when user presses the "parent directory" button
#
proc tkFDialog_UpDirCmd {w} {
    upvar #0 [winfo name $w] data

    if {[string compare $data(selectPath) "/"]} {
	set data(selectPath) [file dirname $data(selectPath)]
    }
}

# Join a file name to a path name. The "file join" command will break
# if the filename begins with ~
#
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343

# Gets called when user presses the "OK" button
#
proc tkFDialog_OkCmd {w} {
    upvar #0 [winfo name $w] data

    set text [tkIconList_Get $data(icons)]
    if [string compare $text ""] {
	set file [tkFDialog_JoinFile $data(selectPath) $text]
	if [file isdirectory $file] {
	    tkFDialog_ListInvoke $w $text
	    return
	}
    }

    tkFDialog_ActivateEnt $w
}







|

|







1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375

# Gets called when user presses the "OK" button
#
proc tkFDialog_OkCmd {w} {
    upvar #0 [winfo name $w] data

    set text [tkIconList_Get $data(icons)]
    if {[string compare $text ""]} {
	set file [tkFDialog_JoinFile $data(selectPath) $text]
	if {[file isdirectory $file]} {
	    tkFDialog_ListInvoke $w $text
	    return
	}
    }

    tkFDialog_ActivateEnt $w
}
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
    upvar #0 [winfo name $w] data

    if {$text == ""} {
	return
    }

    set file [tkFDialog_JoinFile $data(selectPath) $text]
    if ![file isdirectory $file] {
	$data(ent) delete 0 end
	$data(ent) insert 0 $text

	if ![string compare $data(type) open] {
	    $data(okBtn) config -text "Open"
	} else {
	    $data(okBtn) config -text "Save"
	}
    } else {
	$data(okBtn) config -text "Open"
    }







|



|







1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
    upvar #0 [winfo name $w] data

    if {$text == ""} {
	return
    }

    set file [tkFDialog_JoinFile $data(selectPath) $text]
    if {![file isdirectory $file]} {
	$data(ent) delete 0 end
	$data(ent) insert 0 $text

	if {![string compare $data(type) open]} {
	    $data(okBtn) config -text "Open"
	} else {
	    $data(okBtn) config -text "Save"
	}
    } else {
	$data(okBtn) config -text "Open"
    }
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400

    if {$text == ""} {
	return
    }

    set file [tkFDialog_JoinFile $data(selectPath) $text]

    if [file isdirectory $file] {
	set appPWD [pwd]
	if [catch {cd $file}] {
	    tk_messageBox -type ok -parent $data(-parent) -message \
	       "Cannot change to the directory \"$file\".\nPermission denied."\
		-icon warning
	} else {
	    cd $appPWD
	    set data(selectPath) $file
	}







|

|







1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432

    if {$text == ""} {
	return
    }

    set file [tkFDialog_JoinFile $data(selectPath) $text]

    if {[file isdirectory $file]} {
	set appPWD [pwd]
	if {[catch {cd $file}]} {
	    tk_messageBox -type ok -parent $data(-parent) -message \
	       "Cannot change to the directory \"$file\".\nPermission denied."\
		-icon warning
	} else {
	    cd $appPWD
	    set data(selectPath) $file
	}
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428

1429

1430
1431
1432
1433
1434
1435
1436
1437
#	loop in tkFDialog and return the selected filename to the
#	script that calls tk_getOpenFile or tk_getSaveFile
#
proc tkFDialog_Done {w {selectFilePath ""}} {
    upvar #0 [winfo name $w] data
    global tkPriv

    if ![string compare $selectFilePath ""] {
	set selectFilePath [tkFDialog_JoinFile $data(selectPath) \
		$data(selectFile)]
	set tkPriv(selectFile)     $data(selectFile)
	set tkPriv(selectPath)     $data(selectPath)

	if {[file exists $selectFilePath] && 
	    ![string compare $data(type) save]} {

	    set reply [tk_messageBox -icon warning -type yesno -parent $data(-parent) \

	        -message "File \"$selectFilePath\" already exists.\nDo you want to overwrite it?"]

	    if ![string compare $reply "no"] {
		return
	    }
	}
    }
    set tkPriv(selectFilePath) $selectFilePath
}








|








|
>
|
>
|
|
|





1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
#	loop in tkFDialog and return the selected filename to the
#	script that calls tk_getOpenFile or tk_getSaveFile
#
proc tkFDialog_Done {w {selectFilePath ""}} {
    upvar #0 [winfo name $w] data
    global tkPriv

    if {![string compare $selectFilePath ""]} {
	set selectFilePath [tkFDialog_JoinFile $data(selectPath) \
		$data(selectFile)]
	set tkPriv(selectFile)     $data(selectFile)
	set tkPriv(selectPath)     $data(selectPath)

	if {[file exists $selectFilePath] && 
	    ![string compare $data(type) save]} {

		set reply [tk_messageBox -icon warning -type yesno\
			-parent $data(-parent) -message "File\
			\"$selectFilePath\" already exists.\nDo\
			you want to overwrite it?"]
		if {![string compare $reply "no"]} {
		    return
		}
	}
    }
    set tkPriv(selectFilePath) $selectFilePath
}

Changes to library/xmfbox.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
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
# xmfbox.tcl --
#
#	Implements the "Motif" style file selection dialog for the
#	Unix platform. This implementation is used only if the
#	"tk_strictMotif" flag is set.
#
# SCCS: @(#) xmfbox.tcl 1.6 97/10/01 15:06:07
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#


# tkMotifFDialog --
#
#	Implements a file dialog similar to the standard Motif file
#	selection box.
#
# Return value:


#

#	A list of two members. The first member is the absolute
#	pathname of the selected file or "" if user hits cancel. The
#	second member is the name of the selected file type, or ""
#	which stands for "default file type"
#
proc tkMotifFDialog {args} {
    global tkPriv
    set w __tk_filedialog
    upvar #0 $w data

    if ![string compare [lindex [info level 0] 0] tk_getOpenFile] {
	set type open
    } else {
	set type save
    }

    tkMotifFDialog_Config $w $type $args

    if {![string compare $data(-parent) .]} {
        set w .$w
    } else {
        set w $data(-parent).$w
    }

    # (re)create the dialog box if necessary
    #
    if {![winfo exists $w]} {
	tkMotifFDialog_Create $w
    } elseif {[string compare [winfo class $w] TkMotifFDialog]} {
	destroy $w
	tkMotifFDialog_Create $w
    }
    wm transient $w $data(-parent)

    tkMotifFDialog_Update $w

    # 5. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w
    wm title $w $data(-title)

    # 6. Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current $w]
    if {$oldGrab != ""} {
	set grabStatus [grab status $oldGrab]
    }
    grab $w
    focus $data(sEnt)
    $data(sEnt) select from 0
    $data(sEnt) select to   end

    # 7. Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

    tkwait variable tkPriv(selectFilePath)
    catch {focus $oldFocus}
    grab release $w
    wm withdraw $w
    if {$oldGrab != ""} {
	if {$grabStatus == "global"} {
	    grab -global $oldGrab
	} else {
	    grab $oldGrab
	}
    }
    return $tkPriv(selectFilePath)
}


















































































proc tkMotifFDialog_Config {w type argList} {
    upvar #0 $w data

    set data(type) $type

    # 1: the configuration specs
    #
    set specs {
	{-defaultextension "" "" ""}
	{-filetypes "" "" ""}
	{-initialdir "" "" ""}
	{-initialfile "" "" ""}
	{-parent "" "" "."}
	{-title "" "" ""}
    }

    # 2: default values depending on the type of the dialog
    #
    if ![info exists data(selectPath)] {
	# first time the dialog has been popped up
	set data(selectPath) [pwd]
	set data(selectFile) ""
    }

    # 3: parse the arguments
    #
    tclParseConfigSpec $w $specs "" $argList

    if ![string compare $data(-title) ""] {
	if ![string compare $type "open"] {
	    set data(-title) "Open"
	} else {
	    set data(-title) "Save As"
	}
    }

    # 4: set the default directory and selection according to the -initial
    #    settings
    #
    if [string compare $data(-initialdir) ""] {
	if [file isdirectory $data(-initialdir)] {
	    set data(selectPath) [glob $data(-initialdir)]
	} else {


	    error "\"$data(-initialdir)\" is not a valid directory"

	}




    }
    set data(selectFile) $data(-initialfile)

    # 5. Parse the -filetypes option. It is not used by the motif
    #    file dialog, but we check for validity of the value to make sure
    #    the application code also runs fine with the TK file dialog.
    #
    set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]

    if ![info exists data(filter)] {
	set data(filter) *
    }
    if ![winfo exists $data(-parent)] {
	error "bad window path name \"$data(-parent)\""
    }
}











proc tkMotifFDialog_Create {w} {
    set dataName [lindex [split $w .] end]
    upvar #0 $dataName data

    # 1: Create the dialog ...
    #
    toplevel $w -class TkMotifFDialog
    set top [frame $w.top -relief raised -bd 1]
    set bot [frame $w.bot -relief raised -bd 1]

    pack $w.bot -side bottom -fill x
    pack $w.top -side top -expand yes -fill both






|





<
<






|
>
>

>




|
|

|
|

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











|



















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
















|







|

|
|









|
|


>
>
|
>
|
>
>
>
>









|


|




>
>
>
>
>
>
>
>
>
>
|



|







1
2
3
4
5
6
7
8
9
10
11
12


13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

















34



35


















36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
# xmfbox.tcl --
#
#	Implements the "Motif" style file selection dialog for the
#	Unix platform. This implementation is used only if the
#	"tk_strictMotif" flag is set.
#
# RCS: @(#) $Id: xmfbox.tcl,v 1.1.4.4 1998/12/08 02:06:39 stanton Exp $
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.



# tkMotifFDialog --
#
#	Implements a file dialog similar to the standard Motif file
#	selection box.
#
# Arguments:
#	type		"open" or "save"
#	args		Options parsed by the procedure.
#
# Results:
#	A list of two members. The first member is the absolute
#	pathname of the selected file or "" if user hits cancel. The
#	second member is the name of the selected file type, or ""
#	which stands for "default file type"

proc tkMotifFDialog {type args} {
    global tkPriv
    set dataName __tk_filedialog
    upvar #0 $dataName data


















    set w [tkMotifFDialog_Create $dataName $type $args]






















    # Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current $w]
    if {$oldGrab != ""} {
	set grabStatus [grab status $oldGrab]
    }
    grab $w
    focus $data(sEnt)
    $data(sEnt) select from 0
    $data(sEnt) select to   end

    # Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

    tkwait variable tkPriv(selectFilePath)
    catch {focus $oldFocus}
    grab release $w
    wm withdraw $w
    if {$oldGrab != ""} {
	if {$grabStatus == "global"} {
	    grab -global $oldGrab
	} else {
	    grab $oldGrab
	}
    }
    return $tkPriv(selectFilePath)
}

# tkMotifFDialog_Create --
#
#	Creates the Motif file dialog (if it doesn't exist yet) and
#	initialize the internal data structure associated with the
#	dialog.
#
#	This procedure is used by tkMotifFDialog to create the
#	dialog. It's also used by the test suite to test the Motif
#	file dialog implementation. User code shouldn't call this
#	procedure directly.
#
# Arguments:
#	dataName	Name of the global "data" array for the file dialog.
#	type		"Save" or "Open"
#	argList		Options parsed by the procedure.
#
# Results:
#	Pathname of the file dialog.

proc tkMotifFDialog_Create {dataName type argList} {
    global tkPriv
    upvar #0 $dataName data

    tkMotifFDialog_Config $dataName $type $argList

    if {![string compare $data(-parent) .]} {
        set w .$dataName
    } else {
        set w $data(-parent).$dataName
    }

    # (re)create the dialog box if necessary
    #
    if {![winfo exists $w]} {
	tkMotifFDialog_BuildUI $w
    } elseif {[string compare [winfo class $w] TkMotifFDialog]} {
	destroy $w
	tkMotifFDialog_BuildUI $w
    } else {
	set data(fEnt) $w.top.f1.ent
	set data(dList) $w.top.f2.a.l
	set data(fList) $w.top.f2.b.l
	set data(sEnt) $w.top.f3.ent
	set data(okBtn) $w.bot.ok
	set data(filterBtn) $w.bot.filter
	set data(cancelBtn) $w.bot.cancel
    }

    wm transient $w $data(-parent)

    tkMotifFDialog_Update $w

    # Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w
    wm title $w $data(-title)

    return $w
}

# tkMotifFDialog_Config --
#
#	Iterates over the optional arguments to determine the option
#	values for the Motif file dialog; gives default values to
#	unspecified options.
#
# Arguments:
#	dataName	The name of the global variable in which
#			data for the file dialog is stored.
#	type		"Save" or "Open"
#	argList		Options parsed by the procedure.

proc tkMotifFDialog_Config {dataName type argList} {
    upvar #0 $dataName data

    set data(type) $type

    # 1: the configuration specs
    #
    set specs {
	{-defaultextension "" "" ""}
	{-filetypes "" "" ""}
	{-initialdir "" "" ""}
	{-initialfile "" "" ""}
	{-parent "" "" "."}
	{-title "" "" ""}
    }

    # 2: default values depending on the type of the dialog
    #
    if {![info exists data(selectPath)]} {
	# first time the dialog has been popped up
	set data(selectPath) [pwd]
	set data(selectFile) ""
    }

    # 3: parse the arguments
    #
    tclParseConfigSpec $dataName $specs "" $argList

    if {![string compare $data(-title) ""]} {
	if {![string compare $type "open"]} {
	    set data(-title) "Open"
	} else {
	    set data(-title) "Save As"
	}
    }

    # 4: set the default directory and selection according to the -initial
    #    settings
    #
    if {[string compare $data(-initialdir) ""]} {
	if {[file isdirectory $data(-initialdir)]} {
	    set data(selectPath) [glob $data(-initialdir)]
	} else {
	    set data(selectPath) [pwd]
	}

	# Convert the initialdir to an absolute path name.

	set old [pwd]
	cd $data(selectPath)
	set data(selectPath) [pwd]
	cd $old
    }
    set data(selectFile) $data(-initialfile)

    # 5. Parse the -filetypes option. It is not used by the motif
    #    file dialog, but we check for validity of the value to make sure
    #    the application code also runs fine with the TK file dialog.
    #
    set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]

    if {![info exists data(filter)]} {
	set data(filter) *
    }
    if {![winfo exists $data(-parent)]} {
	error "bad window path name \"$data(-parent)\""
    }
}

# tkMotifFDialog_BuildUI --
#
#	Builds the UI components of the Motif file dialog.
#
# Arguments:
# 	w		Pathname of the dialog to build.
#
# Results:
# 	None.

proc tkMotifFDialog_BuildUI {w} {
    set dataName [lindex [split $w .] end]
    upvar #0 $dataName data

    # Create the dialog toplevel and internal frames.
    #
    toplevel $w -class TkMotifFDialog
    set top [frame $w.top -relief raised -bd 1]
    set bot [frame $w.bot -relief raised -bd 1]

    pack $w.bot -side bottom -fill x
    pack $w.top -side top -expand yes -fill both
242
243
244
245
246
247
248















249
250
251
252
253
254
255
256

    bind $data(fEnt) <Return> "tkMotifFDialog_ActivateFEnt $w"
    bind $data(sEnt) <Return> "tkMotifFDialog_ActivateSEnt $w"

    wm protocol $w WM_DELETE_WINDOW "tkMotifFDialog_CancelCmd $w"
}
















proc tkMotifFDialog_MakeSList {w f label under cmd} {
    label $f.lab -text $label -under $under -anchor w
    listbox $f.l -width 12 -height 5 -selectmode browse -exportselection 0\
	-xscrollcommand "$f.h set" \
	-yscrollcommand "$f.v set" 
    scrollbar $f.v -orient vertical   -takefocus 0 \
	-command "$f.l yview"
    scrollbar $f.h -orient horizontal -takefocus 0 \







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







303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332

    bind $data(fEnt) <Return> "tkMotifFDialog_ActivateFEnt $w"
    bind $data(sEnt) <Return> "tkMotifFDialog_ActivateSEnt $w"

    wm protocol $w WM_DELETE_WINDOW "tkMotifFDialog_CancelCmd $w"
}

# tkMotifFDialog_MakeSList --
#
#	Create a scrolled-listbox and set the keyboard accelerator
#	bindings so that the list selection follows what the user
#	types.
#
# Arguments:
#	w		Pathname of the dialog box.
#	f		Frame widget inside which to create the scrolled
#			listbox. This frame widget already exists.
#	label		The string to display on top of the listbox.
#	under		Sets the -under option of the label.
#	cmdPrefix	Specifies procedures to call when the listbox is
#			browsed or activated.

proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} {
    label $f.lab -text $label -under $under -anchor w
    listbox $f.l -width 12 -height 5 -selectmode browse -exportselection 0\
	-xscrollcommand "$f.h set" \
	-yscrollcommand "$f.v set" 
    scrollbar $f.v -orient vertical   -takefocus 0 \
	-command "$f.l yview"
    scrollbar $f.h -orient horizontal -takefocus 0 \
264
265
266
267
268
269
270
271
272
273
274
275
276
277

278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406

407
408

409
410
411
412
413



414

415


416





417












418
419
420
421
422
423
424
425
426
427
428
429
430
















































































































































































































































































431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
    grid rowconfig    $f 0 -weight 0 -minsize 0
    grid rowconfig    $f 1 -weight 1 -minsize 0
    grid columnconfig $f 0 -weight 1 -minsize 0

    # bindings for the listboxes
    #
    set list $f.l
    bind $list <Up>        "tkMotifFDialog_Browse$cmd $w"
    bind $list <Down>      "tkMotifFDialog_Browse$cmd $w"
    bind $list <space>     "tkMotifFDialog_Browse$cmd $w"
    bind $list <1>         "tkMotifFDialog_Browse$cmd $w"
    bind $list <B1-Motion> "tkMotifFDialog_Browse$cmd $w"
    bind $list <Double-1>  "tkMotifFDialog_Activate$cmd $w"
    bind $list <Return>    "tkMotifFDialog_Browse$cmd $w; tkMotifFDialog_Activate$cmd $w"


    bindtags $list "Listbox $list [winfo toplevel $list] all"
    tkListBoxKeyAccel_Set $list

    return $f.l
}

proc tkMotifFDialog_BrowseDList {w} {
    upvar #0 [winfo name $w] data

    focus $data(dList)
    if ![string compare [$data(dList) curselection] ""] {
	return
    }
    set subdir [$data(dList) get [$data(dList) curselection]]
    if ![string compare $subdir ""] {
	return
    }

    $data(fList) selection clear 0 end

    set list [tkMotifFDialog_InterpFilter $w]
    set data(filter) [lindex $list 1]

    case $subdir {
	. {
	    set newSpec [file join $data(selectPath) $data(filter)]
	}
	.. {
	    set newSpec [file join [file dirname $data(selectPath)] \
		$data(filter)]
	}
	default {
	    set newSpec [file join $data(selectPath) $subdir $data(filter)]
	}
    }

    $data(fEnt) delete 0 end
    $data(fEnt) insert 0 $newSpec
}

proc tkMotifFDialog_ActivateDList {w} {
    upvar #0 [winfo name $w] data

    if ![string compare [$data(dList) curselection] ""] {
	return
    }
    set subdir [$data(dList) get [$data(dList) curselection]]
    if ![string compare $subdir ""] {
	return
    }

    $data(fList) selection clear 0 end

    case $subdir {
	. {
	    set newDir $data(selectPath)
	}
	.. {
	    set newDir [file dirname $data(selectPath)]
	}
	default {
	    set newDir [file join $data(selectPath) $subdir]
	}
    }

    set data(selectPath) $newDir
    tkMotifFDialog_Update $w

    if [string compare $subdir ..] {
	$data(dList) selection set 0
	$data(dList) activate 0
    } else {
	$data(dList) selection set 1
	$data(dList) activate 1
    }
}

proc tkMotifFDialog_BrowseFList {w} {
    upvar #0 [winfo name $w] data

    focus $data(fList)
    if ![string compare [$data(fList) curselection] ""] {
	return
    }
    set data(selectFile) [$data(fList) get [$data(fList) curselection]]
    if ![string compare $data(selectFile) ""] {
	return
    }

    $data(dList) selection clear 0 end

    $data(fEnt) delete 0 end
    $data(fEnt) insert 0 [file join $data(selectPath) $data(filter)]
    $data(fEnt) xview end
 
    $data(sEnt) delete 0 end
    $data(sEnt) insert 0 [file join $data(selectPath) $data(selectFile)]
    $data(sEnt) xview end
}

proc tkMotifFDialog_ActivateFList {w} {
    upvar #0 [winfo name $w] data

    if ![string compare [$data(fList) curselection] ""] {
	return
    }
    set data(selectFile) [$data(fList) get [$data(fList) curselection]]
    if ![string compare $data(selectFile) ""] {
	return
    } else {
	tkMotifFDialog_ActivateSEnt $w
    }
}

proc tkMotifFDialog_ActivateFEnt {w} {
    upvar #0 [winfo name $w] data

    set list [tkMotifFDialog_InterpFilter $w]
    set data(selectPath) [lindex $list 0]
    set data(filter)    [lindex $list 1]

    tkMotifFDialog_Update $w
}

proc tkMotifFDialog_InterpFilter {w} {
    upvar #0 [winfo name $w] data

    set text [string trim [$data(fEnt) get]]

    # Perform tilde substitution
    #

    if ![string compare [string index $text 0] ~] {
	set list [file split $text]
	set tilde [lindex $list 0]
	catch {
	    set tilde [glob $tilde]



	}

	set text [eval file join [concat $tilde [lrange $list 1 end]]]


    }


















    set resolved [file join [file dirname $text] [file tail $text]]

    if [file isdirectory $resolved] {
	set dir $resolved
	set fil $data(filter)
    } else {
	set dir [file dirname $resolved]
	set fil [file tail    $resolved]
    }

    return [list $dir $fil]
}


















































































































































































































































































proc tkMotifFDialog_ActivateSEnt {w} {
    global tkPriv
    upvar #0 [winfo name $w] data

    set selectFilePath [string trim [$data(sEnt) get]]
    set selectFile     [file tail    $selectFilePath]
    set selectPath     [file dirname $selectFilePath]


    if {![string compare $selectFilePath ""]} {
	tkMotifFDialog_FilterCmd $w
	return
    }

    if {[file isdirectory $selectFilePath]} {
	set data(selectPath) [glob $selectFilePath]
	set data(selectFile) ""
	tkMotifFDialog_Update $w
	return
    }

    if [string compare [file pathtype $selectFilePath] "absolute"] {
	tk_messageBox -icon warning -type ok \
	    -message "\"$selectFilePath\" must be an absolute pathname"
	return
    }

    if ![file exists $selectPath] {
	tk_messageBox -icon warning -type ok \
	    -message "Directory \"$selectPath\" does not exist."
	return
    }

    if ![file exists $selectFilePath] {
	if ![string compare $data(type) open] {
	    tk_messageBox -icon warning -type ok \
		-message "File \"$selectFilePath\" does not exist."
	    return
	}
    } else {
	if ![string compare $data(type) save] {
	    set message [format %s%s \
		"File \"$selectFilePath\" already exists.\n\n" \
		"Replace existing file?"]
	    set answer [tk_messageBox -icon warning -type yesno \
		-message $message]
	    if ![string compare $answer "no"] {
		return
	    }
	}
    }

    set tkPriv(selectFilePath) $selectFilePath
    set tkPriv(selectFile)     $selectFile







|
|
|
|
|
|
|
>







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





>


>
|


<
|
>
>
>

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












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








<













|





|





|
|





|





|







340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361














362

363












364



365


366







367













368


369








370


371








372

373



374




375























376
377
378
379
380
381
382
383
384
385
386
387

388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708

709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
    grid rowconfig    $f 0 -weight 0 -minsize 0
    grid rowconfig    $f 1 -weight 1 -minsize 0
    grid columnconfig $f 0 -weight 1 -minsize 0

    # bindings for the listboxes
    #
    set list $f.l
    bind $list <Up>        "tkMotifFDialog_Browse$cmdPrefix $w"
    bind $list <Down>      "tkMotifFDialog_Browse$cmdPrefix $w"
    bind $list <space>     "tkMotifFDialog_Browse$cmdPrefix $w"
    bind $list <1>         "tkMotifFDialog_Browse$cmdPrefix $w"
    bind $list <B1-Motion> "tkMotifFDialog_Browse$cmdPrefix $w"
    bind $list <Double-ButtonRelease-1> "tkMotifFDialog_Activate$cmdPrefix $w"
    bind $list <Return>    "tkMotifFDialog_Browse$cmdPrefix $w; \
	    tkMotifFDialog_Activate$cmdPrefix $w"

    bindtags $list "Listbox $list [winfo toplevel $list] all"
    tkListBoxKeyAccel_Set $list

    return $f.l
}















# tkMotifFDialog_InterpFilter --

#












#	Interpret the string in the filter entry into two components:



#	the directory and the pattern. If the string is a relative


#	pathname, give a warning to the user and restore the pattern







#	to original.













#


# Arguments:








#	w		pathname of the dialog box.


#








# Results:

# 	A list of two elements. The first element is the directory



# 	specified # by the filter. The second element is the filter




# 	pattern itself.
























proc tkMotifFDialog_InterpFilter {w} {
    upvar #0 [winfo name $w] data

    set text [string trim [$data(fEnt) get]]

    # Perform tilde substitution
    #
    set badTilde 0
    if {[string compare [string index $text 0] ~] == 0} {
	set list [file split $text]
	set tilde [lindex $list 0]

	if [catch {set tilde [glob $tilde]}] {
	    set badTilde 1
	} else {
	    set text [eval file join [concat $tilde [lrange $list 1 end]]]
	}
    }

    # If the string is a relative pathname, combine it
    # with the current selectPath.

    set relative 0
    if {[file pathtype $text] == "relative"} {
	set relative 1
    } elseif {$badTilde} {
	set relative 1	
    }

    if {$relative} {
	tk_messageBox -icon warning -type ok \
	    -message "\"$text\" must be an absolute pathname"

	$data(fEnt) delete 0 end
	$data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \
		$data(filter)]

	return [list $data(selectPath) $data(filter)]
    }

    set resolved [tkFDialog_JoinFile [file dirname $text] [file tail $text]]

    if [file isdirectory $resolved] {
	set dir $resolved
	set fil $data(filter)
    } else {
	set dir [file dirname $resolved]
	set fil [file tail    $resolved]
    }

    return [list $dir $fil]
}

# tkMotifFDialog_Update
#
#	Load the files and synchronize the "filter" and "selection" fields
#	boxes.
#
# Arguments:
# 	w 		pathname of the dialog box.
#
# Results:
#	None.

proc tkMotifFDialog_Update {w} {
    upvar #0 [winfo name $w] data

    $data(fEnt) delete 0 end
    $data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) $data(filter)]
    $data(sEnt) delete 0 end
    $data(sEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \
	    $data(selectFile)]
 
    tkMotifFDialog_LoadFiles $w
}

# tkMotifFDialog_LoadFiles --
#
#	Loads the files and directories into the two listboxes according
#	to the filter setting.
#
# Arguments:
# 	w 		pathname of the dialog box.
#
# Results:
#	None.

proc tkMotifFDialog_LoadFiles {w} {
    upvar #0 [winfo name $w] data

    $data(dList) delete 0 end
    $data(fList) delete 0 end

    set appPWD [pwd]
    if [catch {
	cd $data(selectPath)
    }] {
	cd $appPWD

	$data(dList) insert end ".."
	return
    }

    # Make the dir list
    #
    foreach f [lsort -dictionary [glob -nocomplain .* *]] {
	if [file isdir ./$f] {
	    $data(dList) insert end $f
	}
    }
    # Make the file list
    #
    if ![string compare $data(filter) *] {
	set files [lsort -dictionary [glob -nocomplain .* *]]
    } else {
	set files [lsort -dictionary \
	    [glob -nocomplain $data(filter)]]
    }

    set top 0
    foreach f $files {
	if ![file isdir ./$f] {
	    regsub {^[.]/} $f "" f
	    $data(fList) insert end $f
	    if [string match .* $f] {
		incr top
	    }
	}
    }

    # The user probably doesn't want to see the . files. We adjust the view
    # so that the listbox displays all the non-dot files
    $data(fList) yview $top

    cd $appPWD
}

# tkMotifFDialog_BrowseFList --
#
#	This procedure is called when the directory list is browsed
#	(clicked-over) by the user.
#
# Arguments:
# 	w		The pathname of the dialog box.
#
# Results:
#	None.	

proc tkMotifFDialog_BrowseDList {w} {
    upvar #0 [winfo name $w] data

    focus $data(dList)
    if {![string compare [$data(dList) curselection] ""]} {
	return
    }
    set subdir [$data(dList) get [$data(dList) curselection]]
    if {![string compare $subdir ""]} {
	return
    }

    $data(fList) selection clear 0 end

    set list [tkMotifFDialog_InterpFilter $w]
    set data(filter) [lindex $list 1]

    switch -- $subdir {
	. {
	    set newSpec [tkFDialog_JoinFile $data(selectPath) $data(filter)]
	}
	.. {
	    set newSpec [tkFDialog_JoinFile [file dirname $data(selectPath)] \
		$data(filter)]
	}
	default {
	    set newSpec [tkFDialog_JoinFile [tkFDialog_JoinFile \
		    $data(selectPath) $subdir] $data(filter)]
	}
    }

    $data(fEnt) delete 0 end
    $data(fEnt) insert 0 $newSpec
}

# tkMotifFDialog_ActivateDList --
#
#	This procedure is called when the directory list is activated
#	(double-clicked) by the user.
#
# Arguments:
# 	w		The pathname of the dialog box.
#
# Results:
#	None.	

proc tkMotifFDialog_ActivateDList {w} {
    upvar #0 [winfo name $w] data

    if {![string compare [$data(dList) curselection] ""]} {
	return
    }
    set subdir [$data(dList) get [$data(dList) curselection]]
    if {![string compare $subdir ""]} {
	return
    }

    $data(fList) selection clear 0 end

    switch -- $subdir {
	. {
	    set newDir $data(selectPath)
	}
	.. {
	    set newDir [file dirname $data(selectPath)]
	}
	default {
	    set newDir [tkFDialog_JoinFile $data(selectPath) $subdir]
	}
    }

    set data(selectPath) $newDir
    tkMotifFDialog_Update $w

    if {[string compare $subdir ..]} {
	$data(dList) selection set 0
	$data(dList) activate 0
    } else {
	$data(dList) selection set 1
	$data(dList) activate 1
    }
}

# tkMotifFDialog_BrowseFList --
#
#	This procedure is called when the file list is browsed
#	(clicked-over) by the user.
#
# Arguments:
# 	w		The pathname of the dialog box.
#
# Results:
#	None.	

proc tkMotifFDialog_BrowseFList {w} {
    upvar #0 [winfo name $w] data

    focus $data(fList)
    if {![string compare [$data(fList) curselection] ""]} {
	return
    }
    set data(selectFile) [$data(fList) get [$data(fList) curselection]]
    if {![string compare $data(selectFile) ""]} {
	return
    }

    $data(dList) selection clear 0 end

    $data(fEnt) delete 0 end
    $data(fEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) $data(filter)]
    $data(fEnt) xview end
 
    $data(sEnt) delete 0 end
    $data(sEnt) insert 0 [tkFDialog_JoinFile $data(selectPath) \
	    $data(selectFile)]
    $data(sEnt) xview end
}

# tkMotifFDialog_ActivateFList --
#
#	This procedure is called when the file list is activated
#	(double-clicked) by the user.
#
# Arguments:
# 	w		The pathname of the dialog box.
#
# Results:
#	None.	

proc tkMotifFDialog_ActivateFList {w} {
    upvar #0 [winfo name $w] data

    if {![string compare [$data(fList) curselection] ""]} {
	return
    }
    set data(selectFile) [$data(fList) get [$data(fList) curselection]]
    if {![string compare $data(selectFile) ""]} {
	return
    } else {
	tkMotifFDialog_ActivateSEnt $w
    }
}

# tkMotifFDialog_ActivateFEnt --
#
#	This procedure is called when the user presses Return inside
#	the "filter" entry. It updates the dialog according to the
#	text inside the filter entry.
#
# Arguments:
# 	w		The pathname of the dialog box.
#
# Results:
#	None.	

proc tkMotifFDialog_ActivateFEnt {w} {
    upvar #0 [winfo name $w] data

    set list [tkMotifFDialog_InterpFilter $w]
    set data(selectPath) [lindex $list 0]
    set data(filter)    [lindex $list 1]

    tkMotifFDialog_Update $w
}

# tkMotifFDialog_ActivateSEnt --
#
#	This procedure is called when the user presses Return inside
#	the "selection" entry. It sets the tkPriv(selectFilePath) global
#	variable so that the vwait loop in tkMotifFDialog will be
#	terminated.
#
# Arguments:
# 	w		The pathname of the dialog box.
#
# Results:
#	None.	

proc tkMotifFDialog_ActivateSEnt {w} {
    global tkPriv
    upvar #0 [winfo name $w] data

    set selectFilePath [string trim [$data(sEnt) get]]
    set selectFile     [file tail    $selectFilePath]
    set selectPath     [file dirname $selectFilePath]


    if {![string compare $selectFilePath ""]} {
	tkMotifFDialog_FilterCmd $w
	return
    }

    if {[file isdirectory $selectFilePath]} {
	set data(selectPath) [glob $selectFilePath]
	set data(selectFile) ""
	tkMotifFDialog_Update $w
	return
    }

    if {[string compare [file pathtype $selectFilePath] "absolute"]} {
	tk_messageBox -icon warning -type ok \
	    -message "\"$selectFilePath\" must be an absolute pathname"
	return
    }

    if {![file exists $selectPath]} {
	tk_messageBox -icon warning -type ok \
	    -message "Directory \"$selectPath\" does not exist."
	return
    }

    if {![file exists $selectFilePath]} {
	if {![string compare $data(type) open]} {
	    tk_messageBox -icon warning -type ok \
		-message "File \"$selectFilePath\" does not exist."
	    return
	}
    } else {
	if {![string compare $data(type) save]} {
	    set message [format %s%s \
		"File \"$selectFilePath\" already exists.\n\n" \
		"Replace existing file?"]
	    set answer [tk_messageBox -icon warning -type yesno \
		-message $message]
	    if {![string compare $answer "no"]} {
		return
	    }
	}
    }

    set tkPriv(selectFilePath) $selectFilePath
    set tkPriv(selectFile)     $selectFile
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591














592
593
594
595
596
597
598
    global tkPriv

    set tkPriv(selectFilePath) ""
    set tkPriv(selectFile)     ""
    set tkPriv(selectPath)     ""
}

# tkMotifFDialog_Update
#
#	Load the files and synchronize the "filter" and "selection" fields
#	boxes.
#
# popup:
#	If this is true, then update the selection field according to the
#	"-selection" flag
#
proc tkMotifFDialog_Update {w} {
    upvar #0 [winfo name $w] data

    $data(fEnt) delete 0 end
    $data(fEnt) insert 0 [file join $data(selectPath) $data(filter)]
    $data(sEnt) delete 0 end
    $data(sEnt) insert 0 [file join $data(selectPath) $data(selectFile)]
 
    tkMotifFDialog_LoadFiles $w
}

proc tkMotifFDialog_LoadFiles {w} {
    upvar #0 [winfo name $w] data

    $data(dList) delete 0 end
    $data(fList) delete 0 end

    set appPWD [pwd]
    if [catch {
	cd $data(selectPath)
    }] {
	cd $appPWD

	$data(dList) insert end ".."
	return
    }

    # Make the dir list
    #
    foreach f [lsort -command tclSortNoCase [glob -nocomplain .* *]] {
	if [file isdir $f] {
	    $data(dList) insert end $f
	}
    }
    # Make the file list
    #
    if ![string compare $data(filter) *] {
	set files [lsort -command tclSortNoCase [glob -nocomplain .* *]]
    } else {
	set files [lsort -command tclSortNoCase \
	    [glob -nocomplain $data(filter)]]
    }

    set top 0
    foreach f $files {
	if ![file isdir $f] {
	    $data(fList) insert end $f
	    if [string match .* $f] {
		incr top
	    }
	}
    }

    # The user probably doesn't want to see the . files. We adjust the view
    # so that the listbox displays all the non-dot files
    $data(fList) yview $top

    cd $appPWD
}

proc tkListBoxKeyAccel_Set {w} {
    bind Listbox <Any-KeyPress> ""
    bind $w <Destroy> "tkListBoxKeyAccel_Unset $w"
    bind $w <Any-KeyPress> "tkListBoxKeyAccel_Key $w %A"
}

proc tkListBoxKeyAccel_Unset {w} {
    global tkPriv

    catch {after cancel $tkPriv(lbAccel,$w,afterId)}
    catch {unset tkPriv(lbAccel,$w)}
    catch {unset tkPriv(lbAccel,$w,afterId)}
}















proc tkListBoxKeyAccel_Key {w key} {
    global tkPriv

    append tkPriv(lbAccel,$w) $key
    tkListBoxKeyAccel_Goto $w $tkPriv(lbAccel,$w)
    catch {







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













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







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
    global tkPriv

    set tkPriv(selectFilePath) ""
    set tkPriv(selectFile)     ""
    set tkPriv(selectPath)     ""
}






































































proc tkListBoxKeyAccel_Set {w} {
    bind Listbox <Any-KeyPress> ""
    bind $w <Destroy> "tkListBoxKeyAccel_Unset $w"
    bind $w <Any-KeyPress> "tkListBoxKeyAccel_Key $w %A"
}

proc tkListBoxKeyAccel_Unset {w} {
    global tkPriv

    catch {after cancel $tkPriv(lbAccel,$w,afterId)}
    catch {unset tkPriv(lbAccel,$w)}
    catch {unset tkPriv(lbAccel,$w,afterId)}
}

# tkListBoxKeyAccel_Key--
#
#	This procedure maintains a list of recently entered keystrokes
#	over a listbox widget. It arranges an idle event to move the
#	selection of the listbox to the entry that begins with the
#	keystrokes.
#
# Arguments:
# 	w		The pathname of the listbox.
#	key		The key which the user just pressed.
#
# Results:
#	None.	

proc tkListBoxKeyAccel_Key {w key} {
    global tkPriv

    append tkPriv(lbAccel,$w) $key
    tkListBoxKeyAccel_Goto $w $tkPriv(lbAccel,$w)
    catch {

Changes to mac/MW_TkHeader.pch.

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
 *  compiler flags.  See MetroWerks documention for more details.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS:  @(#) MW_TkHeader.pch 1.26 97/11/20 19:37:29
 */

/*
 * To use the compilied header you need to set the "Prefix file" in
 * the "C/C++ Language" preference panel to point to the created
 * compilied header.  The name of the header depends on the
 * architecture we are compiling for (see the code below).  For
 * example, for a 68k app the prefix file should be: MW_TclHeader68K.
 */

#if __POWERPC__
#pragma precompile_target "MW_TkHeaderPPC"
#elif __CFM68K__
#pragma precompile_target "MW_TkHeaderCFM68K"
#else
#pragma precompile_target "MW_TkHeader68K"
#endif

/*
 * Macintosh Tcl must be compiled with certain compiler options to
 * ensure that it will work correctly.  The following pragmas are 
 * used to ensure that those options are set correctly.  An error
 * will occur at compile time if they are not set correctly.
 */

#if !__option(enumsalwaysint)
#error Tcl requires the Metrowerks setting "Enums always ints".
#endif

#if !defined(__POWERPC__)
#if !__option(far_data)
#error Tcl requires the Metrowerks setting "Far data".
#endif
#endif

#if !defined(__POWERPC__)
#if !__option(fourbyteints)
#error Tcl requires the Metrowerks setting "4 byte ints".
#endif
#endif

#if !defined(__POWERPC__)
#if !__option(IEEEdoubles)
#error Tcl requires the Metrowerks setting "8 byte doubles".
#endif
#endif

/*
 * The define is used most everywhere to tell Tk (or any Tk
 * extensions) that we are compiling for the Macintosh platform.
 */
#define MAC_TCL

/*
 * The following defines are for the Xlib.h file to force 
 * it to generate prototypes in the way we need it.  This is
 * defined here in case X.h & company are ever included before
 * tk.h.
 */

#define NeedFunctionPrototypes 1
#define NeedWidePrototypes 0

/*
 * The following defines control the behavior of the Macintosh
 * Universial Headers.
 */

#define SystemSevenOrLater 1
#define STRICT_CONTROLS 0
#define STRICT_WINDOWS  0

/*
 * The appearance manager has not yet been shiped by Apple (10/29/97).
 * It's currently in beta testing which is why we were able to write
 * some code that depends on it.  If you have access to the appearance
 * manager you can define the symbol HAVE_APPEARANCE below to compile
 * the code that uses the new appearance manager.
 */

/* #define HAVE_APPEARANCE 1 */

/*
 * Define the following symbol if you want
 * comprehensive debugging turned on.
 */

/* #define TCL_DEBUG */

#ifdef TCL_DEBUG
#   define TCL_MEM_DEBUG
#   define TK_TEST
#   define TCL_TEST
#endif

/*
 * Apple's Universal Headers 2.0 & 3.0 change alot of names and constants.
 * We will switch to the new names as soon as we can be reasonably sure the
 * number of people with older versions of CodeWarrior, who will then not be
 * able to build Tcl/Tk, is negligible.
 */
 
#define OLDROUTINENAMES 1

/*
 * Place any includes below that will are needed by the majority of the
 * and is OK to be in any file in the system.
 */

#include <tcl.h>
#pragma export on
#include "tk.h"
#include "tkInt.h"
#pragma export off







|


















<
<
<
<
<
<
|
<
<
<

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

<
<
<
<
<
<
<











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










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
 *  compiler flags.  See MetroWerks documention for more details.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: MW_TkHeader.pch,v 1.1.4.3 1998/11/25 21:16:35 stanton Exp $
 */

/*
 * To use the compilied header you need to set the "Prefix file" in
 * the "C/C++ Language" preference panel to point to the created
 * compilied header.  The name of the header depends on the
 * architecture we are compiling for (see the code below).  For
 * example, for a 68k app the prefix file should be: MW_TclHeader68K.
 */

#if __POWERPC__
#pragma precompile_target "MW_TkHeaderPPC"
#elif __CFM68K__
#pragma precompile_target "MW_TkHeaderCFM68K"
#else
#pragma precompile_target "MW_TkHeader68K"
#endif







#include "tclMacCommonPch.h"









#ifdef TCL_DEBUG





    #define TK_TEST



#endif








/*
 * The following defines are for the Xlib.h file to force 
 * it to generate prototypes in the way we need it.  This is
 * defined here in case X.h & company are ever included before
 * tk.h.
 */

#define NeedFunctionPrototypes 1
#define NeedWidePrototypes 0










































/*
 * Place any includes below that will are needed by the majority of the
 * and is OK to be in any file in the system.
 */

#include <tcl.h>
#pragma export on
#include "tk.h"
#include "tkInt.h"
#pragma export off

Changes to mac/README.

1
2
3
4
5




6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
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
Tk 8.0 for Macintosh

by Ray Johnson
Sun Microsystems Laboratories
rjohnson@eng.sun.com





SCCS: @(#) README 1.30 97/11/20 22:06:57

1. Introduction
---------------

This is the README file for the Macintosh version of the Tk
extension for the Tcl scripting language.  The file consists of
information specific to the Macintosh version of Tcl and Tk.  For more
general information please read the README file in the main Tk
directory.

2. What's new?
-------------

Native Look & Feel!!!  We now try really hard to support the 
Macintosh Look & Feel with Tcl/Tk 8.0.  We aren't finished but
it look pretty good.  Let me know what are the most "un-mac like"
problems and I'll fix them as quickly as I can.

The button, checkbutton, radiobutton, and scrollbar widgets actually
use the Mac toolbox controls.  This means that they will track the
look&feel if you use extension that change the appearance of
applications (like Aaron.)  We also use "system" colors so the default
backgrounds etc. will also change colors.  We plan to support this
feature - so let me know if something doesn't work quite right.
Unfortunantly, we are not able to change the colors of buttons under
MacOS 8.  We are working on a solution to this.  
In the meantime, if you really must have colored buttons, turn off the 
"System-wide platinum appearance" option in the Appearance Control Panel,
and you will get the System 7, colorable, buttons back.

We also now support native menus!  By using the new -menu option
on toplevels you can have a menubar that is cross platform.  You
can also place Tk menus in the Apple and Help menus!  Check out
the documentation for more details.  Syd Polk <[email protected]> is
the author of the new menu code.  Feel free to contact him if you
have questions or comments about the menu mechanism.

The "tk_messageBox" command on the Macintosh is now much more
mac-like.  I'll probably still need to adjust this more - but it
looks a hell of alot better than it did before.

I've also added a command that allows you to get more native window
styles.  However, we have yet to decide on a cross platform solution
to the problem of varying window styles.  None the less, I thought
it would be use full to add the capability in an unsupported means
to tide you over until a better solution is available.  The command
is called "unsupported1".  It can be used in the following way:

	toplevel .foo; unsupported1 style .foo zoomDocProc

The above command will create a document window with a zoom box.
Type "unsupported1 style . ???" to get a list of the supported
styles.  The command works like "wm overrideredirect" - you must
make the call before the window is mapped.

As always - report the bugs you find - including asthetic ones
in the look & feel of widgets.

3. Mac specific features
------------------------

There are several features or enhancements in Tk that are unique to 
the Macintosh version of Tk.  Here is a list of those features and
pointers to where you can find more information about the feature.
|


|
|
>
>
>
>

|













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

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







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
Tk 8.1 for Macintosh

by Ray Johnson
Scriptics Corporation
rjohnson@scriptics.com
with major help from
Jim Ingham
Cygnus Solutions
[email protected]

RCS: @(#) $Id: README,v 1.1.4.4 1998/12/04 07:21:21 welch Exp $

1. Introduction
---------------

This is the README file for the Macintosh version of the Tk
extension for the Tcl scripting language.  The file consists of
information specific to the Macintosh version of Tcl and Tk.  For more
general information please read the README file in the main Tk
directory.

2. What's new?
-------------





All the widgets will now display internationalized text!


















The widget configuration package has been changed to support the new object



model introduced with the 8.0 compiler.  For now the old configuration






package is retained, and in fact, only the menu and button widgets use

the new package.








3. Mac specific features
------------------------

There are several features or enhancements in Tk that are unique to 
the Macintosh version of Tk.  Here is a list of those features and
pointers to where you can find more information about the feature.
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
  toplevel windows on the Macintosh.  It is not really supported.
  See below for details.

* In addition to the standard built-in bitmaps that Tk supports, the
  Mac version of Tk allows you to use several Mac specific icons.  See
  the GetBitmap.3 man page for a complete list.

* The send command does not yet work on the Macintosh.  We hope to
  have it available in Tk 8.1.

* The -use and -container options almost work. The focus bugs that
  were in Tk8.0 final have been fixed.  But there are still some
  known bugs that cause some major problems.  Be careful, if you
  decide to use these features.  (See bugs.doc for details.)

4. The Distribution
-------------------

Macintosh Tk is distributed in three different forms.  This 
should make it easier to only download what you need.  The 
packages are as follows:

mactk8.0.sea.hqx

    This distribution is a "binary" only release.  It contains an
    installer program that will install a 68k, PowerPC, or Fat
    version of the "Wish" application.  In addition, in installs
    the Tcl & Tk libraries in the Extensions folder inside your
    System Folder.  (No "INIT"'s or Control Pannels are installed.)

mactcltk-full-8.0.sea.hqx

    This release contains the full release of Tcl and Tk for the
    Macintosh plus the More Files package on which Macintosh Tcl and
    Tk rely.

mactk-source-8.0.sea.hqx

    This release contains the complete source to Tk for the Macintosh
    In addition, Metrowerks CodeWarrior libraries and project files
    are included.  However, you must already have the More Files
    package to compile this code.

5. Documentation
----------------

Two books are currently available for Tcl.  Both provide a good
introduction to the language.  It is a good way to get started
if you haven't used the language before:

    Title:			Tcl and the Tk Toolkit
    Author:			John K. Ousterhout
    Publisher:			Addison-Wesley
    ISBN:			0-201-63337-X

    Title:			Practical Programming in Tcl and Tk
    Author:			Brent Welch
    Publisher:			Prentice Hall
    ISBN:			0-13-182007-9




The "doc" subdirectory contains reference in documentation
in the "man" format found on most UNIX machines.  Unfortunately,
there is not a suitable way to view these pages on the Macintosh.  
A version suitable for viewing on the Macintosh has yet to be
developed.  We are working are having better documentation for
the Macintosh platform in the future.  However, if you have WWW 
access you may access the Man pages at the following URL:

	http://sunscript.sun.com/man/tcl8.0/contents.html

Other documentation and sample Tcl scripts can be found at
the Tcl ftp site: 

	ftp://ftp.neosoft.com/tcl/

The internet news group comp.lang.tcl is also a valuable
source of information about Tcl.  A mailing list is also
available (see below).

6. Compiling Tk
---------------

In order to compile Macintosh Tk you must have the 
following items:

	CodeWarrior Pro 1 or higher (CodeWarrior release 9 or higher can work
		and we have project files, but we are depricating support)
	Mac Tcl 8.0 (source)
	  (which requires More Files 1.4.2 or 1.4.3)
	Mac Tk 8.0 (source)

The project  files included with the Mac Tcl source should work 
fine.  The only thing you may need to update are the access paths.
As with Tcl, there is something in the initial release of the CW Pro 2
linker that rendersthe CFM68K version of Wish very unstable.  I am
working with Metrowerks to resolve the issue.

Special notes:

* Check out the file bugs.doc for information about known bugs.

* We are starting to support the new Appearance Manager that shipped
  with MacOS 8.  At this point, the only feature that we are using is 
  the API to Iconify windows (so that wm iconify will work).   However,
  as of the release of Tk8.0p1, the SDK from Apple is still in Beta, so 
  we cannot ship it.  So support for the Appearance Manager is turned off
  in the source version of Tk8.0p1.
  If you want to build Tk, and want to get the Appearance Manager features, 

  then need to do the following:
      1) get the SDK from Apple


      2) Uncomment the #define HAVE_APPEARANCE line in tk8.0:mac:MW_TkHeader.pch
      3) Add the Appearance.lib to tk8.0:mac:TkShells.�, and put the include 
         directory of the SDK on your path in this project, and TkLibraries.�.

7. About Dialog
---------------

There is now a way to replace the default dialog box for the Wish
application.  If you create the tcl procedure "tkAboutDialog" it will
be called instead of creating the default dialog box.  Your procedure
is then responsible for displaying a window, removing it, etc.  This
interface is experimental and may change in the future - tell me what
you think of it.

8. Apple Events
---------------

Tcl/Tk currently doesn't have much in the way of support for Mac
Apple Events.  There is no way to send an apple event (although you
could write an extension to do this) and no general purpose way to







|
|













|







|





|









|













>
>
>








|
















|
<
|

|



|
|
<






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




|
|
|
<
<
|







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
  toplevel windows on the Macintosh.  It is not really supported.
  See below for details.

* In addition to the standard built-in bitmaps that Tk supports, the
  Mac version of Tk allows you to use several Mac specific icons.  See
  the GetBitmap.3 man page for a complete list.

* The send command works among interpreters in the same application.  We hope to
  have the complete implementation available in Tk 8.1.

* The -use and -container options almost work. The focus bugs that
  were in Tk8.0 final have been fixed.  But there are still some
  known bugs that cause some major problems.  Be careful, if you
  decide to use these features.  (See bugs.doc for details.)

4. The Distribution
-------------------

Macintosh Tk is distributed in three different forms.  This 
should make it easier to only download what you need.  The 
packages are as follows:

mactk8.1.sea.hqx

    This distribution is a "binary" only release.  It contains an
    installer program that will install a 68k, PowerPC, or Fat
    version of the "Wish" application.  In addition, in installs
    the Tcl & Tk libraries in the Extensions folder inside your
    System Folder.  (No "INIT"'s or Control Pannels are installed.)

mactcltk-full-8.1.sea.hqx

    This release contains the full release of Tcl and Tk for the
    Macintosh plus the More Files package on which Macintosh Tcl and
    Tk rely.

mactk-source-8.1.sea.hqx

    This release contains the complete source to Tk for the Macintosh
    In addition, Metrowerks CodeWarrior libraries and project files
    are included.  However, you must already have the More Files
    package to compile this code.

5. Documentation
----------------

There are now many books available for Tcl.  These two provide a good
introduction to the language.  It is a good way to get started
if you haven't used the language before:

    Title:			Tcl and the Tk Toolkit
    Author:			John K. Ousterhout
    Publisher:			Addison-Wesley
    ISBN:			0-201-63337-X

    Title:			Practical Programming in Tcl and Tk
    Author:			Brent Welch
    Publisher:			Prentice Hall
    ISBN:			0-13-182007-9

More books are listed at
    http://www.scriptics.com/resource/doc/books/

The "doc" subdirectory contains reference in documentation
in the "man" format found on most UNIX machines.  Unfortunately,
there is not a suitable way to view these pages on the Macintosh.  
A version suitable for viewing on the Macintosh has yet to be
developed.  We are working are having better documentation for
the Macintosh platform in the future.  However, if you have WWW 
access you may access the Man pages at the following URL:

	http://www.scriptics.com/man/tcl8.1/contents.html

Other documentation and sample Tcl scripts can be found at
the Tcl ftp site: 

	ftp://ftp.neosoft.com/tcl/

The internet news group comp.lang.tcl is also a valuable
source of information about Tcl.  A mailing list is also
available (see below).

6. Compiling Tk
---------------

In order to compile Macintosh Tk you must have the 
following items:

	CodeWarrior Pro 3 or higher

	Mac Tcl 8.1 (source)
	  (which requires More Files 1.4.2 or 1.4.3)
	Mac Tk 8.1 (source)

The project  files included with the Mac Tcl source should work 
fine.  The only thing you may need to update are the access paths.
As with Tcl, you need to upgrade to the 2.0.1 version of the C
compilers or later to build the CFM68K version of Tcl/Tk.


Special notes:

* Check out the file bugs.doc for information about known bugs.

* We are starting to support the new Appearance Manager that shipped
  with MacOS 8.0.  The Tk 8.0.3 release is the first Tk release


  that supports the Appearance Manager well.  Tk 8.0.4 extends this support

  to the menu system, though you have to have Appearance 1.0.1 or later
  installed for this to work.
  
* If you get the Unix tar file, it will untar into a directory tcl8.0.4.  However,
  the Macintosh project files expect the folder to be called tcl8.0.  You will need
  to rename the folder to tcl8.0, or change all the paths in the project files.




7. About Dialog
---------------

The prefered method for replacing the about dialog is to replace the
main menubar of the application, using the -menu option for the "."
window.  Then add a cascade called .mainMenu.apple to your mainMenu,


and you can put an about item in here WITH YOUR OWN LABEL!

8. Apple Events
---------------

Tcl/Tk currently doesn't have much in the way of support for Mac
Apple Events.  There is no way to send an apple event (although you
could write an extension to do this) and no general purpose way to
292
293
294
295
296
297
298
299






NOTE: this is an unsupported command and it WILL go away in the
future.


If you have comments or Bug reports send them to:
Jim Ingham
jingham@eng.sun.com












|
>
>
>
>
>
255
256
257
258
259
260
261
262
263
264
265
266
267

NOTE: this is an unsupported command and it WILL go away in the
future.


If you have comments or Bug reports send them to:
Jim Ingham
jingham@cygnus.com

or use our on-line bug form at

http://www.scriptics.com/support/bugForm.html

Changes to mac/bugs.doc.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Known bug list for Tk 8.0 for Macintosh

by Ray Johnson
Sun Microsystems Laboratories
[email protected]

SCCS: @(#) bugs.doc 1.10 97/11/03 17:16:00

We are now very close to passing the test suite for Tk.  We are very
interested in finding remaining bugs that still linger.  Please let us
know (and send us test cases) of any bugs you find.

Known bugs:







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
Known bug list for Tk 8.0 for Macintosh

by Ray Johnson
Sun Microsystems Laboratories
[email protected]

RCS: @(#) $Id: bugs.doc,v 1.1.4.3 1998/11/25 21:16:35 stanton Exp $

We are now very close to passing the test suite for Tk.  We are very
interested in finding remaining bugs that still linger.  Please let us
know (and send us test cases) of any bugs you find.

Known bugs:

22
23
24
25
26
27
28
29




30
31
32
33





34
35
36
37
38
39
40
  the same process.  Also, if you try really hard (for instance by binding 
  on Destroy of an embedded window and destroying the container's toplevel) 
  you can get Tk to crash.  This should never be necessary, however, since
  the destruction of the embedded window triggers the destruction of the
  container, so you can watch that instead.
  All the focus bugs in Tk8.0 have been fixed, however.
  
* The send command is not yet implemented.





* Drawing is not really correct.  This shows up mostly in the canvas
  when line widths are greater than one.  Unfortunantly, this will not
  be easy to fix.






There are many other bugs.  However, will no get listed until they
are reported at least once.  Send those bug reports in!



Ray







|
>
>
>
>




>
>
>
>
>







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
  the same process.  Also, if you try really hard (for instance by binding 
  on Destroy of an embedded window and destroying the container's toplevel) 
  you can get Tk to crash.  This should never be necessary, however, since
  the destruction of the embedded window triggers the destruction of the
  container, so you can watch that instead.
  All the focus bugs in Tk8.0 have been fixed, however.
  
* The send command is only implemented within the same app.

* You cannot color buttons, and the indicators for radiobuttons and
  checkbuttons under Appearance.  They will always use the current
  Theme color.  But, then, you are not supposed to...

* Drawing is not really correct.  This shows up mostly in the canvas
  when line widths are greater than one.  Unfortunantly, this will not
  be easy to fix.
  
* The active menu highlight color in Tearoff menus will not match the system-wide
  menu highlight color under Appearance.  It will be black instead.  This is not
  easy to fix, since the Appearance API's don't really allow you to get your hands
  on this information...

There are many other bugs.  However, will no get listed until they
are reported at least once.  Send those bug reports in!



Ray

Changes to mac/tclets.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
# tclets.tcl --
#
# Drag & Drop Tclets
# by Ray Johnson
#
# A simple way to create Tcl applications.  This applications will copy a droped Tcl file
# into a copy of a stub application (the user can pick).  The file is placed into the
# TEXT resource named "tclshrc" which is automatically executed on startup.
#
# SCCS: @(#) tclets.tcl 1.2 97/08/15 09:25:56
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
# tclets.tcl --
#
# Drag & Drop Tclets
# by Ray Johnson
#
# A simple way to create Tcl applications.  This applications will copy a droped Tcl file
# into a copy of a stub application (the user can pick).  The file is placed into the
# TEXT resource named "tclshrc" which is automatically executed on startup.
#
# RCS: @(#) $Id: tclets.tcl,v 1.1.4.1 1998/09/30 02:18:00 stanton Exp $
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

Changes to mac/tkMac.h.

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
/*
 * tkMacInt.h --
 *
 *	Declarations of Macintosh specific exported variables and procedures.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacInt.h 1.58 97/05/06 16:45:18
 */

#ifndef _TKMAC
#define _TKMAC

#include <Windows.h>



/*
 * "export" is a MetroWerks specific pragma.  It flags the linker that  
 * any symbols that are defined when this pragma is on will be exported 
 * to shared libraries that link with this library.
 */
 
#pragma export on

/*
 * This variable is exported and can be used by extensions.  It is the
 * way Tk extensions should access the QD Globals.  This is so Tk
 * can support embedding itself in another window. 
 */

EXTERN QDGlobalsPtr tcl_macQdPtr;

/* 
 * The following functions are needed to create a shell, and so they must be exported
 * from the Tk library.  However, these are not the final form of these interfaces, so
 * they are not currently supported as public interfaces.
 */





 
/*
 * These functions are currently in tkMacInt.h.  They are just copied over here
 * so they can be exported.
 */

EXTERN void 	TkMacInitMenus _ANSI_ARGS_((Tcl_Interp 	*interp));
EXTERN void		TkMacInitAppleEvents _ANSI_ARGS_((Tcl_Interp *interp));

EXTERN int		TkMacConvertEvent _ANSI_ARGS_((EventRecord *eventPtr));

#pragma export reset

#endif /* _TKMAC */










|






>
>

















|
|
|
<

>
>
>
>
>
|





<
<
<
<




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
/*
 * tkMacInt.h --
 *
 *	Declarations of Macintosh specific exported variables and procedures.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMac.h,v 1.1.4.3 1999/03/10 07:13:48 stanton Exp $
 */

#ifndef _TKMAC
#define _TKMAC

#include <Windows.h>
#include <QDOffscreen.h>
#include "tkInt.h"

/*
 * "export" is a MetroWerks specific pragma.  It flags the linker that  
 * any symbols that are defined when this pragma is on will be exported 
 * to shared libraries that link with this library.
 */
 
#pragma export on

/*
 * This variable is exported and can be used by extensions.  It is the
 * way Tk extensions should access the QD Globals.  This is so Tk
 * can support embedding itself in another window. 
 */

EXTERN QDGlobalsPtr tcl_macQdPtr;

/*
 * Structures and function types for handling Netscape-type in process
 * embedding where Tk does not control the top-level

 */
typedef  int (Tk_MacEmbedRegisterWinProc) (int winID, Tk_Window window);
typedef GWorldPtr (Tk_MacEmbedGetGrafPortProc) (Tk_Window window); 
typedef int (Tk_MacEmbedMakeContainerExistProc) (Tk_Window window); 
typedef void (Tk_MacEmbedGetClipProc) (Tk_Window window, RgnHandle rgn); 
typedef void (Tk_MacEmbedGetOffsetInParentProc) (Tk_Window window, Point *ulCorner);

/*
 * These functions are currently in tkMacInt.h.  They are just copied over here
 * so they can be exported.
 */






#pragma export reset

#endif /* _TKMAC */

Changes to mac/tkMacAppInit.c.

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
/* 
 * tkMacAppInit.c --
 *
 *	Provides a version of the Tcl_AppInit procedure for the example shell.
 *
 * Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacAppInit.c 1.35 97/07/28 11:18:55
 */

#include <Gestalt.h>
#include <ToolUtils.h>
#include <Fonts.h>
#include <Dialogs.h>
#include <SegLoad.h>
#include <Traps.h>


#include "tk.h"
#include "tkInt.h"
#include "tkMacInt.h"
#include "tclMac.h"

#ifdef TK_TEST
EXTERN int		Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#endif /* TK_TEST */

#ifdef TCL_TEST


EXTERN int		TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int		Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#endif /* TCL_TEST */

Tcl_Interp *gStdoutInterp = NULL;

int 	TkMacConvertEvent _ANSI_ARGS_((EventRecord *eventPtr));

/*











|








>







|



>
>
|
|







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
/* 
 * tkMacAppInit.c --
 *
 *	Provides a version of the Tcl_AppInit procedure for the example shell.
 *
 * Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacAppInit.c,v 1.1.4.5 1999/03/10 07:13:48 stanton Exp $
 */

#include <Gestalt.h>
#include <ToolUtils.h>
#include <Fonts.h>
#include <Dialogs.h>
#include <SegLoad.h>
#include <Traps.h>
#include <Appearance.h>

#include "tk.h"
#include "tkInt.h"
#include "tkMacInt.h"
#include "tclMac.h"

#ifdef TK_TEST
extern int		Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#endif /* TK_TEST */

#ifdef TCL_TEST
extern int		Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
extern int		Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
extern int		TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
extern int		Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#endif /* TCL_TEST */

Tcl_Interp *gStdoutInterp = NULL;

int 	TkMacConvertEvent _ANSI_ARGS_((EventRecord *eventPtr));

/*
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
 *
 *	This procedure performs application-specific initialization.
 *	Most applications, especially those that incorporate additional
 *	packages, will have their own version of this procedure.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error
 *	message in interp->result if an error occurs.
 *
 * Side effects:
 *	Depends on the startup script.
 *
 *----------------------------------------------------------------------
 */








|







107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
 *
 *	This procedure performs application-specific initialization.
 *	Most applications, especially those that incorporate additional
 *	packages, will have their own version of this procedure.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error
 *	message in the interp's result if an error occurs.
 *
 * Side effects:
 *	Depends on the startup script.
 *
 *----------------------------------------------------------------------
 */

144
145
146
147
148
149
150





151
152
153
154
155
156
157
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
            (Tcl_PackageInitProc *) NULL);
    if (TclObjTest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }





#endif /* TCL_TEST */

#ifdef TK_TEST
    if (Tktest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tktest", Tktest_Init,







>
>
>
>
>







147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
            (Tcl_PackageInitProc *) NULL);
    if (TclObjTest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (Procbodytest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
            Procbodytest_SafeInit);
#endif /* TCL_TEST */

#ifdef TK_TEST
    if (Tktest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
216
217
218
219
220
221
222











223
224
225
226
227
228
229

    /*
     * Tk needs us to set the qd pointer it uses.  This is needed
     * so Tk doesn't have to assume the availablity of the qd global
     * variable.  Which in turn allows Tk to be used in code resources.
     */
    tcl_macQdPtr = &qd;












    InitGraf(&tcl_macQdPtr->thePort);
    InitFonts();
    InitWindows();
    InitMenus();
    InitDialogs((long) NULL);		
    InitCursor();







>
>
>
>
>
>
>
>
>
>
>







224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248

    /*
     * Tk needs us to set the qd pointer it uses.  This is needed
     * so Tk doesn't have to assume the availablity of the qd global
     * variable.  Which in turn allows Tk to be used in code resources.
     */
    tcl_macQdPtr = &qd;

    /*
     * If appearance is present, then register Tk as an Appearance client
     * This means that the mapping from non-Appearance to Appearance cdefs
     * will be done for Tk regardless of the setting in the Appearance
     * control panel.  
     */
     
     if (TkMacHaveAppearance()) {
         RegisterAppearanceClient();
     }

    InitGraf(&tcl_macQdPtr->thePort);
    InitFonts();
    InitWindows();
    InitMenus();
    InitDialogs((long) NULL);		
    InitCursor();
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265

    
    FlushEvents(everyEvent, 0);
    SetEventMask(everyEvent);


    Tcl_MacSetEventProc(TkMacConvertEvent);
    TkConsoleCreate();

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







<







270
271
272
273
274
275
276

277
278
279
280
281
282
283

    
    FlushEvents(everyEvent, 0);
    SetEventMask(everyEvent);


    Tcl_MacSetEventProc(TkMacConvertEvent);


    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
     */

    gStdoutInterp = interp;

    return TCL_OK;

error:
    panic(interp->result);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * InstallConsole, RemoveConsole, etc. --







|







321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
     */

    gStdoutInterp = interp;

    return TCL_OK;

error:
    panic(Tcl_GetStringResult(interp));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * InstallConsole, RemoveConsole, etc. --

Changes to mac/tkMacApplication.r.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkMacApplication.r --
 *
 *	This file creates resources for use in the Wish application.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacApplication.r 1.3 97/11/03 17:16:24
 */

#include <Types.r>
#include <SysTypes.r>
#include <AEUserTermTypes.r>

/*










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkMacApplication.r --
 *
 *	This file creates resources for use in the Wish application.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacApplication.r,v 1.1.4.1 1998/09/30 02:18:01 stanton Exp $
 */

#include <Types.r>
#include <SysTypes.r>
#include <AEUserTermTypes.r>

/*

Changes to mac/tkMacBitmap.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkMacBitmap.c --
 *
 *	This file handles the implementation of native bitmaps.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacBitmap.c 1.4 96/12/13 11:13:16
 */

#include "tkPort.h"
#include "tk.h"
#include "tkMacInt.h"

#include <Icons.h>





|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkMacBitmap.c --
 *
 *	This file handles the implementation of native bitmaps.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacBitmap.c,v 1.1.4.3 1998/12/13 08:16:12 lfb Exp $
 */

#include "tkPort.h"
#include "tk.h"
#include "tkMacInt.h"

#include <Icons.h>
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
 *
 * TkpDefineNativeBitmaps --
 *
 *	Add native bitmaps.
 *
 * Results:
 *	A standard Tcl result.  If an error occurs then TCL_ERROR is
 *	returned and a message is left in interp->result.
 *
 * Side effects:
 *	"Name" is entered into the bitmap table and may be used from
 *	here on to refer to the given bitmap.
 *
 *----------------------------------------------------------------------
 */

void
TkpDefineNativeBitmaps()
{
    int new;
    Tcl_HashEntry *predefHashPtr;
    TkPredefBitmap *predefPtr;
    char * name;
    BuiltInIcon *builtInPtr;
    NativeIcon *nativeIconPtr;



    
    for (builtInPtr = builtInIcons; builtInPtr->name != NULL; builtInPtr++) {
	name = Tk_GetUid(builtInPtr->name);

	predefHashPtr = Tcl_CreateHashEntry(&tkPredefBitmapTable, name, &new);
	if (!new) {
	    continue;
	}
	predefPtr = (TkPredefBitmap *) ckalloc(sizeof(TkPredefBitmap));
	nativeIconPtr = (NativeIcon *) ckalloc(sizeof(NativeIcon));
	nativeIconPtr->id = builtInPtr->id;
	nativeIconPtr->type = builtInPtr->type;







|

















>
>
>



>
|







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
 *
 * TkpDefineNativeBitmaps --
 *
 *	Add native bitmaps.
 *
 * Results:
 *	A standard Tcl result.  If an error occurs then TCL_ERROR is
 *	returned and a message is left in the interp's result.
 *
 * Side effects:
 *	"Name" is entered into the bitmap table and may be used from
 *	here on to refer to the given bitmap.
 *
 *----------------------------------------------------------------------
 */

void
TkpDefineNativeBitmaps()
{
    int new;
    Tcl_HashEntry *predefHashPtr;
    TkPredefBitmap *predefPtr;
    char * name;
    BuiltInIcon *builtInPtr;
    NativeIcon *nativeIconPtr;
    Tcl_HashTable *tablePtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    
    for (builtInPtr = builtInIcons; builtInPtr->name != NULL; builtInPtr++) {
	name = Tk_GetUid(builtInPtr->name);
	tablePtr = TkGetBitmapPredefTable();
	predefHashPtr = Tcl_CreateHashEntry(tablePtr, name, &new);
	if (!new) {
	    continue;
	}
	predefPtr = (TkPredefBitmap *) ckalloc(sizeof(TkPredefBitmap));
	nativeIconPtr = (NativeIcon *) ckalloc(sizeof(NativeIcon));
	nativeIconPtr->id = builtInPtr->id;
	nativeIconPtr->type = builtInPtr->type;
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
 *
 * TkpCreateNativeBitmap --
 *
 *	Add native bitmaps.
 *
 * Results:
 *	A standard Tcl result.  If an error occurs then TCL_ERROR is
 *	returned and a message is left in interp->result.
 *
 * Side effects:
 *	"Name" is entered into the bitmap table and may be used from
 *	here on to refer to the given bitmap.
 *
 *----------------------------------------------------------------------
 */







|







128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
 *
 * TkpCreateNativeBitmap --
 *
 *	Add native bitmaps.
 *
 * Results:
 *	A standard Tcl result.  If an error occurs then TCL_ERROR is
 *	returned and a message is left in the interp's result.
 *
 * Side effects:
 *	"Name" is entered into the bitmap table and may be used from
 *	here on to refer to the given bitmap.
 *
 *----------------------------------------------------------------------
 */
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
 *
 * TkpGetNativeAppBitmap --
 *
 *	Add native bitmaps.
 *
 * Results:
 *	A standard Tcl result.  If an error occurs then TCL_ERROR is
 *	returned and a message is left in interp->result.
 *
 * Side effects:
 *	"Name" is entered into the bitmap table and may be used from
 *	here on to refer to the given bitmap.
 *
 *----------------------------------------------------------------------
 */







|







188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
 *
 * TkpGetNativeAppBitmap --
 *
 *	Add native bitmaps.
 *
 * Results:
 *	A standard Tcl result.  If an error occurs then TCL_ERROR is
 *	returned and a message is left in the interp's result.
 *
 * Side effects:
 *	"Name" is entered into the bitmap table and may be used from
 *	here on to refer to the given bitmap.
 *
 *----------------------------------------------------------------------
 */
206
207
208
209
210
211
212
213

214





215




216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
{
    Pixmap pix;
    CGrafPtr saveWorld;
    GDHandle saveDevice;
    GWorldPtr destPort;
    Rect destRect;
    Handle resource;
    int type;







    c2pstr(name);




    resource = GetNamedResource('cicn', (StringPtr) name);
    if (resource != NULL) {
	type = TYPE3;
    } else {
	resource = GetNamedResource('ICON', (StringPtr) name);
	if (resource != NULL) {
	    type = TYPE2;
	}
    }
    p2cstr((StringPtr) name);
    
    if (resource == NULL) {
	return NULL;
    }
    
    pix = Tk_GetPixmap(display, None, 32, 32, 0);
    destPort = TkMacGetDrawablePort(pix);







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



|




<







210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238

239
240
241
242
243
244
245
{
    Pixmap pix;
    CGrafPtr saveWorld;
    GDHandle saveDevice;
    GWorldPtr destPort;
    Rect destRect;
    Handle resource;
    int type, destWrote;
    Str255 nativeName;
    
    /*
     * macRoman is the encoding that the resource fork uses.
     */

    Tcl_UtfToExternal(NULL, Tcl_GetEncoding(NULL, "macRoman"), name,
	    strlen(name), 0, NULL, 
	    (char *) &nativeName[1],
	    255, NULL, &destWrote, NULL); /* Internalize native */
    nativeName[0] = destWrote;

    resource = GetNamedResource('cicn', nativeName);
    if (resource != NULL) {
	type = TYPE3;
    } else {
	resource = GetNamedResource('ICON', nativeName);
	if (resource != NULL) {
	    type = TYPE2;
	}
    }

    
    if (resource == NULL) {
	return NULL;
    }
    
    pix = Tk_GetPixmap(display, None, 32, 32, 0);
    destPort = TkMacGetDrawablePort(pix);

Changes to mac/tkMacButton.c.

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
/* 
 * tkMacButton.c --
 *
 *	This file implements the Macintosh specific portion of the
 *	button widgets.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacButton.c 1.18 97/11/20 18:27:21
 */

#include "tkButton.h"
#include "tkMacInt.h"
#include <Controls.h>
#include <LowMem.h>





/*
 * Some defines used to control what type of control is drawn.
 */

#define DRAW_LABEL	0		/* Labels are treated genericly. */
#define DRAW_CONTROL	1		/* Draw using the Native control. */
#define DRAW_CUSTOM	2		/* Make our own button drawing. */


/*
 * The following structures are used to draw our controls.  Rather than
 * having many Mac controls we just use one control of each type and
 * reuse them for all Tk widgets.  When the windowRef variable is NULL
 * it means none of the data structures have been allocated.
 */

static WindowRef windowRef = NULL;
static CWindowRecord windowRecord;
static ControlRef buttonHandle;
static ControlRef checkHandle;
static ControlRef radioHandle;















static CCTabHandle buttonTabHandle;
static CCTabHandle checkTabHandle;
static CCTabHandle radioTabHandle;
static PixMapHandle oldPixPtr;

/*


















 * Forward declarations for procedures defined later in this file:
 */

static int		UpdateControlColors _ANSI_ARGS_((TkButton *butPtr,
			    ControlRef controlHandle, CCTabHandle ccTabHandle,
			    RGBColor *saveColorPtr));
static void		DrawBufferedControl _ANSI_ARGS_((TkButton *butPtr,
			    GWorldPtr destPort));




static void		ChangeBackgroundWindowColor _ANSI_ARGS_((
			    WindowRef macintoshWindow, RGBColor rgbColor,
			    RGBColor *oldColor));
static void		ButtonExitProc _ANSI_ARGS_((ClientData clientData));

/*
 * The class procedure table for the button widgets.
 */

TkClassProcs tkpButtonProcs = { 
    NULL,			/* createProc. */











|






>
>
>
>








>













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






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



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







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
/* 
 * tkMacButton.c --
 *
 *	This file implements the Macintosh specific portion of the
 *	button widgets.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacButton.c,v 1.1.4.2 1998/09/30 02:18:02 stanton Exp $
 */

#include "tkButton.h"
#include "tkMacInt.h"
#include <Controls.h>
#include <LowMem.h>
#include <Appearance.h>


#include <ToolUtils.h>

/*
 * Some defines used to control what type of control is drawn.
 */

#define DRAW_LABEL	0		/* Labels are treated genericly. */
#define DRAW_CONTROL	1		/* Draw using the Native control. */
#define DRAW_CUSTOM	2		/* Make our own button drawing. */
#define DRAW_BEVEL	3

/*
 * The following structures are used to draw our controls.  Rather than
 * having many Mac controls we just use one control of each type and
 * reuse them for all Tk widgets.  When the windowRef variable is NULL
 * it means none of the data structures have been allocated.
 */

static WindowRef windowRef = NULL;
static CWindowRecord windowRecord;
static ControlRef buttonHandle;
static ControlRef checkHandle;
static ControlRef radioHandle;
static ControlRef smallBevelHandle;
static ControlRef smallStickyBevelHandle;
static ControlRef medBevelHandle;
static ControlRef medStickyBevelHandle;
static ControlRef largeBevelHandle;
static ControlRef largeStickyBevelHandle;

/*
 * These are used to store the image content for
 * beveled buttons - i.e. buttons with images.
 */
 
static ControlButtonContentInfo bevelButtonContent;
static OpenCPicParams picParams;

static CCTabHandle buttonTabHandle;
static CCTabHandle checkTabHandle;
static CCTabHandle radioTabHandle;
static PixMapHandle oldPixPtr;

/*
 * These functions are used when Appearance is present.
 * By embedding all our controls in a userPane control,
 * we can color the background of the text in radiobuttons
 * and checkbuttons.  Thanks to Peter Gontier of Apple DTS
 * for help on this one.
 */

static ControlRef userPaneHandle;
static RGBColor gUserPaneBackground = { ~0, ~0, ~0};
static pascal OSErr SetUserPaneDrawProc(ControlRef control,
	ControlUserPaneDrawProcPtr upp);
static pascal OSErr SetUserPaneSetUpSpecialBackgroundProc(ControlRef control,
	ControlUserPaneBackgroundProcPtr upp);
static pascal void UserPaneDraw(ControlRef control, ControlPartCode cpc);
static pascal void UserPaneBackgroundProc(ControlHandle,
	ControlBackgroundPtr info);

/*
 * Forward declarations for procedures defined later in this file:
 */

static int	UpdateControlColors _ANSI_ARGS_((TkButton *butPtr,
	ControlRef controlHandle, CCTabHandle ccTabHandle,
	RGBColor *saveColorPtr));
static void	DrawBufferedControl _ANSI_ARGS_((TkButton *butPtr,
	GWorldPtr destPort, GC gc, Pixmap pixmap));
static void	InitSampleControls();
static void	SetupBevelButton _ANSI_ARGS_((TkButton *butPtr,
	ControlRef controlHandle, 
	GWorldPtr destPort, GC gc, Pixmap pixmap));
static void	ChangeBackgroundWindowColor _ANSI_ARGS_((
    WindowRef macintoshWindow, RGBColor rgbColor,
    RGBColor *oldColor));
static void	ButtonExitProc _ANSI_ARGS_((ClientData clientData));

/*
 * The class procedure table for the button widgets.
 */

TkClassProcs tkpButtonProcs = { 
    NULL,			/* createProc. */
120
121
122
123
124
125
126

127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175













































176
177
178
179
180
181
182















183

184
185



186


187


188
189
190












191
192
193
194
195
196
197
198
199
200
201
202

203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220


221
222


223
224
225
226
227
228
229
230
    int y, relief;
    register Tk_Window tkwin = butPtr->tkwin;
    int width, height;
    int offset;			/* 0 means this is a normal widget.  1 means
				 * it is an image button, so we offset the
				 * image to make the button appear to move
				 * up and down as the relief changes. */

    CGrafPtr saveWorld;
    GDHandle saveDevice;
    GWorldPtr destPort;
    int drawType, borderWidth;
    
    GetGWorld(&saveWorld, &saveDevice);

    butPtr->flags &= ~REDRAW_PENDING;
    if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
	return;
    }

    border = butPtr->normalBorder;
    if ((butPtr->state == tkDisabledUid) && (butPtr->disabledFg != NULL)) {
	gc = butPtr->disabledGC;
    } else if ((butPtr->type == TYPE_BUTTON) && (butPtr->state == tkActiveUid)) {
	gc = butPtr->activeTextGC;
	border = butPtr->activeBorder;
    } else {
	gc = butPtr->normalTextGC;
    }
    if ((butPtr->flags & SELECTED) && (butPtr->state != tkActiveUid)
	    && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) {
	border = butPtr->selectBorder;
    }

    /*
     * Override the relief specified for the button if this is a
     * checkbutton or radiobutton and there's no indicator.
     */

    relief = butPtr->relief;
    if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) {
	relief = (butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN
		: TK_RELIEF_RAISED;
    }

    offset = ((butPtr->type == TYPE_BUTTON) && 
	((butPtr->image != NULL) || (butPtr->bitmap != None)));

    /*
     * In order to avoid screen flashes, this procedure redraws
     * the button in a pixmap, then copies the pixmap to the
     * screen in a single operation.  This means that there's no
     * point in time where the on-sreen image has been cleared.
     */

    pixmap = Tk_GetPixmap(butPtr->display, Tk_WindowId(tkwin),
	    Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));













































    Tk_Fill3DRectangle(tkwin, pixmap, butPtr->normalBorder, 0, 0,
	    Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);

   
    if (butPtr->type == TYPE_LABEL) {
	drawType = DRAW_LABEL;
    } else if (butPtr->type == TYPE_BUTTON) {















	if ((butPtr->image == None) && (butPtr->bitmap == None)) {

	    drawType = DRAW_CONTROL;
	} else {



	    drawType = DRAW_CUSTOM;


	}


    } else {
	if (butPtr->indicatorOn) {
	    drawType = DRAW_CONTROL;












	} else {
	    drawType = DRAW_CUSTOM;
	}
    }

    /*
     * Draw the native portion of the buttons.  Start by creating the control
     * if it doesn't already exist.  Then configure the Macintosh control from
     * the Tk info.  Finally, we call Draw1Control to draw to the screen.
     */

    if (drawType == DRAW_CONTROL) {

	borderWidth = 0;
	
	/*
	 * This part uses Macintosh rather than Tk calls to draw
	 * to the screen.  Make sure the ports etc. are set correctly.
	 */
	
	destPort = TkMacGetDrawablePort(pixmap);
	SetGWorld(destPort, NULL);
	DrawBufferedControl(butPtr, destPort);
    }

    if ((drawType == DRAW_CUSTOM) || (drawType == DRAW_LABEL)) {
	borderWidth = butPtr->borderWidth;
    }

    /*
     * Display image or bitmap or text for button.


     */



    if (butPtr->image != None) {
	Tk_SizeOfImage(butPtr->image, &width, &height);

	imageOrBitmap:
	TkComputeAnchor(butPtr->anchor, tkwin, 0, 0,
		butPtr->indicatorSpace + width, height, &x, &y);
	x += butPtr->indicatorSpace;








>












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









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




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



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






|




|
>









|







|
>
>


>
>
|







162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181




























182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
    int y, relief;
    register Tk_Window tkwin = butPtr->tkwin;
    int width, height;
    int offset;			/* 0 means this is a normal widget.  1 means
				 * it is an image button, so we offset the
				 * image to make the button appear to move
				 * up and down as the relief changes. */
    int hasImageOrBitmap;
    CGrafPtr saveWorld;
    GDHandle saveDevice;
    GWorldPtr destPort;
    int drawType, borderWidth;
    
    GetGWorld(&saveWorld, &saveDevice);

    butPtr->flags &= ~REDRAW_PENDING;
    if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
	return;
    }





























    /*
     * In order to avoid screen flashes, this procedure redraws
     * the button in a pixmap, then copies the pixmap to the
     * screen in a single operation.  This means that there's no
     * point in time where the on-sreen image has been cleared.
     */

    pixmap = Tk_GetPixmap(butPtr->display, Tk_WindowId(tkwin),
	    Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));

    hasImageOrBitmap = ((butPtr->image != NULL) || (butPtr->bitmap != None));
    offset = (butPtr->type == TYPE_BUTTON) && hasImageOrBitmap;

    border = butPtr->normalBorder;
    if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) {
	gc = butPtr->disabledGC;
    } else if ((butPtr->type == TYPE_BUTTON)
	    && (butPtr->state == STATE_ACTIVE)) {
	gc = butPtr->activeTextGC;
	border = butPtr->activeBorder;
    } else {
	gc = butPtr->normalTextGC;
    }
    
    if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE)
	    && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) {
	border = butPtr->selectBorder;
    }

    /*
     * Override the relief specified for the button if this is a
     * checkbutton or radiobutton and there's no indicator.
     * However, don't do this in the presence of Appearance, since
     * then the bevel button will take care of the relief.
     */

    relief = butPtr->relief;

    if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) { 
	if (!TkMacHaveAppearance() || !hasImageOrBitmap) {
	    relief = (butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN
		: TK_RELIEF_RAISED;
	}
    }

    /*
     * See the comment in UpdateControlColors as to why we use the 
     * highlightbackground for the border of Macintosh buttons.
     */
     
    if (butPtr->type == TYPE_BUTTON) {
	Tk_Fill3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0, 0,
		Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
    } else {
	Tk_Fill3DRectangle(tkwin, pixmap, butPtr->normalBorder, 0, 0,
		Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
    }
   
    if (butPtr->type == TYPE_LABEL) {
	drawType = DRAW_LABEL;
    } else if (butPtr->type == TYPE_BUTTON) {
	if (!hasImageOrBitmap) {
	    drawType = DRAW_CONTROL;
	} else if (butPtr->image != None) {
	    drawType = DRAW_BEVEL;
	} else {
	    /*
	     * TO DO - The current way the we draw bitmaps (XCopyPlane)
	     * uses CopyDeepMask in this one case.  The Picture recording 
	     * does not record this call, and so we can't use the
	     * Appearance bevel button here.  The only case that would
	     * exercise this is if you use a bitmap, with
	     * -data & -mask specified.	 We should probably draw the 
	     * appearance button and overprint the image in this case.
	     * This just punts and draws the old-style, ugly, button.
	     */
	     
	    if (gc->clip_mask == 0) {
		drawType = DRAW_BEVEL;
	    } else {
		TkpClipMask *clipPtr = (TkpClipMask*) gc->clip_mask;
		if ((clipPtr->type == TKP_CLIP_PIXMAP) &&
			(clipPtr->value.pixmap != butPtr->bitmap)) {
		    drawType = DRAW_CUSTOM;
		} else {
		    drawType = DRAW_BEVEL;
		}
	    }
	}
    } else {
	if (butPtr->indicatorOn) {
	    drawType = DRAW_CONTROL;
	} else if (hasImageOrBitmap) {
	    if (gc->clip_mask == 0) {
		drawType = DRAW_BEVEL;
	    } else {
		TkpClipMask *clipPtr = (TkpClipMask*) gc->clip_mask;
		if ((clipPtr->type == TKP_CLIP_PIXMAP) &&
			(clipPtr->value.pixmap != butPtr->bitmap)) {
		    drawType = DRAW_CUSTOM;
		} else {
		    drawType = DRAW_BEVEL;
		}
	    }
	} else {
	    drawType = DRAW_CUSTOM;
	}
    }

    /*
     * Draw the native portion of the buttons.	Start by creating the control
     * if it doesn't already exist.  Then configure the Macintosh control from
     * the Tk info.  Finally, we call Draw1Control to draw to the screen.
     */

    if ((drawType == DRAW_CONTROL) || 
	    ((drawType == DRAW_BEVEL) && TkMacHaveAppearance())) {
	borderWidth = 0;
	
	/*
	 * This part uses Macintosh rather than Tk calls to draw
	 * to the screen.  Make sure the ports etc. are set correctly.
	 */
	
	destPort = TkMacGetDrawablePort(pixmap);
	SetGWorld(destPort, NULL);
	DrawBufferedControl(butPtr, destPort, gc, pixmap);
    }

    if ((drawType == DRAW_CUSTOM) || (drawType == DRAW_LABEL)) {
	borderWidth = butPtr->borderWidth;
    }

    /*
     * Display image or bitmap or text for button.  This has
     * already been done under Appearance with the Bevel
     * button types.
     */

    if ((drawType == DRAW_BEVEL) && TkMacHaveAppearance()) {
	/* Empty Body */
    } else if (butPtr->image != None) {
	Tk_SizeOfImage(butPtr->image, &width, &height);

	imageOrBitmap:
	TkComputeAnchor(butPtr->anchor, tkwin, 0, 0,
		butPtr->indicatorSpace + width, height, &x, &y);
	x += butPtr->indicatorSpace;

265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
	Tk_DrawTextLayout(butPtr->display, pixmap, gc, butPtr->textLayout,
		x, y, 0, -1);
	y += butPtr->textHeight/2;
    }

    /*
     * If the button is disabled with a stipple rather than a special
     * foreground color, generate the stippled effect.  If the widget
     * is selected and we use a different background color when selected,
     * must temporarily modify the GC.
     */

    if ((butPtr->state == tkDisabledUid)
	    && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
	if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
		&& (butPtr->selectBorder != NULL)) {
	    XSetForeground(butPtr->display, butPtr->disabledGC,
		    Tk_3DBorderColor(butPtr->selectBorder)->pixel);
	}
	XFillRectangle(butPtr->display, pixmap, butPtr->disabledGC,







|




|







365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
	Tk_DrawTextLayout(butPtr->display, pixmap, gc, butPtr->textLayout,
		x, y, 0, -1);
	y += butPtr->textHeight/2;
    }

    /*
     * If the button is disabled with a stipple rather than a special
     * foreground color, generate the stippled effect.	If the widget
     * is selected and we use a different background color when selected,
     * must temporarily modify the GC.
     */

    if ((butPtr->state == STATE_DISABLED)
	    && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
	if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
		&& (butPtr->selectBorder != NULL)) {
	    XSetForeground(butPtr->display, butPtr->disabledGC,
		    Tk_3DBorderColor(butPtr->selectBorder)->pixel);
	}
	XFillRectangle(butPtr->display, pixmap, butPtr->disabledGC,
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
void
TkpComputeButtonGeometry(
    TkButton *butPtr)	/* Button whose geometry may have changed. */
{
    int width, height, avgWidth;
    Tk_FontMetrics fm;

    if (butPtr->highlightWidth < 0) {
	butPtr->highlightWidth = 0;
    }
    if ((butPtr->type == TYPE_BUTTON) && (butPtr->image == None)
	    && (butPtr->bitmap == None)) {
	butPtr->inset = 0;
    } else if ((butPtr->type != TYPE_LABEL) && butPtr->indicatorOn) {
	butPtr->inset = 0;
    } else {
	butPtr->inset = butPtr->borderWidth;
    }

    /*
     * The highlight width corresponds to the default ring on the Macintosh.
     * As such, the highlight width is only added if the button is the default
     * button.  The actual width of the default ring is one less than the
     * highlight width as there is also one pixel of spacing.
     */

    if (butPtr->defaultState != tkDisabledUid) {
	butPtr->inset += butPtr->highlightWidth;
    }
    butPtr->indicatorSpace = 0;
    if (butPtr->image != NULL) {
	Tk_SizeOfImage(butPtr->image, &width, &height);
	imageOrBitmap:
	if (butPtr->width > 0) {
	    width = butPtr->width;
	}







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

<
|
<
<

|
<
<
<







438
439
440
441
442
443
444


445









446

447


448
449



450
451
452
453
454
455
456
void
TkpComputeButtonGeometry(
    TkButton *butPtr)	/* Button whose geometry may have changed. */
{
    int width, height, avgWidth;
    Tk_FontMetrics fm;













    /*

     * First figure out the size of the contents of the button.


     */
     



    butPtr->indicatorSpace = 0;
    if (butPtr->image != NULL) {
	Tk_SizeOfImage(butPtr->image, &width, &height);
	imageOrBitmap:
	if (butPtr->width > 0) {
	    width = butPtr->width;
	}
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
	}
    } else if (butPtr->bitmap != None) {
	Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
	goto imageOrBitmap;
    } else {
	Tk_FreeTextLayout(butPtr->textLayout);
	butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
		butPtr->text, -1, butPtr->wrapLength, butPtr->justify, 0,
		&butPtr->textWidth, &butPtr->textHeight);

	width = butPtr->textWidth;
	height = butPtr->textHeight;
	avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1);
	Tk_GetFontMetrics(butPtr->tkfont, &fm);

	if (butPtr->width > 0) {







|
|







467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
	}
    } else if (butPtr->bitmap != None) {
	Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
	goto imageOrBitmap;
    } else {
	Tk_FreeTextLayout(butPtr->textLayout);
	butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
		Tcl_GetString(butPtr->text), -1, butPtr->wrapLength,
		butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight);

	width = butPtr->textWidth;
	height = butPtr->textHeight;
	avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1);
	Tk_GetFontMetrics(butPtr->tkfont, &fm);

	if (butPtr->width > 0) {
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
		butPtr->indicatorDiameter = (80*butPtr->indicatorDiameter)/100;
	    }
	    butPtr->indicatorSpace = butPtr->indicatorDiameter + avgWidth;
	}
    }

    /*














     * When issuing the geometry request, add extra space for the indicator,
     * if any, and for the border and padding, plus if this is an image two 
     * extra pixels so the display can be offset by 1 pixel in either
     * direction for the raised or lowered effect.







     */

    if ((butPtr->image == NULL) && (butPtr->bitmap == None)) {
	width += 2*butPtr->padX;
	height += 2*butPtr->padY;
    }

    if ((butPtr->type == TYPE_BUTTON) && 
	((butPtr->image != NULL) || (butPtr->bitmap != None))) {










	width += 2;
	height += 2;


    }
































    Tk_GeometryRequest(butPtr->tkwin, (int) (width + butPtr->indicatorSpace
	    + 2*butPtr->inset), (int) (height + 2*butPtr->inset));
    Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset);
}

/*
 *----------------------------------------------------------------------







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




>
>
>
>
>
>
>


|



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







491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
		butPtr->indicatorDiameter = (80*butPtr->indicatorDiameter)/100;
	    }
	    butPtr->indicatorSpace = butPtr->indicatorDiameter + avgWidth;
	}
    }

    /*
     * Now figure out the size of the border decorations for the button.
     */
     
    if (butPtr->highlightWidth < 0) {
	butPtr->highlightWidth = 0;
    }
    
    /*
     * The width and height calculation for Appearance buttons with images & 
     * non-Appearance buttons with images is different.	 In the latter case, 
     * we add the borderwidth to the inset, since we are going to stamp a
     * 3-D border over the image.  In the former, we add it to the height,
     * directly, since Appearance will draw the border as part of our control.
     *
     * When issuing the geometry request, add extra space for the indicator,
     * if any, and for the border and padding, plus if this is an image two 
     * extra pixels so the display can be offset by 1 pixel in either
     * direction for the raised or lowered effect.
     *
     * The highlight width corresponds to the default ring on the Macintosh.
     * As such, the highlight width is only added if the button is the default
     * button.	The actual width of the default ring is one less than the
     * highlight width as there is also one pixel of spacing.
     * Appearance buttons with images do not have a highlight ring, because the 
     * Bevel button type does not support one.
     */

    if ((butPtr->image == None) && (butPtr->bitmap == None)) {
	width += 2*butPtr->padX;
	height += 2*butPtr->padY;
    }
    
    if ((butPtr->type == TYPE_BUTTON)) {
	if ((butPtr->image == None) && (butPtr->bitmap == None)) {
	    butPtr->inset = 0;
	    if (butPtr->defaultState != STATE_DISABLED) {
		butPtr->inset += butPtr->highlightWidth;
	    }
	} else if (TkMacHaveAppearance()) {
	    butPtr->inset = 0;
	    width += (2 * butPtr->borderWidth + 4);
	    height += (2 * butPtr->borderWidth + 4);
	} else {
	    butPtr->inset = butPtr->borderWidth;
	    width += 2;
	    height += 2;
	    if (butPtr->defaultState != STATE_DISABLED) {
		butPtr->inset += butPtr->highlightWidth;
	    }
	}
    } else if ((butPtr->type != TYPE_LABEL)) {
	if (butPtr->indicatorOn) {
	    butPtr->inset = 0;
	} else {
	    /*
	     * Under Appearance, the Checkbutton or radiobutton with an image
	     * is represented by a BevelButton with the Sticky defProc...  
	     * So we must set its height in the same way as the Button 
	     * with an image or bitmap.
	     */
	    if (((butPtr->image != None) || (butPtr->bitmap != None))
		    && TkMacHaveAppearance()) {
		int border;
		butPtr->inset = 0;
		if ( butPtr->borderWidth <= 2 ) {
		    border = 6;
		}  else {
		    border = 2 * butPtr->borderWidth + 2;
		}	       
		width += border;
		height += border;
	    } else {
		butPtr->inset = butPtr->borderWidth;
	    }	
	}	
    } else {
	butPtr->inset = butPtr->borderWidth;
    }



    Tk_GeometryRequest(butPtr->tkwin, (int) (width + butPtr->indicatorSpace
	    + 2*butPtr->inset), (int) (height + 2*butPtr->inset));
    Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset);
}

/*
 *----------------------------------------------------------------------
474
475
476
477
478
479
480
481





482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612


613
614

615


616
617
618
619
620
621
622




































































































































623
624
625
626
627
628
629
630
631
632
633
634
635
636
637


638
639



640


641
642

















643



644
645
646
647
648
649
650
651
652
653
654

655
656
657
658
659
660
661

662
663








664
665







































































































































































































































































































































































































666
667
668
669
670
671
672
673
674
675



676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694














695
696



697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719

720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
 *
 *--------------------------------------------------------------
 */

static void
DrawBufferedControl(
    TkButton *butPtr,		/* Tk button. */
    GWorldPtr destPort)		/* Off screen GWorld. */





{
    ControlRef controlHandle;
    CCTabHandle ccTabHandle;
    int windowColorChanged = false;
    RGBColor saveBackColor;

    if (windowRef == NULL) {
	Rect geometry = {0, 0, 10, 10};
	CWindowPeek windowList;

	/*
	 * Create a dummy window that we can draw to.  We will
	 * actually replace this windows bitmap with a the one
	 * we want to draw to at a later time.  This window and
	 * the data structures attached to it are only deallocated
	 * on exit of the application.
	 */
	
	windowRef = NewCWindow(NULL, &geometry, "\pempty", false, 
	    zoomDocProc, (WindowRef) -1, true, 0);
	if (windowRef == NULL) {
	    panic("Can't allocate buffer window.");
	}
	
	/*
	 * Now add the three standard controls to hidden window.  We
	 * only create one of each and reuse them for every widget in
	 * Tk.
	 */
	
	SetPort(windowRef);
	buttonHandle = NewControl(windowRef, &geometry, "\p",
		false, 1, 0, 1, pushButProc, (SInt32) 0);
	checkHandle = NewControl(windowRef, &geometry, "\p",
		false, 1, 0, 1, checkBoxProc, (SInt32) 0);
	radioHandle = NewControl(windowRef, &geometry, "\p",
		false, 1, 0, 1, radioButProc, (SInt32) 0);
	((CWindowPeek) windowRef)->visible = true;

	buttonTabHandle = (CCTabHandle) NewHandle(sizeof(CtlCTab));
	checkTabHandle = (CCTabHandle) NewHandle(sizeof(CtlCTab));
	radioTabHandle = (CCTabHandle) NewHandle(sizeof(CtlCTab));

	/*
	 * Remove our window from the window list.  This way our
	 * applications and others will not be confused that this
	 * window exists - but no one knows about it.
	 */

	windowList = (CWindowPeek) LMGetWindowList();
	if (windowList == (CWindowPeek) windowRef) {
	    LMSetWindowList((WindowRef) windowList->nextWindow);
	} else {
	    while ((windowList != NULL) 
		    && (windowList->nextWindow != (CWindowPeek) windowRef)) {
		windowList = windowList->nextWindow;
	    }
	    if (windowList != NULL) {
		windowList->nextWindow = windowList->nextWindow->nextWindow;
	    }
	}
	((CWindowPeek) windowRef)->nextWindow = NULL;

	/* 
	 * Create an exit handler to clean up this mess if we our
	 * unloaded etc.  We need to remember the windows portPixMap
	 * so it isn't leaked.
	 *
	 * TODO: The ButtonExitProc doesn't currently work and the
	 * code it includes will crash the Mac on exit from Tk.
	 
	 oldPixPtr = ((CWindowPeek) windowRef)->port.portPixMap;
	 Tcl_CreateExitHandler(ButtonExitProc, (ClientData) NULL);
	 */
    }
    
    /*
     * Set up control in hidden window to match what we need
     * to draw in the buffered window.
     */

    switch (butPtr->type) {
	case TYPE_BUTTON:
	    controlHandle = buttonHandle;
	    ccTabHandle = buttonTabHandle;
	    break;
	case TYPE_RADIO_BUTTON:
	    controlHandle = radioHandle;
	    ccTabHandle = radioTabHandle;
	    break;
	case TYPE_CHECK_BUTTON:
	    controlHandle = checkHandle;
	    ccTabHandle = checkTabHandle;
	    break;
    }
    (**controlHandle).contrlRect.left = butPtr->inset;
    (**controlHandle).contrlRect.top = butPtr->inset;
    (**controlHandle).contrlRect.right = Tk_Width(butPtr->tkwin) 
	    - butPtr->inset;
    (**controlHandle).contrlRect.bottom = Tk_Height(butPtr->tkwin) 
	    - butPtr->inset;
    if ((**controlHandle).contrlVis != 255) {
	(**controlHandle).contrlVis = 255;
    }
    if (butPtr->flags & SELECTED) {
	(**controlHandle).contrlValue = 1;
    } else {
	(**controlHandle).contrlValue = 0;
    }
    if (butPtr->state == tkActiveUid) {
	switch (butPtr->type) {
	    case TYPE_BUTTON:
		(**controlHandle).contrlHilite = kControlButtonPart;
		break;
	    case TYPE_RADIO_BUTTON:
		(**controlHandle).contrlHilite = kControlRadioButtonPart;
		break;
	    case TYPE_CHECK_BUTTON:
		(**controlHandle).contrlHilite = kControlCheckBoxPart;
		break;
	}
    } else if (butPtr->state == tkDisabledUid) {
	(**controlHandle).contrlHilite = kControlInactivePart;
    } else {
	(**controlHandle).contrlHilite = kControlNoPart;
    }

    /*
     * Now swap in the passed in GWorld for the portBits of our fake
     * window.  We also adjust various fields in the WindowRecord to make
     * the system think this is a normal window.


     */


    ((CWindowPeek) windowRef)->port.portPixMap = destPort->portPixMap;


    ((CWindowPeek) windowRef)->port.portRect = destPort->portRect;
    RectRgn(((CWindowPeek) windowRef)->port.visRgn, &destPort->portRect);
    RectRgn(((CWindowPeek) windowRef)->strucRgn, &destPort->portRect);
    RectRgn(((CWindowPeek) windowRef)->updateRgn, &destPort->portRect);
    RectRgn(((CWindowPeek) windowRef)->contRgn, &destPort->portRect);
    PortChanged(windowRef);
    




































































































































    /*
     * Before we draw the control we must add the hidden window back to the
     * main window list.  Otherwise, radiobuttons and checkbuttons will draw
     * incorrectly.  I don't really know why - but clearly the control draw
     * proc needs to have the controls window in the window list.
     */

    ((CWindowPeek) windowRef)->nextWindow = (CWindowPeek) LMGetWindowList();
    LMSetWindowList(windowRef);

    /*
     * Now we can set the port to our doctered up window.  We next need
     * to muck with the colors for the port & window to draw the control
     * with the proper Tk colors.  If we need to we also draw a default
     * ring for buttons.


     */




    SetPort(windowRef);


    windowColorChanged = UpdateControlColors(butPtr, controlHandle, 
	ccTabHandle, &saveBackColor);

















    Draw1Control(controlHandle);



    if ((butPtr->type == TYPE_BUTTON) && 
	    (butPtr->defaultState == tkActiveUid)) {
	Rect box = (**controlHandle).contrlRect;
	RGBColor rgbColor;

	TkSetMacColor(butPtr->highlightColorPtr->pixel, &rgbColor);
	RGBForeColor(&rgbColor);
	PenSize(butPtr->highlightWidth - 1, butPtr->highlightWidth - 1);
	InsetRect(&box, -butPtr->highlightWidth, -butPtr->highlightWidth);
	FrameRoundRect(&box, 16, 16);
    }

    if (windowColorChanged) {
	RGBColor dummyColor;
	ChangeBackgroundWindowColor(windowRef, saveBackColor, &dummyColor);
    }
    
    /*
     * Clean up: remove the hidden window from the main window list.

     */









    LMSetWindowList((WindowRef) ((CWindowPeek) windowRef)->nextWindow);
}








































































































































































































































































































































































































/*
 *--------------------------------------------------------------
 *
 * UpdateControlColors --
 *
 *	This function will review the colors used to display
 *	a Macintosh button.  If any non-standard colors are
 *	used we create a custom palette for the button, populate
 *	with the colors for the button and install the palette.



 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The Macintosh control may get a custom palette installed.
 *
 *--------------------------------------------------------------
 */

static int
UpdateControlColors(
    TkButton *butPtr,
    ControlRef controlHandle,
    CCTabHandle ccTabHandle,
    RGBColor *saveColorPtr)
{
    XColor *xcolor;
    














    xcolor = Tk_3DBorderColor(butPtr->normalBorder);




    (**ccTabHandle).ccSeed = 0;
    (**ccTabHandle).ccRider = 0;
    (**ccTabHandle).ctSize = 3;
    (**ccTabHandle).ctTable[0].value = cBodyColor;
    TkSetMacColor(xcolor->pixel,
	&(**ccTabHandle).ctTable[0].rgb);
    (**ccTabHandle).ctTable[1].value = cTextColor;
    TkSetMacColor(butPtr->normalFg->pixel,
	&(**ccTabHandle).ctTable[1].rgb);
    (**ccTabHandle).ctTable[2].value = cFrameColor;
    TkSetMacColor(butPtr->highlightColorPtr->pixel,
	&(**ccTabHandle).ctTable[2].rgb);
    SetControlColor(controlHandle, ccTabHandle);
        
    if (((xcolor->pixel >> 24) != CONTROL_BODY_PIXEL) && 
	    ((butPtr->type == TYPE_CHECK_BUTTON) ||
		    (butPtr->type == TYPE_RADIO_BUTTON))) {
	RGBColor newColor;
	
	TkSetMacColor(xcolor->pixel, &newColor);
	ChangeBackgroundWindowColor((**controlHandle).contrlOwner,
		newColor, saveColorPtr);
	return true;

    }
    
    return false;
}

/*
 *--------------------------------------------------------------
 *
 * ChangeBackgroundWindowColor --
 *
 *	This procedure will change the background color entry
 *	in the Window's colortable.  The system isn't notified
 *	of the change.  This call should only be used to fool
 *	the drawing routines for checkboxes and radiobuttons.
 *	Any change should be temporary and be reverted after
 *	the widget is drawn.
 *
 * Results:
 *	None.
 *







|
>
>
>
>
>





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

|

>
>

|
>
|
>
>







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















>
>


>
>
>
|
>
>

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









>






|
>


>
>
>
>
>
>
>
>


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










>
>
>



















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

|
|
|
|
>












|







623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641



642










643


644





645








646




647




















































































648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
 *
 *--------------------------------------------------------------
 */

static void
DrawBufferedControl(
    TkButton *butPtr,		/* Tk button. */
    GWorldPtr destPort,		/* Off screen GWorld. */
    GC gc,			/* The GC we are drawing into - needed for
				 * the bevel button */
    Pixmap pixmap		/* The pixmap we are drawing into - needed
				   for the bevel button */
    )		
{
    ControlRef controlHandle;
    CCTabHandle ccTabHandle;
    int windowColorChanged = false;
    RGBColor saveBackColor;
    int isBevel = 0;



    










    if (windowRef == NULL) {


	InitSampleControls();





    }








    




    /*




















































































     * Now swap in the passed in GWorld for the portBits of our fake
     * window.	We also adjust various fields in the WindowRecord to make
     * the system think this is a normal window.
     * Note, we can use DrawControlInCurrentPort under Appearance, so we don't
     * need to swap pixmaps.
     */
    
    if (!TkMacHaveAppearance()) {
	((CWindowPeek) windowRef)->port.portPixMap = destPort->portPixMap;
    }
    
    ((CWindowPeek) windowRef)->port.portRect = destPort->portRect;
    RectRgn(((CWindowPeek) windowRef)->port.visRgn, &destPort->portRect);
    RectRgn(((CWindowPeek) windowRef)->strucRgn, &destPort->portRect);
    RectRgn(((CWindowPeek) windowRef)->updateRgn, &destPort->portRect);
    RectRgn(((CWindowPeek) windowRef)->contRgn, &destPort->portRect);
    PortChanged(windowRef);
    
    /*
     * Set up control in hidden window to match what we need
     * to draw in the buffered window.	
     */
     
    isBevel = 0;   
    switch (butPtr->type) {
	case TYPE_BUTTON:
	    if (TkMacHaveAppearance()) {
		if ((butPtr->image == None) && (butPtr->bitmap == None)) {
		    controlHandle = buttonHandle;
		    ccTabHandle = buttonTabHandle;
		} else {
		    if (butPtr->borderWidth <= 2) {
			controlHandle = smallBevelHandle;
		    } else if (butPtr->borderWidth == 3) {
			controlHandle = medBevelHandle;
		    } else {
			controlHandle = largeBevelHandle;
		    }
		    ccTabHandle = buttonTabHandle;
		    SetupBevelButton(butPtr, controlHandle, destPort, 
			    gc, pixmap);
		    isBevel = 1;		
		}
	    } else {
		controlHandle = buttonHandle;
		ccTabHandle = buttonTabHandle;
	    }
	    break;
	case TYPE_RADIO_BUTTON:
	    if (TkMacHaveAppearance()) {
		if (((butPtr->image == None) && (butPtr->bitmap == None))
			|| (butPtr->indicatorOn)) {
		    controlHandle = radioHandle;
		    ccTabHandle = radioTabHandle;
		} else {
		    if (butPtr->borderWidth <= 2) {
			controlHandle = smallStickyBevelHandle;
		    } else if (butPtr->borderWidth == 3) {
			controlHandle = medStickyBevelHandle;
		    } else {
			controlHandle = largeStickyBevelHandle;
		    }
		    ccTabHandle = radioTabHandle;
		    SetupBevelButton(butPtr, controlHandle, destPort, 
			    gc, pixmap);
		    isBevel = 1;		
		}
	    } else {
		controlHandle = radioHandle;
		ccTabHandle = radioTabHandle;
	    }	       
	    break;
	case TYPE_CHECK_BUTTON:
	    if (TkMacHaveAppearance()) {
		if (((butPtr->image == None) && (butPtr->bitmap == None))
			|| (butPtr->indicatorOn)) {
		    controlHandle = checkHandle;
		    ccTabHandle = checkTabHandle;
		} else {
		    if (butPtr->borderWidth <= 2) {
			controlHandle = smallStickyBevelHandle;
		    } else if (butPtr->borderWidth == 3) {
			controlHandle = medStickyBevelHandle;
		    } else {
			controlHandle = largeStickyBevelHandle;
		    }
		    ccTabHandle = checkTabHandle;
		    SetupBevelButton(butPtr, controlHandle, destPort, 
			    gc, pixmap);
		    isBevel = 1;		
		}
	    } else {
		controlHandle = checkHandle;
		ccTabHandle = checkTabHandle;
	    }	       
	    break;
    }
    
    (**controlHandle).contrlRect.left = butPtr->inset;
    (**controlHandle).contrlRect.top = butPtr->inset;
    (**controlHandle).contrlRect.right = Tk_Width(butPtr->tkwin) 
	- butPtr->inset;
    (**controlHandle).contrlRect.bottom = Tk_Height(butPtr->tkwin) 
	- butPtr->inset;
	    
    /*
     * Setting the control visibility by hand does not 
     * seem to work under Appearance. 
     */
     
    if (TkMacHaveAppearance()) {
	SetControlVisibility(controlHandle, true, false);      
	(**userPaneHandle).contrlRect.left = 0;
	(**userPaneHandle).contrlRect.top = 0;
	(**userPaneHandle).contrlRect.right = Tk_Width(butPtr->tkwin);
	(**userPaneHandle).contrlRect.bottom = Tk_Height(butPtr->tkwin);
    } else {	  
	(**controlHandle).contrlVis = 255;
    }	  
    
		
    
    if (butPtr->flags & SELECTED) {
	(**controlHandle).contrlValue = 1;
    } else {
	(**controlHandle).contrlValue = 0;
    }
    
    if (butPtr->state == STATE_ACTIVE) {
	if (isBevel) {
	    (**controlHandle).contrlHilite = kControlButtonPart;
	} else {
	    switch (butPtr->type) {
		case TYPE_BUTTON:
		    (**controlHandle).contrlHilite = kControlButtonPart;
		    break;
		case TYPE_RADIO_BUTTON:
		    (**controlHandle).contrlHilite = kControlRadioButtonPart;
		    break;
		case TYPE_CHECK_BUTTON:
		    (**controlHandle).contrlHilite = kControlCheckBoxPart;
		    break;
	    }
	}
    } else if (butPtr->state == STATE_DISABLED) {
	(**controlHandle).contrlHilite = kControlInactivePart;
    } else {
	(**controlHandle).contrlHilite = kControlNoPart;
    }

    /*
     * Before we draw the control we must add the hidden window back to the
     * main window list.  Otherwise, radiobuttons and checkbuttons will draw
     * incorrectly.  I don't really know why - but clearly the control draw
     * proc needs to have the controls window in the window list.
     */

    ((CWindowPeek) windowRef)->nextWindow = (CWindowPeek) LMGetWindowList();
    LMSetWindowList(windowRef);

    /*
     * Now we can set the port to our doctered up window.  We next need
     * to muck with the colors for the port & window to draw the control
     * with the proper Tk colors.  If we need to we also draw a default
     * ring for buttons.
     * Under Appearance, we draw the control directly into destPort, and
     * just set the default control data.
     */

    if (TkMacHaveAppearance()) {
	SetPort((GrafPort *) destPort);
    } else {
	SetPort(windowRef);
    }
    
    windowColorChanged = UpdateControlColors(butPtr, controlHandle, 
	    ccTabHandle, &saveBackColor);
	
    if ((butPtr->type == TYPE_BUTTON) && TkMacHaveAppearance()) {
	Boolean isDefault;
	
	if (butPtr->defaultState == STATE_ACTIVE) {
	    isDefault = true;
	} else {
	    isDefault = false;
	}
	SetControlData(controlHandle, kControlNoPart, 
		kControlPushButtonDefaultTag,
		sizeof(isDefault), (Ptr) &isDefault);			
    }

    if (TkMacHaveAppearance()) {
	DrawControlInCurrentPort(userPaneHandle);
    } else {
	Draw1Control(controlHandle);
    }

    if (!TkMacHaveAppearance() &&
	    (butPtr->type == TYPE_BUTTON) && 
	    (butPtr->defaultState == STATE_ACTIVE)) {
	Rect box = (**controlHandle).contrlRect;
	RGBColor rgbColor;

	TkSetMacColor(butPtr->highlightColorPtr->pixel, &rgbColor);
	RGBForeColor(&rgbColor);
	PenSize(butPtr->highlightWidth - 1, butPtr->highlightWidth - 1);
	InsetRect(&box, -butPtr->highlightWidth, -butPtr->highlightWidth);
	FrameRoundRect(&box, 16, 16);
    }
    
    if (windowColorChanged) {
	RGBColor dummyColor;
	ChangeBackgroundWindowColor(windowRef, saveBackColor, &dummyColor);
    }
    
    /*
     * Clean up: remove the hidden window from the main window list, and
     * hide the control we drew.  
     */

    if (TkMacHaveAppearance()) {
	SetControlVisibility(controlHandle, false, false);
	if (isBevel) {
	    KillPicture(bevelButtonContent.u.picture);
	}     
    } else {	  
	(**controlHandle).contrlVis = 0;
    }	  
    LMSetWindowList((WindowRef) ((CWindowPeek) windowRef)->nextWindow);
}

/*
 *--------------------------------------------------------------
 *
 * InitSampleControls --
 *
 *	This function initializes a dummy Macintosh window and
 *	sample controls to allow drawing Mac controls to any GWorld 
 *	(including off-screen bitmaps).	 
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Controls & a window are created.
 *
 *--------------------------------------------------------------
 */

static void
InitSampleControls()
{
    Rect geometry = {0, 0, 10, 10};
    CWindowPeek windowList;

    /*
     * Create a dummy window that we can draw to.  We will
     * actually replace this window's bitmap with the one
     * we want to draw to at a later time.  This window and
     * the data structures attached to it are only deallocated
     * on exit of the application.
     */

    windowRef = NewCWindow(NULL, &geometry, "\pempty", false, 
	    zoomDocProc, (WindowRef) -1, true, 0);
    if (windowRef == NULL) {
	panic("Can't allocate buffer window.");
    }
	
    /*
     * Now add the three standard controls to hidden window.  We
     * only create one of each and reuse them for every widget in
     * Tk.
     * Under Appearance, we have to embed the controls in a UserPane
     * control, so that we can color the background text in 
     * radiobuttons and checkbuttons.
     */
	
    SetPort(windowRef);
	
    if (TkMacHaveAppearance()) {
	    
	OSErr err;
	ControlRef dontCare;
	    
	/* Adding UserPaneBackgroundProcs to the root control does
	 * not seem to work, so we have to add another UserPane to 
	 * the root control.
	 */
	     
	err = CreateRootControl(windowRef, &dontCare);
	if (err != noErr) {
	    panic("Can't create root control in DrawBufferedControl");
	}
	    
	userPaneHandle = NewControl(windowRef, &geometry, "\p",
		true, kControlSupportsEmbedding|kControlHasSpecialBackground, 
		0, 1, kControlUserPaneProc, (SInt32) 0);
	SetUserPaneSetUpSpecialBackgroundProc(userPaneHandle,
		UserPaneBackgroundProc);
	SetUserPaneDrawProc(userPaneHandle, UserPaneDraw);

	buttonHandle = NewControl(windowRef, &geometry, "\p",
		false, 1, 0, 1, kControlPushButtonProc, (SInt32) 0);
	EmbedControl(buttonHandle, userPaneHandle);
	checkHandle = NewControl(windowRef, &geometry, "\p",
		false, 1, 0, 1, kControlCheckBoxProc, (SInt32) 0);
	EmbedControl(checkHandle, userPaneHandle);
	radioHandle = NewControl(windowRef, &geometry, "\p",
		false, 1, 0, 1, kControlRadioButtonProc, (SInt32) 0);
	EmbedControl(radioHandle, userPaneHandle);
	smallBevelHandle = NewControl(windowRef, &geometry, "\p",
		false, 0, 0, 
		kControlBehaviorOffsetContents << 16
		| kControlContentPictHandle, 
		kControlBevelButtonSmallBevelProc, (SInt32) 0);
	EmbedControl(smallBevelHandle, userPaneHandle);
	medBevelHandle = NewControl(windowRef, &geometry, "\p",
		false, 0, 0, 
		kControlBehaviorOffsetContents << 16
		| kControlContentPictHandle, 
		kControlBevelButtonNormalBevelProc, (SInt32) 0);
	EmbedControl(medBevelHandle, userPaneHandle);
	largeBevelHandle = NewControl(windowRef, &geometry, "\p",
		false, 0, 0, 
		kControlBehaviorOffsetContents << 16
		| kControlContentPictHandle, 
		kControlBevelButtonLargeBevelProc, (SInt32) 0);
	EmbedControl(largeBevelHandle, userPaneHandle);
	bevelButtonContent.contentType = kControlContentPictHandle;
	smallStickyBevelHandle = NewControl(windowRef, &geometry, "\p",
		false, 0, 0, 
		(kControlBehaviorOffsetContents
			| kControlBehaviorSticky) << 16 
		| kControlContentPictHandle, 
		kControlBevelButtonSmallBevelProc, (SInt32) 0);
	EmbedControl(smallStickyBevelHandle, userPaneHandle);
	medStickyBevelHandle = NewControl(windowRef, &geometry, "\p",
		false, 0, 0, 
		(kControlBehaviorOffsetContents
			| kControlBehaviorSticky) << 16 
		| kControlContentPictHandle, 
		kControlBevelButtonNormalBevelProc, (SInt32) 0);
	EmbedControl(medStickyBevelHandle, userPaneHandle);
	largeStickyBevelHandle = NewControl(windowRef, &geometry, "\p",
		false, 0, 0, 
		(kControlBehaviorOffsetContents
			| kControlBehaviorSticky) << 16 
		| kControlContentPictHandle, 
		kControlBevelButtonLargeBevelProc, (SInt32) 0);
	EmbedControl(largeStickyBevelHandle, userPaneHandle);
    
	picParams.version = -2;
	picParams.hRes = 0x00480000;
	picParams.vRes = 0x00480000;
	picParams.srcRect.top = 0;
	picParams.srcRect.left = 0;
    
	((CWindowPeek) windowRef)->visible = true;
    } else {
	buttonHandle = NewControl(windowRef, &geometry, "\p",
		false, 1, 0, 1, pushButProc, (SInt32) 0);
	checkHandle = NewControl(windowRef, &geometry, "\p",
		false, 1, 0, 1, checkBoxProc, (SInt32) 0);
	radioHandle = NewControl(windowRef, &geometry, "\p",
		false, 1, 0, 1, radioButProc, (SInt32) 0);
	((CWindowPeek) windowRef)->visible = true;

	buttonTabHandle = (CCTabHandle) NewHandle(sizeof(CtlCTab));
	checkTabHandle = (CCTabHandle) NewHandle(sizeof(CtlCTab));
	radioTabHandle = (CCTabHandle) NewHandle(sizeof(CtlCTab));
    }

    /*
     * Remove our window from the window list.	This way our
     * applications and others will not be confused that this
     * window exists - but no one knows about it.
     */

    windowList = (CWindowPeek) LMGetWindowList();
    if (windowList == (CWindowPeek) windowRef) {
	LMSetWindowList((WindowRef) windowList->nextWindow);
    } else {
	while ((windowList != NULL) 
		&& (windowList->nextWindow != (CWindowPeek) windowRef)) {
	    windowList = windowList->nextWindow;
	}
	if (windowList != NULL) {
	    windowList->nextWindow = windowList->nextWindow->nextWindow;
	}
    }
    ((CWindowPeek) windowRef)->nextWindow = NULL;

    /* 
     * Create an exit handler to clean up this mess if we our
     * unloaded etc.  We need to remember the windows portPixMap
     * so it isn't leaked.
     *
     * TODO: The ButtonExitProc doesn't currently work and the
     * code it includes will crash the Mac on exit from Tk.
	 
     oldPixPtr = ((CWindowPeek) windowRef)->port.portPixMap;
     Tcl_CreateExitHandler(ButtonExitProc, (ClientData) NULL);
    */

}

/*
 *--------------------------------------------------------------
 *
 * SetupBevelButton --
 *
 *	Sets up the Bevel Button with image by copying the
 *	source image onto the PicHandle for the button.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	The image or bitmap for the button is copied over to a picture.
 *
 *--------------------------------------------------------------
 */
void
SetupBevelButton(
    TkButton *butPtr,		/* Tk button. */
    ControlRef controlHandle,	 /* The control to set this picture to */
    GWorldPtr destPort,		/* Off screen GWorld. */
    GC gc,			/* The GC we are drawing into - needed for
				 * the bevel button */
    Pixmap pixmap		/* The pixmap we are drawing into - needed
				   for the bevel button */
    )
{
    int height, width;
    ControlButtonGraphicAlignment theAlignment;
    
    SetPort((GrafPtr) destPort);

    if (butPtr->image != None) {
	Tk_SizeOfImage(butPtr->image, 
		&width, &height);
    } else {
	Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, 
		&width, &height);
    }
	    
    if ((butPtr->width > 0) && (butPtr->width < width)) {
	width = butPtr->width;
    }
    if ((butPtr->height > 0) && (butPtr->height < height)) {
	height = butPtr->height;
    }
    
    picParams.srcRect.right = width;
    picParams.srcRect.bottom = height;
    
    bevelButtonContent.u.picture = OpenCPicture(&picParams);
    
    /*
     * TO DO - There is one case where XCopyPlane calls CopyDeepMask,
     * which does not get recorded in the picture.  So the bitmap code
     * will fail in that case.
     */
     
    if ((butPtr->selectImage != NULL) && (butPtr->flags & SELECTED)) {
	Tk_RedrawImage(butPtr->selectImage, 0, 0, width, height,
		pixmap, 0, 0);
    } else if (butPtr->image != NULL) {
	Tk_RedrawImage(butPtr->image, 0, 0, width, 
		height, pixmap, 0, 0);
    } else {			
	XSetClipOrigin(butPtr->display, gc, 0, 0);
	XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc, 0, 0,
		(unsigned int) width, (unsigned int) height, 0, 0, 1);
    }
    
    ClosePicture();
    
    SetControlData(controlHandle, kControlButtonPart,
	    kControlBevelButtonContentTag,
	    sizeof(ControlButtonContentInfo),
	    (char *) &bevelButtonContent);
	    
    if (butPtr->anchor == TK_ANCHOR_N) {
	theAlignment = kControlBevelButtonAlignTop;
    } else if (butPtr->anchor == TK_ANCHOR_NE) { 
	theAlignment = kControlBevelButtonAlignTopRight;
    } else if (butPtr->anchor == TK_ANCHOR_E) { 
	theAlignment = kControlBevelButtonAlignRight;
    } else if (butPtr->anchor == TK_ANCHOR_SE) {
	theAlignment = kControlBevelButtonAlignBottomRight;
    } else if (butPtr->anchor == TK_ANCHOR_S) {
	theAlignment = kControlBevelButtonAlignBottom;
    } else if (butPtr->anchor == TK_ANCHOR_SW) {
	theAlignment = kControlBevelButtonAlignBottomLeft;
    } else if (butPtr->anchor == TK_ANCHOR_W) {
	theAlignment = kControlBevelButtonAlignLeft;
    } else if (butPtr->anchor == TK_ANCHOR_NW) {
	theAlignment = kControlBevelButtonAlignTopLeft;
    } else if (butPtr->anchor == TK_ANCHOR_CENTER) {
	theAlignment = kControlBevelButtonAlignCenter;
    }

    SetControlData(controlHandle, kControlButtonPart,
	    kControlBevelButtonGraphicAlignTag,
	    sizeof(ControlButtonGraphicAlignment),
	    (char *) &theAlignment);

}

/*
 *--------------------------------------------------------------
 *
 * SetUserPaneDrawProc --
 *
 *	Utility function to add a UserPaneDrawProc
 *	to a userPane control.	From MoreControls code
 *	from Apple DTS.
 *
 * Results:
 *	MacOS system error.
 *
 * Side effects:
 *	The user pane gets a new UserPaneDrawProc.
 *
 *--------------------------------------------------------------
 */
pascal OSErr SetUserPaneDrawProc (
    ControlRef control,
    ControlUserPaneDrawProcPtr upp)
{
    ControlUserPaneDrawUPP myControlUserPaneDrawUPP;
    myControlUserPaneDrawUPP = NewControlUserPaneDrawProc(upp);	
    return SetControlData (control, 
	    kControlNoPart, kControlUserPaneDrawProcTag, 
	    sizeof(myControlUserPaneDrawUPP), 
	    (Ptr) &myControlUserPaneDrawUPP);
}

/*
 *--------------------------------------------------------------
 *
 * SetUserPaneSetUpSpecialBackgroundProc --
 *
 *	Utility function to add a UserPaneBackgroundProc
 *	to a userPane control
 *
 * Results:
 *	MacOS system error.
 *
 * Side effects:
 *	The user pane gets a new UserPaneBackgroundProc.
 *
 *--------------------------------------------------------------
 */
pascal OSErr
SetUserPaneSetUpSpecialBackgroundProc(
    ControlRef control, 
    ControlUserPaneBackgroundProcPtr upp)
{
    ControlUserPaneBackgroundUPP myControlUserPaneBackgroundUPP;
    myControlUserPaneBackgroundUPP = NewControlUserPaneBackgroundProc(upp);
    return SetControlData (control, kControlNoPart, 
	    kControlUserPaneBackgroundProcTag, 
	    sizeof(myControlUserPaneBackgroundUPP), 
	    (Ptr) &myControlUserPaneBackgroundUPP);
}

/*
 *--------------------------------------------------------------
 *
 * UserPaneDraw --
 *
 *	This function draws the background of the user pane that will 
 *	lie under checkboxes and radiobuttons.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The user pane gets updated to the current color.
 *
 *--------------------------------------------------------------
 */
pascal void
UserPaneDraw(
    ControlRef control,
    ControlPartCode cpc)
{
    Rect contrlRect = (**control).contrlRect;
    RGBBackColor (&gUserPaneBackground);
    EraseRect (&contrlRect);
}

/*
 *--------------------------------------------------------------
 *
 * UserPaneBackgroundProc --
 *
 *	This function sets up the background of the user pane that will 
 *	lie under checkboxes and radiobuttons.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The user pane background gets set to the current color.
 *
 *--------------------------------------------------------------
 */

pascal void
UserPaneBackgroundProc(
    ControlHandle,
    ControlBackgroundPtr info)
{
    if (info->colorDevice) {
	RGBBackColor (&gUserPaneBackground);
    }
}

/*
 *--------------------------------------------------------------
 *
 * UpdateControlColors --
 *
 *	This function will review the colors used to display
 *	a Macintosh button.  If any non-standard colors are
 *	used we create a custom palette for the button, populate
 *	with the colors for the button and install the palette.
 *
 *	Under Appearance, we just set the pointer that will be
 *	used by the UserPaneDrawProc.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The Macintosh control may get a custom palette installed.
 *
 *--------------------------------------------------------------
 */

static int
UpdateControlColors(
    TkButton *butPtr,
    ControlRef controlHandle,
    CCTabHandle ccTabHandle,
    RGBColor *saveColorPtr)
{
    XColor *xcolor;
    
    /*
     * Under Appearance we cannot change the background of the
     * button itself.  However, the color we are setting is the color
     *	of the containing userPane.  This will be the color that peeks 
     * around the rounded corners of the button.  
     * We make this the highlightbackground rather than the background,
     * because if you color the background of a frame containing a
     * button, you usually also color the highlightbackground as well,
     * or you will get a thin grey ring around the button.
     */
      
    if (TkMacHaveAppearance() && (butPtr->type == TYPE_BUTTON)) {
	xcolor = Tk_3DBorderColor(butPtr->highlightBorder);
    } else {
	xcolor = Tk_3DBorderColor(butPtr->normalBorder);
    }
    if (TkMacHaveAppearance()) {
	TkSetMacColor(xcolor->pixel, &gUserPaneBackground);
    } else {
	(**ccTabHandle).ccSeed = 0;
	(**ccTabHandle).ccRider = 0;
	(**ccTabHandle).ctSize = 3;
	(**ccTabHandle).ctTable[0].value = cBodyColor;
	TkSetMacColor(xcolor->pixel,
		&(**ccTabHandle).ctTable[0].rgb);
	(**ccTabHandle).ctTable[1].value = cTextColor;
	TkSetMacColor(butPtr->normalFg->pixel,
		&(**ccTabHandle).ctTable[1].rgb);
	(**ccTabHandle).ctTable[2].value = cFrameColor;
	TkSetMacColor(butPtr->highlightColorPtr->pixel,
		&(**ccTabHandle).ctTable[2].rgb);
	SetControlColor(controlHandle, ccTabHandle);
	
	if (((xcolor->pixel >> 24) != CONTROL_BODY_PIXEL) && 
		((butPtr->type == TYPE_CHECK_BUTTON) ||
			(butPtr->type == TYPE_RADIO_BUTTON))) {
	    RGBColor newColor;
	
	    TkSetMacColor(xcolor->pixel, &newColor);
	    ChangeBackgroundWindowColor((**controlHandle).contrlOwner,
		    newColor, saveColorPtr);
	    return true;
	}
    }
    
    return false;
}

/*
 *--------------------------------------------------------------
 *
 * ChangeBackgroundWindowColor --
 *
 *	This procedure will change the background color entry
 *	in the Window's colortable.  The system isn't notified
 *	of the change.	This call should only be used to fool
 *	the drawing routines for checkboxes and radiobuttons.
 *	Any change should be temporary and be reverted after
 *	the widget is drawn.
 *
 * Results:
 *	None.
 *
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
    ClientData clientData;		/* Not used. */
{
    Rect pixRect = {0, 0, 10, 10};
    Rect rgnRect = {0, 0, 0, 0};

    /*
     * Restore our dummy window to it's origional state by putting it
     * back in the window list and restoring it's bits.  The destroy
     * the controls and window.
     */
 
    ((CWindowPeek) windowRef)->nextWindow = (CWindowPeek) LMGetWindowList();
    LMSetWindowList(windowRef);
    ((CWindowPeek) windowRef)->port.portPixMap = oldPixPtr;
    ((CWindowPeek) windowRef)->port.portRect = pixRect;







|







1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
    ClientData clientData;		/* Not used. */
{
    Rect pixRect = {0, 0, 10, 10};
    Rect rgnRect = {0, 0, 0, 0};

    /*
     * Restore our dummy window to it's origional state by putting it
     * back in the window list and restoring it's bits.	 The destroy
     * the controls and window.
     */
 
    ((CWindowPeek) windowRef)->nextWindow = (CWindowPeek) LMGetWindowList();
    LMSetWindowList(windowRef);
    ((CWindowPeek) windowRef)->port.portPixMap = oldPixPtr;
    ((CWindowPeek) windowRef)->port.portRect = pixRect;

Changes to mac/tkMacClipboard.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tkMacClipboard.c --
 *
 * 	This file manages the clipboard for the Tk toolkit.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacClipboard.c 1.18 97/05/01 15:41:17
 */

#include "tkInt.h"
#include "tkPort.h"
#include "tkMacInt.h"

#include <Scrap.h>










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tkMacClipboard.c --
 *
 * 	This file manages the clipboard for the Tk toolkit.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacClipboard.c,v 1.1.4.3 1998/12/13 08:16:12 lfb Exp $
 */

#include "tkInt.h"
#include "tkPort.h"
#include "tkMacInt.h"

#include <Scrap.h>
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 *	Retrieve the specified selection from another process.  For
 *	now, only fetching XA_STRING from CLIPBOARD is supported.
 *	Eventually other types should be allowed.
 * 
 * Results:
 *	The return value is a standard Tcl return value.
 *	If an error occurs (such as no selection exists)
 *	then an error message is left in interp->result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */








|







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 *	Retrieve the specified selection from another process.  For
 *	now, only fetching XA_STRING from CLIPBOARD is supported.
 *	Eventually other types should be allowed.
 * 
 * Results:
 *	The return value is a standard Tcl return value.
 *	If an error occurs (such as no selection exists)
 *	then an error message is left in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
{
    TkClipboardTarget *targetPtr;
    TkClipboardBuffer *cbPtr;
    TkDisplay *dispPtr;
    char *buffer, *p, *endPtr, *buffPtr;
    long length;

    dispPtr = tkDisplayList;
    if ((dispPtr == NULL) || !dispPtr->clipboardActive) {
	return;
    }

    for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
	    targetPtr = targetPtr->nextPtr) {
	if (targetPtr->type == XA_STRING)







|







237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
{
    TkClipboardTarget *targetPtr;
    TkClipboardBuffer *cbPtr;
    TkDisplay *dispPtr;
    char *buffer, *p, *endPtr, *buffPtr;
    long length;

    dispPtr = TkGetDisplayList();
    if ((dispPtr == NULL) || !dispPtr->clipboardActive) {
	return;
    }

    for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
	    targetPtr = targetPtr->nextPtr) {
	if (targetPtr->type == XA_STRING)

Changes to mac/tkMacColor.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkMacColor.c --
 *
 *	This file maintains a database of color values for the Tk
 *	toolkit, in order to avoid round-trips to the server to
 *	map color names to pixel values.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacColor.c 1.36 96/11/25 11:02:12
 */

#include <tkColor.h>
#include "tkMacInt.h"

#include <LowMem.h>
#include <Palettes.h>













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkMacColor.c --
 *
 *	This file maintains a database of color values for the Tk
 *	toolkit, in order to avoid round-trips to the server to
 *	map color names to pixel values.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacColor.c,v 1.1.4.2 1998/11/25 21:16:36 stanton Exp $
 */

#include <tkColor.h>
#include "tkMacInt.h"

#include <LowMem.h>
#include <Palettes.h>
86
87
88
89
90
91
92


93
94
95
96
97
98
99
	case MENU_ACTIVE_PIXEL:
	case MENU_ACTIVE_TEXT_PIXEL:
	case MENU_BACKGROUND_PIXEL:
	case MENU_DISABLED_PIXEL:
	case MENU_TEXT_PIXEL:
	    GetMenuPartColor((pixel >> 24), macColor);
	    return true;


	case PIXEL_MAGIC:
	default:
	    macColor->blue = (unsigned short) ((pixel & 0xFF) << 8);
	    macColor->green = (unsigned short) (((pixel >> 8) & 0xFF) << 8);
	    macColor->red = (unsigned short) (((pixel >> 16) & 0xFF) << 8);
	    return true;
    }







>
>







86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
	case MENU_ACTIVE_PIXEL:
	case MENU_ACTIVE_TEXT_PIXEL:
	case MENU_BACKGROUND_PIXEL:
	case MENU_DISABLED_PIXEL:
	case MENU_TEXT_PIXEL:
	    GetMenuPartColor((pixel >> 24), macColor);
	    return true;
	case APPEARANCE_PIXEL:
	    return false;
	case PIXEL_MAGIC:
	default:
	    macColor->blue = (unsigned short) ((pixel & 0xFF) << 8);
	    macColor->green = (unsigned short) (((pixel >> 8) & 0xFF) << 8);
	    macColor->red = (unsigned short) (((pixel >> 16) & 0xFF) << 8);
	    return true;
    }
247
248
249
250
251
252
253






254
255
256
257
258
259
260
	} else if (!strcasecmp(name+6, "MenuDisabled")) {
	    GetMenuPartColor(MENU_DISABLED_PIXEL, &rgbValue);
	    pixelCode = MENU_DISABLED_PIXEL;
	    foundSystemColor = true;
	} else if (!strcasecmp(name+6, "MenuText")) {
	    GetMenuPartColor(MENU_TEXT_PIXEL, &rgbValue);
	    pixelCode = MENU_TEXT_PIXEL;






	    foundSystemColor = true;
	}
	
	if (foundSystemColor) {
	    color.red = rgbValue.red;
	    color.green = rgbValue.green;
	    color.blue = rgbValue.blue;







>
>
>
>
>
>







249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
	} else if (!strcasecmp(name+6, "MenuDisabled")) {
	    GetMenuPartColor(MENU_DISABLED_PIXEL, &rgbValue);
	    pixelCode = MENU_DISABLED_PIXEL;
	    foundSystemColor = true;
	} else if (!strcasecmp(name+6, "MenuText")) {
	    GetMenuPartColor(MENU_TEXT_PIXEL, &rgbValue);
	    pixelCode = MENU_TEXT_PIXEL;
	    foundSystemColor = true;
	} else if (!strcasecmp(name+6, "AppearanceColor")) {
	    color.red = 0;
	    color.green = 0;
	    color.blue = 0;
	    pixelCode = APPEARANCE_PIXEL;
	    foundSystemColor = true;
	}
	
	if (foundSystemColor) {
	    color.red = rgbValue.red;
	    color.green = rgbValue.green;
	    color.blue = rgbValue.blue;

Added mac/tkMacConfig.c.



























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
/* 
 * tkMacConfig.c --
 *
 *	This module implements the Macintosh system defaults for
 *	the configuration package.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacConfig.c,v 1.1.2.2 1998/09/30 02:18:04 stanton Exp $
 */

#include "tk.h"
#include "tkInt.h"


/*
 *----------------------------------------------------------------------
 *
 * TkpGetSystemDefault --
 *
 *	Given a dbName and className for a configuration option,
 *	return a string representation of the option.
 *
 * Results:
 *	Returns a Tk_Uid that is the string identifier that identifies
 *	this option. Returns NULL if there are no system defaults
 *	that match this pair.
 *
 * Side effects:
 *	None, once the package is initialized.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TkpGetSystemDefault(
    Tk_Window tkwin,		/* A window to use. */
    char *dbName,		/* The option database name. */
    char *className)		/* The name of the option class. */
{
    return NULL;
}

Changes to mac/tkMacCursor.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkMacCursor.c --
 *
 *	This file contains Macintosh specific cursor related routines.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacCursor.c 1.20 97/09/17 19:33:13
 */

#include "tkPort.h"
#include "tkInt.h"
#include "tkMacInt.h"

#include <Resources.h>










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkMacCursor.c --
 *
 *	This file contains Macintosh specific cursor related routines.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacCursor.c,v 1.1.4.3 1999/03/10 07:13:48 stanton Exp $
 */

#include "tkPort.h"
#include "tkInt.h"
#include "tkMacInt.h"

#include <Resources.h>
60
61
62
63
64
65
66
67
68
69







70
71
72
73
74
75
76

/*
 * Declarations of static variables used in this file.
 */

static TkMacCursor * gCurrentCursor = NULL;  /* A pointer to the current
					      * cursor. */
static int gResizeOverride = false;	     /* A boolean indicating wether
					      * we should use the resize
					      * cursor during installations. */








/*
 * Declarations of procedures local to this file
 */

static  void FindCursorByName _ANSI_ARGS_ ((TkMacCursor *macCursorPtr,
	             char *string));







|


>
>
>
>
>
>
>







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

/*
 * Declarations of static variables used in this file.
 */

static TkMacCursor * gCurrentCursor = NULL;  /* A pointer to the current
					      * cursor. */
static int gResizeOverride = false;	     /* A boolean indicating whether
					      * we should use the resize
					      * cursor during installations. */
static int gTkOwnsCursor = true;             /* A boolean indicating whether
                                                Tk owns the cursor.  If not (for
                                                instance, in the case where a Tk 
                                                window is embedded in another app's
                                                window, and the cursor is out of
                                                the tk window, we will not attempt
                                                to adjust the cursor */

/*
 * Declarations of procedures local to this file
 */

static  void FindCursorByName _ANSI_ARGS_ ((TkMacCursor *macCursorPtr,
	             char *string));
98
99
100
101
102
103
104

105
106
107
108
109
110



111






112
113
114
115
116
117
118
void 
FindCursorByName(
    TkMacCursor *macCursorPtr,
    char *string)
{
    Handle resource;
    Str255 curName;

    
    curName[0] = strlen(string);
    if (curName[0] > 255) {
        return;
    }
    



    strcpy((char *) curName + 1, string);






    resource = GetNamedResource('crsr', curName);

    if (resource != NULL) {
	short id;
	Str255 theName;
	ResType	theType;








>

|
|


|
>
>
>
|
>
>
>
>
>
>







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
void 
FindCursorByName(
    TkMacCursor *macCursorPtr,
    char *string)
{
    Handle resource;
    Str255 curName;
    int destWrote, inCurLen;
    
    inCurLen = strlen(string);
    if (inCurLen > 255) {
        return;
    }

    /*
     * macRoman is the encoding that the resource fork uses.
     */

    Tcl_UtfToExternal(NULL, Tcl_GetEncoding(NULL, "macRoman"), string,
	    inCurLen, 0, NULL, 
	    (char *) &curName[1],
	    255, NULL, &destWrote, NULL); /* Internalize native */
    curName[0] = destWrote;

    resource = GetNamedResource('crsr', curName);

    if (resource != NULL) {
	short id;
	Str255 theName;
	ResType	theType;

241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
{
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TkFreeCursor --
 *
 *	This procedure is called to release a cursor allocated by
 *	TkGetCursorByName.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The cursor data structure is deallocated.
 *
 *----------------------------------------------------------------------
 */

void
TkFreeCursor(
    TkCursor *cursorPtr)
{
    TkMacCursor *macCursorPtr = (TkMacCursor *) cursorPtr;

    switch (macCursorPtr->type) {
	case COLOR:
	    DisposeCCursor((CCrsrHandle) macCursorPtr->macCursor);
	    break;
	case NORMAL:
	    ReleaseResource(macCursorPtr->macCursor);
	    break;
    }

    if (macCursorPtr == gCurrentCursor) {
	gCurrentCursor = NULL;
    }
    
    ckfree((char *) macCursorPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TkMacInstallCursor --
 *







|














|
















<
<







258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296


297
298
299
300
301
302
303
{
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TkpFreeCursor --
 *
 *	This procedure is called to release a cursor allocated by
 *	TkGetCursorByName.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The cursor data structure is deallocated.
 *
 *----------------------------------------------------------------------
 */

void
TkpFreeCursor(
    TkCursor *cursorPtr)
{
    TkMacCursor *macCursorPtr = (TkMacCursor *) cursorPtr;

    switch (macCursorPtr->type) {
	case COLOR:
	    DisposeCCursor((CCrsrHandle) macCursorPtr->macCursor);
	    break;
	case NORMAL:
	    ReleaseResource(macCursorPtr->macCursor);
	    break;
    }

    if (macCursorPtr == gCurrentCursor) {
	gCurrentCursor = NULL;
    }


}

/*
 *----------------------------------------------------------------------
 *
 * TkMacInstallCursor --
 *
344
345
346
347
348
349
350



351
352
353
354
355
356
357
358
359
360























 *----------------------------------------------------------------------
 */

void
TkpSetCursor(
    TkpCursor cursor)
{



    if (cursor == None) {
	gCurrentCursor = NULL;
    } else {
	gCurrentCursor = (TkMacCursor *) cursor;
    }

    if (tkMacAppInFront) {
	TkMacInstallCursor(gResizeOverride);
    }
}






























>
>
>










>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
 *----------------------------------------------------------------------
 */

void
TkpSetCursor(
    TkpCursor cursor)
{
    if (!gTkOwnsCursor) {
        return;
    }
    if (cursor == None) {
	gCurrentCursor = NULL;
    } else {
	gCurrentCursor = (TkMacCursor *) cursor;
    }

    if (tkMacAppInFront) {
	TkMacInstallCursor(gResizeOverride);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_MacTkOwnsCursor --
 *
 *	Sets whether Tk has the right to adjust the cursor.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May keep Tk from changing the cursor.
 *
 *----------------------------------------------------------------------
 */

void
Tk_MacTkOwnsCursor(
    int tkOwnsIt)
{
    gTkOwnsCursor = tkOwnsIt;
}

Changes to mac/tkMacCursors.r.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkMacCursors.r --
 *
 *	This file defines a set of Macintosh cursor resources that
 * 	are only available on the Macintosh platform.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacCursors.r 1.3 96/01/25 10:24:15
 */

/*
 * These are resource definitions for Macintosh cursors.
 * The are identified and loaded by the "name" of the
 * cursor.  However, the ids must be unique.
 */











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkMacCursors.r --
 *
 *	This file defines a set of Macintosh cursor resources that
 * 	are only available on the Macintosh platform.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacCursors.r,v 1.1.4.1 1998/09/30 02:18:04 stanton Exp $
 */

/*
 * These are resource definitions for Macintosh cursors.
 * The are identified and loaded by the "name" of the
 * cursor.  However, the ids must be unique.
 */

Changes to mac/tkMacDefault.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkMacDefault.h --
 *
 *	This file defines the defaults for all options for all of
 *	the Tk widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacDefault.h 1.48 97/10/09 17:45:04
 */

#ifndef _TKMACDEFAULT
#define _TKMACDEFAULT

/*
 * The definitions below provide symbolic names for the default colors.












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkMacDefault.h --
 *
 *	This file defines the defaults for all options for all of
 *	the Tk widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacDefault.h,v 1.1.4.4 1999/02/16 06:00:42 lfb Exp $
 */

#ifndef _TKMACDEFAULT
#define _TKMACDEFAULT

/*
 * The definitions below provide symbolic names for the default colors.
57
58
59
60
61
62
63

64
65
66
67
68
69
70
71
#define DEF_BUTTON_DEFAULT		"disabled"
#define DEF_BUTTON_DISABLED_FG_COLOR	DISABLED
#define DEF_BUTTON_DISABLED_FG_MONO	""
#define DEF_BUTTON_FG			"systemButtonText"
#define DEF_CHKRAD_FG			DEF_BUTTON_FG
#define DEF_BUTTON_FONT			"system"
#define DEF_BUTTON_HEIGHT		"0"

#define DEF_BUTTON_HIGHLIGHT_BG		NORMAL_BG
#define DEF_BUTTON_HIGHLIGHT		"systemButtonFrame"
#define DEF_LABEL_HIGHLIGHT_WIDTH	"0"
#define DEF_BUTTON_HIGHLIGHT_WIDTH	"4"
#define DEF_BUTTON_IMAGE		(char *) NULL
#define DEF_BUTTON_INDICATOR		"1"
#define DEF_BUTTON_JUSTIFY		"center"
#define DEF_BUTTON_OFF_VALUE		"0"







>
|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
#define DEF_BUTTON_DEFAULT		"disabled"
#define DEF_BUTTON_DISABLED_FG_COLOR	DISABLED
#define DEF_BUTTON_DISABLED_FG_MONO	""
#define DEF_BUTTON_FG			"systemButtonText"
#define DEF_CHKRAD_FG			DEF_BUTTON_FG
#define DEF_BUTTON_FONT			"system"
#define DEF_BUTTON_HEIGHT		"0"
#define DEF_BUTTON_HIGHLIGHT_BG_COLOR	DEF_BUTTON_BG_COLOR
#define DEF_BUTTON_HIGHLIGHT_BG_MONO	DEF_BUTTON_BG_MONO
#define DEF_BUTTON_HIGHLIGHT		"systemButtonFrame"
#define DEF_LABEL_HIGHLIGHT_WIDTH	"0"
#define DEF_BUTTON_HIGHLIGHT_WIDTH	"4"
#define DEF_BUTTON_IMAGE		(char *) NULL
#define DEF_BUTTON_INDICATOR		"1"
#define DEF_BUTTON_JUSTIFY		"center"
#define DEF_BUTTON_OFF_VALUE		"0"
284
285
286
287
288
289
290

291
292
293
294
295
296
297
298
#define DEF_MENUBUTTON_CURSOR		""
#define DEF_MENUBUTTON_DIRECTION	"below"
#define DEF_MENUBUTTON_DISABLED_FG_COLOR DISABLED
#define DEF_MENUBUTTON_DISABLED_FG_MONO	""
#define DEF_MENUBUTTON_FONT		"system"
#define DEF_MENUBUTTON_FG		BLACK
#define DEF_MENUBUTTON_HEIGHT		"0"

#define DEF_MENUBUTTON_HIGHLIGHT_BG	NORMAL_BG
#define DEF_MENUBUTTON_HIGHLIGHT	BLACK
#define DEF_MENUBUTTON_HIGHLIGHT_WIDTH	"0"
#define DEF_MENUBUTTON_IMAGE		(char *) NULL
#define DEF_MENUBUTTON_INDICATOR	"0"
/* #define DEF_MENUBUTTON_JUSTIFY		"center" */
#define DEF_MENUBUTTON_JUSTIFY		"left"
#define DEF_MENUBUTTON_MENU		""







>
|







285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
#define DEF_MENUBUTTON_CURSOR		""
#define DEF_MENUBUTTON_DIRECTION	"below"
#define DEF_MENUBUTTON_DISABLED_FG_COLOR DISABLED
#define DEF_MENUBUTTON_DISABLED_FG_MONO	""
#define DEF_MENUBUTTON_FONT		"system"
#define DEF_MENUBUTTON_FG		BLACK
#define DEF_MENUBUTTON_HEIGHT		"0"
#define DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR DEF_MENUBUTTON_BG_COLOR
#define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO  DEF_MENUBUTTON_BG_MONO
#define DEF_MENUBUTTON_HIGHLIGHT	BLACK
#define DEF_MENUBUTTON_HIGHLIGHT_WIDTH	"0"
#define DEF_MENUBUTTON_IMAGE		(char *) NULL
#define DEF_MENUBUTTON_INDICATOR	"0"
/* #define DEF_MENUBUTTON_JUSTIFY		"center" */
#define DEF_MENUBUTTON_JUSTIFY		"left"
#define DEF_MENUBUTTON_MENU		""
344
345
346
347
348
349
350

351
352
353
354
355
356
357
358
#define DEF_SCALE_COMMAND		""
#define DEF_SCALE_CURSOR		""
#define DEF_SCALE_DIGITS		"0"
#define DEF_SCALE_FONT			"system"
#define DEF_SCALE_FG_COLOR		BLACK
#define DEF_SCALE_FG_MONO		BLACK
#define DEF_SCALE_FROM			"0"

#define DEF_SCALE_HIGHLIGHT_BG		NORMAL_BG
#define DEF_SCALE_HIGHLIGHT		BLACK
#define DEF_SCALE_HIGHLIGHT_WIDTH	"0"
#define DEF_SCALE_LABEL			""
#define DEF_SCALE_LENGTH		"100"
#define DEF_SCALE_ORIENT		"vertical"
#define DEF_SCALE_RELIEF		"flat"
#define DEF_SCALE_REPEAT_DELAY	"300"







>
|







346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
#define DEF_SCALE_COMMAND		""
#define DEF_SCALE_CURSOR		""
#define DEF_SCALE_DIGITS		"0"
#define DEF_SCALE_FONT			"system"
#define DEF_SCALE_FG_COLOR		BLACK
#define DEF_SCALE_FG_MONO		BLACK
#define DEF_SCALE_FROM			"0"
#define DEF_SCALE_HIGHLIGHT_BG_COLOR	DEF_SCALE_BG_COLOR
#define DEF_SCALE_HIGHLIGHT_BG_MONO	DEF_SCALE_BG_MONO
#define DEF_SCALE_HIGHLIGHT		BLACK
#define DEF_SCALE_HIGHLIGHT_WIDTH	"0"
#define DEF_SCALE_LABEL			""
#define DEF_SCALE_LENGTH		"100"
#define DEF_SCALE_ORIENT		"vertical"
#define DEF_SCALE_RELIEF		"flat"
#define DEF_SCALE_REPEAT_DELAY	"300"

Changes to mac/tkMacDialog.c.

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







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185

186
















187

























188
























189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295

296
297
298
299
300
301
302
303
304
305
306
307
308
309


310
311



312



313
314
315


316
317
318


319

320
321
322

323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411

412
413
414








415
416
417
418
419
420
421
































































422
423


424
425






426












427

428
429
430
431
432
433
434
435
436
437
438
439
440
441

442
443
444
445
446
447

448
449
450
451
452




453
454
455
456
457
458
459
460
461
462
463
464
465

466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505

506
507
508


509
510
511

512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
/*
 * tkMacDialog.c --
 *
 *	Contains the Mac implementation of the common dialog boxes.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacDialog.c 1.12 96/12/03 11:15:12
 *
 */

#include <Gestalt.h>
#include <Aliases.h>
#include <Errors.h>
#include <Strings.h>
#include <MoreFiles.h>
#include <MoreFilesExtras.h>
#include <StandardFile.h>
#include <ColorPicker.h>
#include <Lowmem.h>
#include "tkPort.h"
#include "tkInt.h"
#include "tclMacInt.h"
#include "tkFileFilter.h"








/*
 * The following are ID's for resources that are defined in tkMacResource.r
 */
#define OPEN_BOX        130
#define OPEN_POPUP      131
#define OPEN_MENU       132
#define OPEN_POPUP_ITEM 10

#define SAVE_FILE	0
#define OPEN_FILE	1

#define MATCHED		0
#define UNMATCHED	1

/*
 * The following structure is used in the GetFileName() function. It stored
 * information about the file dialog and the file filters.
 */
typedef struct _OpenFileData {
    Tcl_Interp * interp;
    char * initialFile;			/* default file to appear in the
					 * save dialog */
    char * defExt;			/* default extension (not used on the
					 * Mac) */
    FileFilterList fl;			/* List of file filters. */
    SInt16 curType;			/* The filetype currently being
					 * listed */
    int isOpen;				/* True if this is an Open dialog,
					 * false if it is a Save dialog. */
    MenuHandle menu;			/* Handle of the menu in the popup*/
    short dialogId;			/* resource ID of the dialog */
    int popupId;			/* resource ID of the popup */
    short popupItem;			/* item number of the popup in the
					 * dialog */
    int usePopup;			/* True if we show the popup menu (this
    					 * is an open operation and the
					 * -filetypes option is set)
    					 */
} OpenFileData;

static pascal Boolean	FileFilterProc _ANSI_ARGS_((CInfoPBPtr pb,
			    void *myData));
static int 		GetFileName _ANSI_ARGS_ ((
			    ClientData clientData, Tcl_Interp *interp,
    			    int argc, char **argv, int isOpen ));
static Boolean		MatchOneType _ANSI_ARGS_((CInfoPBPtr pb,
			    OpenFileData * myDataPtr, FileFilter * filterPtr));
static pascal short 	OpenHookProc _ANSI_ARGS_((short item,
			    DialogPtr theDialog, OpenFileData * myDataPtr));
static int 		ParseFileDlgArgs _ANSI_ARGS_ ((Tcl_Interp * interp,
			    OpenFileData * myDataPtr, int argc, char ** argv,
			    int isOpen));

/*
 * Filter and hook functions used by the tk_getOpenFile and tk_getSaveFile
 * commands.
 */

static FileFilterYDUPP openFilter = NULL;
static DlgHookYDUPP openHook = NULL;
static DlgHookYDUPP saveHook = NULL;
  

/*
 *----------------------------------------------------------------------
 *
 * EvalArgv --
 *
 *	Invokes the Tcl procedure with the arguments. argv[0] is set by
 *	the caller of this function. It may be different than cmdName.
 *	The TCL command will see argv[0], not cmdName, as its name if it
 *	invokes [lindex [info level 0] 0]
 *
 * Results:
 *	TCL_ERROR if the command does not exist and cannot be autoloaded.
 *	Otherwise, return the result of the evaluation of the command.
 *
 * Side effects:
 *	The command may be autoloaded.
 *
 *----------------------------------------------------------------------
 */

static int
EvalArgv(
    Tcl_Interp *interp,		/* Current interpreter. */
    char * cmdName,		/* Name of the TCL command to call */
    int argc,			/* Number of arguments. */
    char **argv)		/* Argument strings. */
{
    Tcl_CmdInfo cmdInfo;

    if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
	char * cmdArgv[2];

	/*
	 * This comand is not in the interpreter yet -- looks like we
	 * have to auto-load it
	 */
	if (!Tcl_GetCommandInfo(interp, "auto_load", &cmdInfo)) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "cannot execute command \"auto_load\"",
		NULL);
	    return TCL_ERROR;
	}

	cmdArgv[0] = "auto_load";
	cmdArgv[1] = cmdName;

	if ((*cmdInfo.proc)(cmdInfo.clientData, interp, 2, cmdArgv)!= TCL_OK){ 
	    return TCL_ERROR;
	}

	if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "cannot auto-load command \"",
		cmdName, "\"",NULL);
	    return TCL_ERROR;
	}
    }

    return (*cmdInfo.proc)(cmdInfo.clientData, interp, argc, argv);
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_ChooseColorCmd --
 *
 *	This procedure implements the color dialog box for the Mac
 *	platform. See the user documentation for details on what it
 *	does.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tk_ChooseColorCmd(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    char **argv)		/* Argument strings. */
{
    Tk_Window parent = Tk_MainWindow(interp);
    char * colorStr = NULL;
    XColor * colorPtr = NULL;
    char * title = "Choose a color:";
    int i, version;
    long response = 0;
    OSErr err = noErr;
    char buff[40];

    static RGBColor in;
















    static inited = 0;


















































    /*
     * Use the gestalt manager to determine how to bring
     * up the color picker.  If versin 2.0 isn't available
     * we can assume version 1.0 is available as it comes with
     * Color Quickdraw which Tk requires to run at all.
     */
     
    err = Gestalt(gestaltColorPicker, &response); 
    if ((err == noErr) || (response == 0x0200L)) {
    	version = 2;
    } else {
    	version = 1;
    }
 
    for (i=1; i<argc; i+=2) {
        int v = i+1;
	int len = strlen(argv[i]);

        if (strncmp(argv[i], "-initialcolor", len)==0) {
	    if (v==argc) {goto arg_missing;}

	    colorStr = argv[v];
	} else if (strncmp(argv[i], "-parent", len)==0) {
	    if (v==argc) {goto arg_missing;}

	    parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
	    if (parent == NULL) {
		return TCL_ERROR;
	    }
	} else if (strncmp(argv[i], "-title", len)==0) {
	    if (v==argc) {goto arg_missing;}

	    title = argv[v];
	} else {
    	    Tcl_AppendResult(interp, "unknown option \"", 
		    argv[i], "\", must be -initialcolor, -parent or -title",
		    NULL);
	    return TCL_ERROR;
	}
    }

    if (colorStr) {
        colorPtr = Tk_GetColor(interp, parent, colorStr);
        if (colorPtr == NULL) {
            return TCL_ERROR;
        }
    }

    if (!inited) {
        inited = 1;
        in.red = 0xffff;
        in.green = 0xffff;
        in.blue = 0xffff;
    }
    if (colorPtr) {
        in.red   = colorPtr->red;
        in.green = colorPtr->green;
        in.blue  = colorPtr->blue;
    }
        
    if (version == 1) {
        /*
         * Use version 1.0 of the color picker
         */
    	
    	RGBColor out;
    	Str255 prompt;
    	Point point = {-1, -1};
    	
        prompt[0] = strlen(title);
        strncpy((char*) prompt+1, title, 255);
        
        if (GetColor(point, prompt, &in, &out)) {
            /*
             * user selected a color
             */
            sprintf(buff, "#%02x%02x%02x", out.red >> 8, out.green >> 8,
                out.blue >> 8);
            Tcl_SetResult(interp, buff, TCL_VOLATILE);

            /*
             * Save it for the next time
             */
            in.red   = out.red;
            in.green = out.green;
            in.blue  = out.blue;
        } else {
            Tcl_ResetResult(interp);
    	}
    } else {
        /*
         * Version 2.0 of the color picker is available. Let's use it
         */
	ColorPickerInfo cpinfo;

    	cpinfo.theColor.profile = 0L;
    	cpinfo.theColor.color.rgb.red   = in.red;
    	cpinfo.theColor.color.rgb.green = in.green;
    	cpinfo.theColor.color.rgb.blue  = in.blue;
    	cpinfo.dstProfile = 0L;
    	cpinfo.flags = CanModifyPalette | CanAnimatePalette;
    	cpinfo.placeWhere = kDeepestColorScreen;
    	cpinfo.pickerType = 0L;
    	cpinfo.eventProc = NULL;
    	cpinfo.colorProc = NULL;
    	cpinfo.colorProcData = NULL;


        cpinfo.prompt[0] = strlen(title);
        strncpy((char*)cpinfo.prompt+1, title, 255);
        
        if ((PickColor(&cpinfo) == noErr) && cpinfo.newColorChosen) {
            sprintf(buff, "#%02x%02x%02x",
		cpinfo.theColor.color.rgb.red   >> 8, 
                cpinfo.theColor.color.rgb.green >> 8,
		cpinfo.theColor.color.rgb.blue  >> 8);
            Tcl_SetResult(interp, buff, TCL_VOLATILE);
            
            in.blue  = cpinfo.theColor.color.rgb.red;
    	    in.green = cpinfo.theColor.color.rgb.green;
    	    in.blue  = cpinfo.theColor.color.rgb.blue;
          } else {


            Tcl_ResetResult(interp);
        }



    }




    if (colorPtr) {
	Tk_FreeColor(colorPtr);


    }

    return TCL_OK;




  arg_missing:
    Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
	NULL);

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetOpenFileCmd --
 *
 *	This procedure implements the "open file" dialog box for the
 *	Mac platform. See the user documentation for details on what
 *	it does.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *	See user documentation.
 *----------------------------------------------------------------------
 */

int
Tk_GetOpenFileCmd(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    char **argv)		/* Argument strings. */
{
    return GetFileName(clientData, interp, argc, argv, OPEN_FILE);
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetSaveFileCmd --
 *
 *	Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
 *	instead
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *	See user documentation.
 *----------------------------------------------------------------------
 */

int
Tk_GetSaveFileCmd(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    char **argv)		/* Argument strings. */
{
    return GetFileName(clientData, interp, argc, argv, SAVE_FILE);
}

/*
 *----------------------------------------------------------------------
 *
 * GetFileName --
 *
 *	Calls the Mac file dialog functions for the user to choose a
 *	file to or save.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	If the user selects a file, the native pathname of the file
 *	is returned in interp->result. Otherwise an empty string
 *	is returned in interp->result.
 *
 *----------------------------------------------------------------------
 */

static int
GetFileName(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    char **argv,		/* Argument strings. */
    int isOpen)			/* true if we should call GetOpenFileName(),
				 * false if we should call GetSaveFileName() */
{
    int code = TCL_OK;
    int i;
    OpenFileData myData, *myDataPtr;
    StandardFileReply reply;
    Point mypoint;

    Str255 str;

    myDataPtr = &myData;









    if (openFilter == NULL) {
	openFilter = NewFileFilterYDProc(FileFilterProc);
	openHook = NewDlgHookYDProc(OpenHookProc);
	saveHook = NewDlgHookYDProc(OpenHookProc);
    }

































































    /*
     * 1. Parse the arguments.


     */
    if (ParseFileDlgArgs(interp, myDataPtr, argc, argv, isOpen) 






	!= TCL_OK) {












	return TCL_ERROR;

    }

    /*
     * 2. Set the items in the file types popup.
     */

    /*
     * Delete all the entries inside the popup menu, in case there's any
     * left overs from previous invocation of this command
     */

    if (myDataPtr->usePopup) {
	FileFilter * filterPtr;


        for (i=CountMItems(myDataPtr->menu); i>0; i--) {
            /*
             * The item indices are one based. Also, if we delete from
             * the beginning, the items may be re-numbered. So we
             * delete from the end
    	     */

    	     DeleteMenuItem(myDataPtr->menu, i);
        }

	if (myDataPtr->fl.filters) {
	    for (filterPtr=myDataPtr->fl.filters; filterPtr;




		    filterPtr=filterPtr->next) {
		strncpy((char*)str+1, filterPtr->name, 254);
		str[0] = strlen(filterPtr->name);
		AppendMenu(myDataPtr->menu, (ConstStr255Param) str);
	    }
	} else {
	    myDataPtr->usePopup = 0;
	}
    }

    /*
     * 3. Call the toolbox file dialog function.
     */

    SetPt(&mypoint, -1, -1);
    TkpSetCursor(NULL);
    
    if (myDataPtr->isOpen) {
        if (myDataPtr->usePopup) {
	    CustomGetFile(openFilter, (short) -1, NULL, &reply, 
	        myDataPtr->dialogId, 
	        mypoint, openHook, NULL, NULL, NULL, (void*)myDataPtr);
	} else {
	    StandardGetFile(NULL, -1, NULL, &reply);
	}
    } else {
	Str255 prompt, def;

	strcpy((char*)prompt+1, "Save as");
	prompt[0] = strlen("Save as");
   	if (myDataPtr->initialFile) {
   	    strncpy((char*)def+1, myDataPtr->initialFile, 254);
	    def[0] = strlen(myDataPtr->initialFile);
        } else {
            def[0] = 0;
        }
   	if (myDataPtr->usePopup) {
   	    /*
   	     * Currently this never gets called because we don't use
   	     * popup for the save dialog.
   	     */
	    CustomPutFile(prompt, def, &reply, myDataPtr->dialogId, mypoint, 
	        saveHook, NULL, NULL, NULL, myDataPtr);
	} else {
	    StandardPutFile(prompt, def, &reply);
	}
    }

    Tcl_ResetResult(interp);    
    if (reply.sfGood) {
        int length;
    	Handle pathHandle = NULL;
    	char * pathName = NULL;
    	

    	FSpPathFromLocation(&reply.sfFile, &length, &pathHandle);

	if (pathHandle != NULL) {


	    HLock(pathHandle);
	    pathName = (char *) ckalloc((unsigned) (length + 1));
	    strcpy(pathName, *pathHandle);

	    HUnlock(pathHandle);
	    DisposeHandle(pathHandle);

	    /*
	     * Return the full pathname of the selected file
	     */

	    Tcl_SetResult(interp, pathName, TCL_DYNAMIC);
	}
    }

  done:
    TkFreeFileFilters(&myDataPtr->fl);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseFileDlgArgs --
 *
 *	Parses the arguments passed to tk_getOpenFile and tk_getSaveFile.
 *
 * Results:
 *	A standard TCL return value.
 *
 * Side effects:
 *	The OpenFileData structure is initialized and modified according
 *	to the arguments.
 *
 *----------------------------------------------------------------------
 */

static int
ParseFileDlgArgs(
    Tcl_Interp * interp,		/* Current interpreter. */
    OpenFileData * myDataPtr,		/* Information about the file dialog */
    int argc,				/* Number of arguments */
    char ** argv,			/* Argument strings */
    int isOpen)				/* TRUE if this is an "open" dialog */
{
    int i;

    myDataPtr->interp      	= interp;
    myDataPtr->initialFile 	= NULL;
    myDataPtr->curType		= 0;

    TkInitFileFilters(&myDataPtr->fl);
    
    if (isOpen) {
	myDataPtr->isOpen    = 1;
        myDataPtr->usePopup  = 1;
	myDataPtr->menu      = GetMenu(OPEN_MENU);
	myDataPtr->dialogId  = OPEN_BOX;
	myDataPtr->popupId   = OPEN_POPUP;
	myDataPtr->popupItem = OPEN_POPUP_ITEM;
	if (myDataPtr->menu == NULL) {
	    Debugger();
	}
    } else {
        myDataPtr->isOpen    = 0;
	myDataPtr->usePopup  = 0;
    }

    for (i=1; i<argc; i+=2) {
        int v = i+1;
	int len = strlen(argv[i]);

	if (strncmp(argv[i], "-defaultextension", len)==0) {
	    if (v==argc) {goto arg_missing;}

	    myDataPtr->defExt = argv[v];
	}
	else if (strncmp(argv[i], "-filetypes", len)==0) {
	    if (v==argc) {goto arg_missing;}

	    if (TkGetFileFilters(interp, &myDataPtr->fl,argv[v],0) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
	else if (strncmp(argv[i], "-initialdir", len)==0) {
	    FSSpec dirSpec;
	    char * dirName;
	    Tcl_DString dstring;
	    long dirID;
	    OSErr err;
	    Boolean isDirectory;

	    if (v==argc) {goto arg_missing;}
	    
	    if (Tcl_TranslateFileName(interp, argv[v], &dstring) == NULL) {
	        return TCL_ERROR;
	    }
	    dirName = dstring.string;
	    if (FSpLocationFromPath(strlen(dirName), dirName, &dirSpec) != 
		    noErr) {
		Tcl_AppendResult(interp, "bad directory \"", argv[v],
	            "\"", NULL);
	        return TCL_ERROR;
	    }
	    err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
	    if ((err != noErr) || !isDirectory) {
		Tcl_AppendResult(interp, "bad directory \"", argv[v],
	            "\"", NULL);
	        return TCL_ERROR;
	    }
	    /*
	     * Make sure you negate -dirSpec.vRefNum because the standard file
	     * package wants it that way !
	     */
	    LMSetSFSaveDisk(-dirSpec.vRefNum);
	    LMSetCurDirStore(dirID);
	    Tcl_DStringFree(&dstring);
    	}
	else if (strncmp(argv[i], "-initialfile", len)==0) {
	    if (v==argc) {goto arg_missing;}
	    
	    myDataPtr->initialFile = argv[v];
	}
	else if (strncmp(argv[i], "-parent", len)==0) {
	    /*
	     * Ignored on the Mac, but make sure that it's a valid window
	     * pathname
	     */
	    Tk_Window parent;

	    if (v==argc) {goto arg_missing;}
	    	    
	    parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
	    if (parent == NULL) {
		return TCL_ERROR;
	    }	    
	}
	else if (strncmp(argv[i], "-title", len)==0) {
	    if (v==argc) {goto arg_missing;}
	    
	    /*
	     * This option is ignored on the Mac because the Mac file
	     * dialog do not support titles.
	     */
	}
	else {
    	    Tcl_AppendResult(interp, "unknown option \"", 
		argv[i], "\", must be -defaultextension, ",
		"-filetypes, -initialdir, -initialfile, -parent or -title",
		NULL);
	    return TCL_ERROR;
	}
    }

    return TCL_OK;

  arg_missing:
    Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
	NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * OpenHookProc --
 *
 *	Gets called for various events that occur in the file dialog box.
 *	Initializes the popup menu or rebuild the file list depending on





|




|
<















>
>
>
>
>
>
>




















<
<
<
<
<


|
<
<
<
<
<
|
|


|
<




|
|
|

|

|

|















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















|


|
|

|
|
<
<
|
|
|
<
>

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

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








|
<
<
<
<
|
<
<
<

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

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


<












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

<
|
>
>
|
|
|
>
>

>
|
|
<
>
|





|














|


|
|

|





|













|


|
|

|















|
|








|
|



<
|
|


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






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











|
|
|
>
|





>
|


|
|
>
>
>
>
|
|
|
|

<
<






>


<
|
|
|
<
|




|
|
<
<
<
<
<
<
<
<
|




|
|

|



<


|
<

>

<

>
>

|
|
>


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

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







1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53





54
55
56





57
58
59
60
61

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89





























































90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113


114
115
116

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194




195



196











































197





























198
199

200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217

218
219
220
221
222



223
224
225
226
227
228
229
230
231
232
233
234
235

236
237
238
239
240
241
242
243
244
245
246
247

248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332

333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420

421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481


482
483
484
485
486
487
488
489
490

491
492
493

494
495
496
497
498
499
500








501
502
503
504
505
506
507
508
509
510
511
512

513
514
515

516
517
518

519
520
521
522
523
524
525
526
527
528



529

530














531































































532

533


























534












535





536




537









538
539






540
541
542
543
544
545
546
/*
 * tkMacDialog.c --
 *
 *	Contains the Mac implementation of the common dialog boxes.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacDialog.c,v 1.1.4.2 1998/09/30 02:18:05 stanton Exp $

 */

#include <Gestalt.h>
#include <Aliases.h>
#include <Errors.h>
#include <Strings.h>
#include <MoreFiles.h>
#include <MoreFilesExtras.h>
#include <StandardFile.h>
#include <ColorPicker.h>
#include <Lowmem.h>
#include "tkPort.h"
#include "tkInt.h"
#include "tclMacInt.h"
#include "tkFileFilter.h"

#ifndef StrLength
#define StrLength(s) 		(*((unsigned char *) (s)))
#endif
#ifndef StrBody
#define StrBody(s)		((char *) (s) + 1)
#endif

/*
 * The following are ID's for resources that are defined in tkMacResource.r
 */
#define OPEN_BOX        130
#define OPEN_POPUP      131
#define OPEN_MENU       132
#define OPEN_POPUP_ITEM 10

#define SAVE_FILE	0
#define OPEN_FILE	1

#define MATCHED		0
#define UNMATCHED	1

/*
 * The following structure is used in the GetFileName() function. It stored
 * information about the file dialog and the file filters.
 */
typedef struct _OpenFileData {





    FileFilterList fl;			/* List of file filters. */
    SInt16 curType;			/* The filetype currently being
					 * listed. */





    short popupItem;			/* Item number of the popup in the
					 * dialog. */
    int usePopup;			/* True if we show the popup menu (this
    					 * is an open operation and the
					 * -filetypes option is set). */

} OpenFileData;

static pascal Boolean	FileFilterProc _ANSI_ARGS_((CInfoPBPtr pb,
			    void *myData));
static int 		GetFileName _ANSI_ARGS_ ((ClientData clientData, 
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[], int isOpen));
static Boolean		MatchOneType _ANSI_ARGS_((CInfoPBPtr pb,
			    OpenFileData *myofdPtr, FileFilter *filterPtr));
static pascal short 	OpenHookProc _ANSI_ARGS_((short item,
			    DialogPtr theDialog, OpenFileData * myofdPtr));
static int 		ParseFileDlgArgs _ANSI_ARGS_ ((Tcl_Interp * interp,
			    OpenFileData * myofdPtr, int argc, char ** argv,
			    int isOpen));

/*
 * Filter and hook functions used by the tk_getOpenFile and tk_getSaveFile
 * commands.
 */

static FileFilterYDUPP openFilter = NULL;
static DlgHookYDUPP openHook = NULL;
static DlgHookYDUPP saveHook = NULL;
  

/*
 *----------------------------------------------------------------------
 *





























































 * Tk_ChooseColorObjCmd --
 *
 *	This procedure implements the color dialog box for the Mac
 *	platform. See the user documentation for details on what it
 *	does.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tk_ChooseColorObjCmd(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    Tk_Window parent;
    char *title;


    int i, picked, srcRead, dstWrote;
    long response;
    OSErr err;

    static inited = 0;
    static RGBColor in;
    static char *optionStrings[] = {
	"-initialcolor",    "-parent",	    "-title",	    NULL
    };
    enum options {
	COLOR_INITIAL,	    COLOR_PARENT,   COLOR_TITLE
    };

    if (inited == 0) {
    	/*
    	 * 'in' stores the last color picked.  The next time the color dialog
    	 * pops up, the last color will remain in the dialog.
    	 */
    	 
        in.red = 0xffff;
        in.green = 0xffff;
        in.blue = 0xffff;
        inited = 1;
    }
    
    parent = (Tk_Window) clientData;
    title = "Choose a color:";
    picked = 0;
        
    for (i = 1; i < objc; i += 2) {
    	int index;
    	char *option, *value;
    	
        if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (i + 1 == objc) {
	    option = Tcl_GetStringFromObj(objv[i], NULL);
	    Tcl_AppendResult(interp, "value for \"", option, "\" missing", 
		    (char *) NULL);
	    return TCL_ERROR;
	}
	value = Tcl_GetStringFromObj(objv[i + 1], NULL);
	
	switch ((enum options) index) {
	    case COLOR_INITIAL: {
		XColor *colorPtr;

		colorPtr = Tk_GetColor(interp, parent, value);
		if (colorPtr == NULL) {
		    return TCL_ERROR;
		}
		in.red   = colorPtr->red;
		in.green = colorPtr->green;
                in.blue  = colorPtr->blue;
                Tk_FreeColor(colorPtr);
		break;
	    }
	    case COLOR_PARENT: {
		parent = Tk_NameToWindow(interp, value, parent);
		if (parent == NULL) {
		    return TCL_ERROR;
		}
		break;
	    }
	    case COLOR_TITLE: {
	        title = value;
		break;
	    }
	}
    }
        
    /*
     * Use the gestalt manager to determine how to bring
     * up the color picker.  If versin 2.0 isn't available
     * we can assume version 1.0 is available as it comes with
     * Color Quickdraw which Tk requires to run at all.
     */
     
    err = Gestalt(gestaltColorPicker, &response); 
    if ((err == noErr) && (response == 0x0200L)) {




	ColorPickerInfo cpinfo;















































        /*





























         * Version 2.0 of the color picker is available. Let's use it
         */


    	cpinfo.theColor.profile = 0L;
    	cpinfo.theColor.color.rgb.red   = in.red;
    	cpinfo.theColor.color.rgb.green = in.green;
    	cpinfo.theColor.color.rgb.blue  = in.blue;
    	cpinfo.dstProfile = 0L;
    	cpinfo.flags = CanModifyPalette | CanAnimatePalette;
    	cpinfo.placeWhere = kDeepestColorScreen;
    	cpinfo.pickerType = 0L;
    	cpinfo.eventProc = NULL;
    	cpinfo.colorProc = NULL;
    	cpinfo.colorProcData = NULL;
    	
    	Tcl_UtfToExternal(NULL, NULL, title, -1, 0, NULL, 
		StrBody(cpinfo.prompt), 255, &srcRead, &dstWrote, NULL);
    	StrLength(cpinfo.prompt) = (unsigned char) dstWrote;

        if ((PickColor(&cpinfo) == noErr) && (cpinfo.newColorChosen != 0)) {

            in.red 	= cpinfo.theColor.color.rgb.red;
            in.green 	= cpinfo.theColor.color.rgb.green;
            in.blue 	= cpinfo.theColor.color.rgb.blue;
            picked = 1;
        }



    } else {
    	RGBColor out;
    	Str255 prompt;
    	Point point = {-1, -1};
    	
        /*
         * Use version 1.0 of the color picker
         */
    	
    	Tcl_UtfToExternal(NULL, NULL, title, -1, 0, NULL, StrBody(prompt), 
		255, &srcRead, &dstWrote, NULL);
    	StrLength(prompt) = (unsigned char) dstWrote;


        if (GetColor(point, prompt, &in, &out)) {
            in = out;
            picked = 1;
        }
    } 
    
    if (picked != 0) {
        char result[32];

        sprintf(result, "#%02x%02x%02x", in.red >> 8, in.green >> 8, 
        	in.blue >> 8);
	Tcl_AppendResult(interp, result, NULL);

    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetOpenFileObjCmd --
 *
 *	This procedure implements the "open file" dialog box for the
 *	Mac platform. See the user documentation for details on what
 *	it does.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *	See user documentation.
 *----------------------------------------------------------------------
 */

int
Tk_GetOpenFileObjCmd(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    return GetFileName(clientData, interp, objc, objv, OPEN_FILE);
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetSaveFileObjCmd --
 *
 *	Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
 *	instead
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *	See user documentation.
 *----------------------------------------------------------------------
 */

int
Tk_GetSaveFileObjCmd(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    return GetFileName(clientData, interp, objc, objv, SAVE_FILE);
}

/*
 *----------------------------------------------------------------------
 *
 * GetFileName --
 *
 *	Calls the Mac file dialog functions for the user to choose a
 *	file to or save.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	If the user selects a file, the native pathname of the file
 *	is returned in the interp's result. Otherwise an empty string
 *	is returned in the interp's result.
 *
 *----------------------------------------------------------------------
 */

static int
GetFileName(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *CONST objv[],	/* Argument objects. */
    int isOpen)			/* true if we should call GetOpenFileName(),
				 * false if we should call GetSaveFileName() */
{

    int i, result;
    OpenFileData ofd;
    StandardFileReply reply;
    Point mypoint;
    MenuHandle menu;
    Str255 initialFile;
    char *choice[6];
    Tk_Window parent;
    static char *optionStrings[] = {
	"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
	"-parent",	"-title",	NULL
    };
    enum options {
	FILE_DEFAULT,	FILE_TYPES,	FILE_INITDIR,	FILE_INITFILE,
	FILE_PARENT,	FILE_TITLE
    };

    if (openFilter == NULL) {
	openFilter = NewFileFilterYDProc(FileFilterProc);
	openHook = NewDlgHookYDProc(OpenHookProc);
	saveHook = NewDlgHookYDProc(OpenHookProc);
    }
    
    result = TCL_ERROR;    
    parent = (Tk_Window) clientData;    
    memset(choice, 0, sizeof(choice));

    for (i = 1; i < objc; i += 2) {
	int index;
	char *string;

	if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (i + 1 == objc) {
	    string = Tcl_GetStringFromObj(objv[i], NULL);
	    Tcl_AppendResult(interp, "value for \"", string, "\" missing", 
		    (char *) NULL);
	    return TCL_ERROR;
	}
	choice[index] = Tcl_GetStringFromObj(objv[i + 1], NULL);
    }
    
    StrLength(initialFile) = 0;
    menu = NULL;
    
    TkInitFileFilters(&ofd.fl);
    ofd.curType		= 0;
    ofd.popupItem	= OPEN_POPUP_ITEM;
    ofd.usePopup 	= isOpen;
    
    if (choice[FILE_TYPES] != NULL) {
        if (TkGetFileFilters(interp, &ofd.fl, choice[FILE_TYPES], 0) != TCL_OK) {
            goto end;
        }
    }
    if (choice[FILE_INITDIR] != NULL) {
        FSSpec dirSpec;
	Tcl_DString ds;
	long dirID;
	OSErr err;
	Boolean isDirectory;
	char *string;
	Str255 dir;
	int srcRead, dstWrote;
	
	string = choice[FILE_INITDIR];
	if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
	    goto end;
	}
	Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds), 
		Tcl_DStringLength(&ds), 0, NULL, StrBody(dir), 255, 
		&srcRead, &dstWrote, NULL);
        StrLength(dir) = (unsigned char) dstWrote;
	Tcl_DStringFree(&ds);
          
	err = FSpLocationFromPath(StrLength(dir), StrBody(dir), &dirSpec);
	if (err != noErr) {
	    Tcl_AppendResult(interp, "bad directory \"", string, "\"", NULL);
	    goto end;
	}
	err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
	if ((err != noErr) || !isDirectory) {
	    Tcl_AppendResult(interp, "bad directory \"", string, "\"", NULL);
	    goto end;
	}
	/*

	 * Make sure you negate -dirSpec.vRefNum because the 
	 * standard file package wants it that way !
	 */
	
	LMSetSFSaveDisk(-dirSpec.vRefNum);
	LMSetCurDirStore(dirID);
    }
    if (choice[FILE_INITFILE] != NULL) {
        Tcl_DString ds;
        int srcRead, dstWrote;
        
        if (Tcl_TranslateFileName(interp, choice[FILE_INITFILE], &ds) == NULL) {
            goto end;
        }
        Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds), 
        	Tcl_DStringLength(&ds), 0, NULL, 
		StrBody(initialFile), 255, &srcRead, &dstWrote, NULL);
        StrLength(initialFile) = (unsigned char) dstWrote;
        Tcl_DStringFree(&ds);
    }
    if (choice[FILE_PARENT] != NULL) {
        parent = Tk_NameToWindow(interp, choice[FILE_PARENT], parent);
	if (parent == NULL) {
	    return TCL_ERROR;
	}
    }

    /*
     * 2. Set the items in the file types popup.
     */

    /*
     * Delete all the entries inside the popup menu, in case there's any
     * left overs from previous invocation of this command
     */

    if (ofd.usePopup) {
	FileFilter *filterPtr;
	
	menu = GetMenu(OPEN_MENU);
        for (i = CountMItems(menu); i > 0; i--) {
            /*
             * The item indices are one based. Also, if we delete from
             * the beginning, the items may be re-numbered. So we
             * delete from the end
    	     */
    	     
    	     DeleteMenuItem(menu, i);
        }

	filterPtr = ofd.fl.filters;
	if (filterPtr == NULL) {
	    ofd.usePopup = 0;
	} else {
	    for ( ; filterPtr != NULL; filterPtr = filterPtr->next) {
	        Str255 str;
	        
	    	StrLength(str) = (unsigned char) strlen(filterPtr->name);
	    	strcpy(StrBody(str), filterPtr->name);
		AppendMenu(menu, str);
	    }


	}
    }

    /*
     * 3. Call the toolbox file dialog function.
     */
     
    SetPt(&mypoint, -1, -1);
    TkpSetCursor(NULL);

    if (isOpen) {
        if (ofd.usePopup) {
	    CustomGetFile(openFilter, (short) -1, NULL, &reply, OPEN_BOX,

	    	    mypoint, openHook, NULL, NULL, NULL, (void*) &ofd);
	} else {
	    StandardGetFile(NULL, -1, NULL, &reply);
	}
    } else {
	static Str255 prompt = "\pSave as";
	








   	if (ofd.usePopup) {
   	    /*
   	     * Currently this never gets called because we don't use
   	     * popup for the save dialog.
   	     */
	    CustomPutFile(prompt, initialFile, &reply, OPEN_BOX, 
	    	    mypoint, saveHook, NULL, NULL, NULL, (void *) &ofd);
	} else {
	    StandardPutFile(prompt, initialFile, &reply);
	}
    }


    if (reply.sfGood) {
        int length;
    	Handle pathHandle;

    	
    	pathHandle = NULL;
    	FSpPathFromLocation(&reply.sfFile, &length, &pathHandle);

	if (pathHandle != NULL) {
	    Tcl_DString ds;
	    
	    HLock(pathHandle);
	    Tcl_ExternalToUtfDString(NULL, (char *) *pathHandle, -1, &ds);
	    Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
	    Tcl_DStringFree(&ds);
	    HUnlock(pathHandle);
	    DisposeHandle(pathHandle);
	}



    }

    














    result = TCL_OK;

































































    end:


























    TkFreeFileFilters(&ofd.fl);












    if (menu != NULL) {





    	DisposeMenu(menu);




    }









    return result;
}






/*
 *----------------------------------------------------------------------
 *
 * OpenHookProc --
 *
 *	Gets called for various events that occur in the file dialog box.
 *	Initializes the popup menu or rebuild the file list depending on
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
 *----------------------------------------------------------------------
 */

static pascal short
OpenHookProc(
    short item,			/* Event description. */
    DialogPtr theDialog,	/* The dialog where the event occurs. */
    OpenFileData * myDataPtr)	/* Information about the file dialog. */
{
    short ignore;
    Rect rect;
    Handle handle;
    int newType;

    switch (item) {
	case sfHookFirstCall:
	    if (myDataPtr->usePopup) {
		/*
		 * Set the popup list to display the selected type.
		 */
		GetDialogItem(theDialog, myDataPtr->popupItem,
			&ignore, &handle, &rect);
		SetControlValue((ControlRef) handle, myDataPtr->curType + 1);
	    }
	    return sfHookNullEvent;
      
	case OPEN_POPUP_ITEM:
	    if (myDataPtr->usePopup) {
		GetDialogItem(theDialog, myDataPtr->popupItem,
			&ignore, &handle, &rect);
		newType = GetCtlValue((ControlRef) handle) - 1;
		if (myDataPtr->curType != newType) {
		    if (newType<0 || newType>myDataPtr->fl.numFilters) {
			/*
			 * Sanity check. Looks like the user selected an
			 * non-existent menu item?? Don't do anything.
			 */
		    } else {
			myDataPtr->curType = newType;
		    }
		    return sfHookRebuildList;
		}
	    }  
	    break;
    }








|








|



|
|
|




|
|


|
|





|







555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
 *----------------------------------------------------------------------
 */

static pascal short
OpenHookProc(
    short item,			/* Event description. */
    DialogPtr theDialog,	/* The dialog where the event occurs. */
    OpenFileData *ofdPtr)	/* Information about the file dialog. */
{
    short ignore;
    Rect rect;
    Handle handle;
    int newType;

    switch (item) {
	case sfHookFirstCall:
	    if (ofdPtr->usePopup) {
		/*
		 * Set the popup list to display the selected type.
		 */
		GetDialogItem(theDialog, ofdPtr->popupItem, &ignore, &handle, 
			&rect);
		SetControlValue((ControlRef) handle, ofdPtr->curType + 1);
	    }
	    return sfHookNullEvent;
      
	case OPEN_POPUP_ITEM:
	    if (ofdPtr->usePopup) {
		GetDialogItem(theDialog, ofdPtr->popupItem,
			&ignore, &handle, &rect);
		newType = GetCtlValue((ControlRef) handle) - 1;
		if (ofdPtr->curType != newType) {
		    if (newType<0 || newType>ofdPtr->fl.numFilters) {
			/*
			 * Sanity check. Looks like the user selected an
			 * non-existent menu item?? Don't do anything.
			 */
		    } else {
			ofdPtr->curType = newType;
		    }
		    return sfHookRebuildList;
		}
	    }  
	    break;
    }

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

static pascal Boolean
FileFilterProc(
    CInfoPBPtr pb,		/* Information about the file */
    void *myData)		/* Client data for this file dialog */
{
    int i;
    OpenFileData * myDataPtr = (OpenFileData*)myData;
    FileFilter * filterPtr;

    if (myDataPtr->fl.numFilters == 0) {
	/*
	 * No types have been specified. List all files by default
	 */
	return MATCHED;
    }

    if (pb->dirInfo.ioFlAttrib & 0x10) {
    	/*
    	 * This is a directory: always show it
    	 */
    	return MATCHED;
    }

    if (myDataPtr->usePopup) {
        i = myDataPtr->curType;
	for (filterPtr=myDataPtr->fl.filters; filterPtr && i>0; i--) {
	    filterPtr = filterPtr->next;
	}
	if (filterPtr) {
	    return MatchOneType(pb, myDataPtr, filterPtr);
	} else {
	    return UNMATCHED;
        }
    } else {
	/*
	 * We are not using the popup menu. In this case, the file is
	 * considered matched if it matches any of the file filters.
	 */

	for (filterPtr=myDataPtr->fl.filters; filterPtr;
		filterPtr=filterPtr->next) {
	    if (MatchOneType(pb, myDataPtr, filterPtr) == MATCHED) {
	        return MATCHED;
	    }
	}
	return UNMATCHED;
    }
}








|


|













|
|
|



|









|

|







621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670

static pascal Boolean
FileFilterProc(
    CInfoPBPtr pb,		/* Information about the file */
    void *myData)		/* Client data for this file dialog */
{
    int i;
    OpenFileData * ofdPtr = (OpenFileData*)myData;
    FileFilter * filterPtr;

    if (ofdPtr->fl.numFilters == 0) {
	/*
	 * No types have been specified. List all files by default
	 */
	return MATCHED;
    }

    if (pb->dirInfo.ioFlAttrib & 0x10) {
    	/*
    	 * This is a directory: always show it
    	 */
    	return MATCHED;
    }

    if (ofdPtr->usePopup) {
        i = ofdPtr->curType;
	for (filterPtr=ofdPtr->fl.filters; filterPtr && i>0; i--) {
	    filterPtr = filterPtr->next;
	}
	if (filterPtr) {
	    return MatchOneType(pb, ofdPtr, filterPtr);
	} else {
	    return UNMATCHED;
        }
    } else {
	/*
	 * We are not using the popup menu. In this case, the file is
	 * considered matched if it matches any of the file filters.
	 */

	for (filterPtr=ofdPtr->fl.filters; filterPtr;
		filterPtr=filterPtr->next) {
	    if (MatchOneType(pb, ofdPtr, filterPtr) == MATCHED) {
	        return MATCHED;
	    }
	}
	return UNMATCHED;
    }
}

814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
 *
 *----------------------------------------------------------------------
 */

static Boolean
MatchOneType(
    CInfoPBPtr pb,		/* Information about the file */
    OpenFileData * myDataPtr,	/* Information about this file dialog */
    FileFilter * filterPtr)	/* Match the file described by pb against
				 * this filter */
{
    FileFilterClause * clausePtr;

    /*
     * A file matches with a file type if it matches with at least one







|







684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
 *
 *----------------------------------------------------------------------
 */

static Boolean
MatchOneType(
    CInfoPBPtr pb,		/* Information about the file */
    OpenFileData * ofdPtr,	/* Information about this file dialog */
    FileFilter * filterPtr)	/* Match the file described by pb against
				 * this filter */
{
    FileFilterClause * clausePtr;

    /*
     * A file matches with a file type if it matches with at least one
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926

927
928
929
930
931
932
933
934
935
936
937


938
939
	if (globMatched && macMatched) {
	    return MATCHED;
	}
    }

    return UNMATCHED;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_MessageBoxCmd --
 *
 *	This procedure implements the MessageBox window for the
 *	Mac platform. See the user documentation for details on what
 *	it does.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *	See user documentation.

 *
 *----------------------------------------------------------------------
 */

int
Tk_MessageBoxCmd(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    char **argv)		/* Argument strings. */
{


    return EvalArgv(interp, "tkMessageBox", argc, argv);
}







<



|

|
|
|


|


|
>





|
|
|
|
|

>
>
|
|
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
	if (globMatched && macMatched) {
	    return MATCHED;
	}
    }

    return UNMATCHED;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_ChooseDirectoryObjCmd --
 *
 *	This procedure implements the "tk_chooseDirectory" dialog box 
 *	for the Windows platform. See the user documentation for details 
 *	on what it does.
 *
 * Results:
 *	See user documentation.
 *
 * Side effects:
 *	A modal dialog window is created.  Tcl_SetServiceMode() is
 *	called to allow background events to be processed
 *
 *----------------------------------------------------------------------
 */

int
Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window associated with interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    return TCL_ERROR;
}


Changes to mac/tkMacDraw.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkMacDraw.c --
 *
 *	This file contains functions that preform drawing to
 *	Xlib windows.  Most of the functions simple emulate
 *	Xlib functions.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacDraw.c 1.55 97/11/20 18:28:56
 */

#include "tkInt.h"
#include "X.h"
#include "Xlib.h"
#include <stdio.h>
#include <tcl.h>












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkMacDraw.c --
 *
 *	This file contains functions that preform drawing to
 *	Xlib windows.  Most of the functions simple emulate
 *	Xlib functions.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacDraw.c,v 1.1.4.1 1998/09/30 02:18:06 stanton Exp $
 */

#include "tkInt.h"
#include "X.h"
#include "Xlib.h"
#include <stdio.h>
#include <tcl.h>

Changes to mac/tkMacEmbed.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
/* 
 * tkMacEmbed.c --
 *
 *	This file contains platform-specific procedures for theMac to provide
 *	basic operations needed for application embedding (where one
 *	application can use as its main window an internal window from
 *	some other application).
 *	Currently only Toplevel embedding within the same Tk application is
 *      allowed on the Macintosh.
 *
 * Copyright (c) 1996-97 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 *  SCCS: @(#) tkMacEmbed.c 1.6 97/10/31 17:20:22
 */

#include "tkInt.h"
#include "tkPort.h"
#include "X.h"
#include "Xlib.h"
#include <stdio.h>










|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
/* 
 * tkMacEmbed.c --
 *
 *	This file contains platform-specific procedures for theMac to provide
 *	basic operations needed for application embedding (where one
 *	application can use as its main window an internal window from
 *	some other application).
 *	Currently only Toplevel embedding within the same Tk application is
 *      allowed on the Macintosh.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 *  RCS: @(#) $Id: tkMacEmbed.c,v 1.1.4.2 1998/09/30 02:18:06 stanton Exp $
 */

#include "tkInt.h"
#include "tkPort.h"
#include "X.h"
#include "Xlib.h"
#include <stdio.h>
49
50
51
52
53
54
55





56
57
58
59
60
61
62
    struct Container *nextPtr;	/* Next in list of all containers in
				 * this process. */
} Container;

static Container *firstContainerPtr = NULL;
					/* First in list of all containers
					 * managed by this process.  */






/*
 * Prototypes for static procedures defined in this file:
 */

static void		ContainerEventProc _ANSI_ARGS_((
			    ClientData clientData, XEvent *eventPtr));







>
>
>
>
>







49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
    struct Container *nextPtr;	/* Next in list of all containers in
				 * this process. */
} Container;

static Container *firstContainerPtr = NULL;
					/* First in list of all containers
					 * managed by this process.  */
/*
 * Globals defined in this file
 */

TkMacEmbedHandler *gMacEmbedHandler = NULL;

/*
 * Prototypes for static procedures defined in this file:
 */

static void		ContainerEventProc _ANSI_ARGS_((
			    ClientData clientData, XEvent *eventPtr));
70
71
72
73
74
75
76
77







78

79
























80
81
82
83
84
85
86
			    Container * containerPtr, int width, int height));
static void		EmbedSendConfigure _ANSI_ARGS_((
			    Container *containerPtr));
static void		EmbedStructureProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		EmbedWindowDeleted _ANSI_ARGS_((TkWindow *winPtr));

/* WARNING - HACK */







static void		GenerateFocusEvents _ANSI_ARGS_((TkWindow *sourcePtr,

			    TkWindow *destPtr));


























/*
 *----------------------------------------------------------------------
 *
 * TkpMakeWindow --
 *







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







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
			    Container * containerPtr, int width, int height));
static void		EmbedSendConfigure _ANSI_ARGS_((
			    Container *containerPtr));
static void		EmbedStructureProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		EmbedWindowDeleted _ANSI_ARGS_((TkWindow *winPtr));


/*
 *----------------------------------------------------------------------
 *
 * Tk_MacSetEmbedHandler --
 *
 *	Registers a handler for an in process form of embedding, like 
 *	Netscape plugins, where Tk is loaded into the process, but does
 *	not control the main window
 *
 * Results:
 *	None
 *
 * Side effects:
 *	The embed handler is set.
 *
 *----------------------------------------------------------------------
 */
void
Tk_MacSetEmbedHandler(
    Tk_MacEmbedRegisterWinProc *registerWinProc,
    Tk_MacEmbedGetGrafPortProc *getPortProc,
    Tk_MacEmbedMakeContainerExistProc *containerExistProc,
    Tk_MacEmbedGetClipProc *getClipProc,
    Tk_MacEmbedGetOffsetInParentProc *getOffsetProc)
{
    if (gMacEmbedHandler == NULL) {
    	gMacEmbedHandler = (TkMacEmbedHandler *) ckalloc(sizeof(TkMacEmbedHandler));
    }
    gMacEmbedHandler->registerWinProc = registerWinProc;
    gMacEmbedHandler->getPortProc = getPortProc;
    gMacEmbedHandler->containerExistProc = containerExistProc;
    gMacEmbedHandler->getClipProc = getClipProc;
    gMacEmbedHandler->getOffsetProc = getOffsetProc;    
}


/*
 *----------------------------------------------------------------------
 *
 * TkpMakeWindow --
 *
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
 *	its parent window, rather than the root window for the screen.
 *	It is invoked by an embedded application to specify the window
 *	in which it is embedded.
 *
 * Results:
 *	The return value is normally TCL_OK.  If an error occurs (such
 *	as string not being a valid window spec), then the return value
 *	is TCL_ERROR and an error message is left in interp->result if
 *	interp is non-NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */







|







213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
 *	its parent window, rather than the root window for the screen.
 *	It is invoked by an embedded application to specify the window
 *	in which it is embedded.
 *
 * Results:
 *	The return value is normally TCL_OK.  If an error occurs (such
 *	as string not being a valid window spec), then the return value
 *	is TCL_ERROR and an error message is left in the interp's result if
 *	interp is non-NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266











267
268
269
270


271
272

273
274
275
276
277
278
279
280
281
282
283



284
285



286
287








288





289


290




291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308










309
310
311
312
313
314
315
316
317
318
319
320

321
322
323
324
325
326

327
328
329



330
331
332
333
334
335
336
	if (containerPtr->parent == (Window) parent) {
	    winPtr->flags |= TK_BOTH_HALVES;
	    containerPtr->parentPtr->flags |= TK_BOTH_HALVES;
	    break;
	}
    }
    
    /* 
     * We should not get to this code until we start to allow 
     * embedding in other applications.
     */
     
    if (containerPtr == NULL) {
	Tcl_AppendResult(interp, "The window ID ", string,
	    " does not correspond to a valid Tk Window.",
	    (char *) NULL);
	return TCL_ERROR;	
    }
        
    /*
     * Make the embedded window.  
     */

    macWin = (MacDrawable *) ckalloc(sizeof(MacDrawable));
    if (macWin == NULL) {
	winPtr->privatePtr = NULL;
	return TCL_ERROR;
    }
    
    macWin->winPtr = winPtr;
    winPtr->privatePtr = macWin;











    macWin->clipRgn = NewRgn();
    macWin->aboveClipRgn = NewRgn();
    macWin->referenceCount = 0;
    macWin->flags = TK_CLIP_INVALID;


    
    winPtr->flags |= TK_EMBEDDED;

    
    /*
     * Make a copy of the TK_EMBEDDED flag, since sometimes
     * we need this to get the port after the TkWindow structure
     * has been freed.
     */
     
    macWin->flags |= TK_EMBEDDED;
    
    /* 
     * The portPtr will be NULL for an embedded window.



     * Always use TkMacGetDrawablePort to get the portPtr.
     * It will correctly find the container's port.



     */
     








    macWin->portPtr = (GWorldPtr) NULL;





      


    macWin->toplevel = macWin;




    macWin->xOff = parent->winPtr->privatePtr->xOff +
	parent->winPtr->changes.border_width +
	winPtr->changes.x;
    macWin->yOff = parent->winPtr->privatePtr->yOff +
	parent->winPtr->changes.border_width +
	winPtr->changes.y;
    
    macWin->toplevel->referenceCount++;
    
    /*
     * Finish filling up the container structure with the embedded window's 
     * information.
     */
     
    containerPtr->embedded = (Window) macWin;
    containerPtr->embeddedPtr = macWin->winPtr;

    /* 










     * TODO: need general solution for visibility events.
     */
     
    event.xany.serial = Tk_Display(winPtr)->request;
    event.xany.send_event = False;
    event.xany.display = Tk_Display(winPtr);
	
    event.xvisibility.type = VisibilityNotify;
    event.xvisibility.window = (Window) macWin;;
    event.xvisibility.state = VisibilityUnobscured;
    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);


    /*
     * Create an event handler to clean up the Container structure when
     * tkwin is eventually deleted.
     */

    Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbeddedEventProc,

	    (ClientData) winPtr);

     



     
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







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












>
>
>
>
>
>
>
>
>
>
>




>
>
|

>









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

<

|
|
|
|

|
|

|
>
>
>
>
>
>
>
>
>
>












>
|
<
|

|
|
>
|
|
|
>
>
>







273
274
275
276
277
278
279












280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361

362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395

396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
	if (containerPtr->parent == (Window) parent) {
	    winPtr->flags |= TK_BOTH_HALVES;
	    containerPtr->parentPtr->flags |= TK_BOTH_HALVES;
	    break;
	}
    }
    












    /*
     * Make the embedded window.  
     */

    macWin = (MacDrawable *) ckalloc(sizeof(MacDrawable));
    if (macWin == NULL) {
	winPtr->privatePtr = NULL;
	return TCL_ERROR;
    }
    
    macWin->winPtr = winPtr;
    winPtr->privatePtr = macWin;

    /*
     * The portPtr will be NULL for a Tk in Tk embedded window.
     * It is none of our business what it is for a Tk not in Tk embedded window,
     * but we will initialize it to NULL, and let the registerWinProc 
     * set it.  In any case, you must always use TkMacGetDrawablePort 
     * to get the portPtr.  It will correctly find the container's port.
     */

    macWin->portPtr = (GWorldPtr) NULL;

    macWin->clipRgn = NewRgn();
    macWin->aboveClipRgn = NewRgn();
    macWin->referenceCount = 0;
    macWin->flags = TK_CLIP_INVALID;
    macWin->toplevel = macWin;
    macWin->toplevel->referenceCount++;
   
    winPtr->flags |= TK_EMBEDDED;
    
    
    /*
     * Make a copy of the TK_EMBEDDED flag, since sometimes
     * we need this to get the port after the TkWindow structure
     * has been freed.
     */
     
    macWin->flags |= TK_EMBEDDED;
    
    /*
     * Now check whether it is embedded in another Tk widget.  If not (the first
     * case below) we see if there is an in-process embedding handler registered,
     * and if so, let that fill in the rest of the macWin.
     */
    
    if (containerPtr == NULL) {
	/*
	 * If someone has registered an in process embedding handler, then 
	 * see if it can handle this window...
	 */
	
	if (gMacEmbedHandler == NULL ||
		gMacEmbedHandler->registerWinProc(result, (Tk_Window) winPtr) != TCL_OK) {
	    Tcl_AppendResult(interp, "The window ID ", string,
	            " does not correspond to a valid Tk Window.",
		     (char *) NULL);
	    return TCL_ERROR;	
	} else {
	    containerPtr = (Container *) ckalloc(sizeof(Container));

	    containerPtr->parentPtr = NULL;
	    containerPtr->embedded = (Window) macWin;
	    containerPtr->embeddedPtr = macWin->winPtr;
	    containerPtr->nextPtr = firstContainerPtr;
	    firstContainerPtr = containerPtr;
	    
	}    
    } else {
        
	/* 
         * The window is embedded in another Tk window.
         */ 
	
	macWin->xOff = parent->winPtr->privatePtr->xOff +
	        parent->winPtr->changes.border_width +
	        winPtr->changes.x;
	macWin->yOff = parent->winPtr->privatePtr->yOff +
	        parent->winPtr->changes.border_width +
	        winPtr->changes.y;
    

    
        /*
         * Finish filling up the container structure with the embedded window's 
         * information.
         */
     
	containerPtr->embedded = (Window) macWin;
	containerPtr->embeddedPtr = macWin->winPtr;

	/*
         * Create an event handler to clean up the Container structure when
         * tkwin is eventually deleted.
         */

        Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbeddedEventProc,
	        (ClientData) winPtr);

    }

   /* 
     * TODO: need general solution for visibility events.
     */
     
    event.xany.serial = Tk_Display(winPtr)->request;
    event.xany.send_event = False;
    event.xany.display = Tk_Display(winPtr);
	
    event.xvisibility.type = VisibilityNotify;
    event.xvisibility.window = (Window) macWin;;
    event.xvisibility.state = VisibilityUnobscured;
    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);

    
    /* 

     * TODO: need general solution for visibility events.
     */
     
    event.xany.serial = Tk_Display(winPtr)->request;
    event.xany.send_event = False;
    event.xany.display = Tk_Display(winPtr);
	
    event.xvisibility.type = VisibilityNotify;
    event.xvisibility.window = (Window) macWin;;
    event.xvisibility.state = VisibilityUnobscured;
    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
     
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
EmbedActivateProc(clientData, eventPtr)
    ClientData clientData;		/* Token for container window. */
    XEvent *eventPtr;			/* ResizeRequest event. */
{
    Container *containerPtr = (Container *) clientData;
    
    if (containerPtr->embeddedPtr != NULL) {
            
      if (eventPtr->type == ActivateNotify) {
            TkGenerateActivateEvents(containerPtr->embeddedPtr, 1);
        } else if (eventPtr->type == DeactivateNotify) {
            TkGenerateActivateEvents(containerPtr->embeddedPtr, 0); 
        }        
    }
}

/*
 *----------------------------------------------------------------------
 *







<
|
|

|







957
958
959
960
961
962
963

964
965
966
967
968
969
970
971
972
973
974
EmbedActivateProc(clientData, eventPtr)
    ClientData clientData;		/* Token for container window. */
    XEvent *eventPtr;			/* ResizeRequest event. */
{
    Container *containerPtr = (Container *) clientData;
    
    if (containerPtr->embeddedPtr != NULL) {

        if (eventPtr->type == ActivateNotify) {
            TkGenerateActivateEvents(containerPtr->embeddedPtr,1);
        } else if (eventPtr->type == DeactivateNotify) {
            TkGenerateActivateEvents(containerPtr->embeddedPtr,0);
        }        
    }
}

/*
 *----------------------------------------------------------------------
 *
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
    XEvent *eventPtr;			/* ResizeRequest event. */
{
    Container *containerPtr = (Container *) clientData;
    Display *display;
    XEvent event;

    if (containerPtr->embeddedPtr != NULL) {
        display = Tk_Display(containerPtr->parentPtr);
        event.xfocus.serial = LastKnownRequestProcessed(display);
        event.xfocus.send_event = false;
        event.xfocus.display = display;
        event.xfocus.mode = NotifyNormal;
        event.xfocus.window = containerPtr->embedded; 
        
        if (eventPtr->type == FocusIn) {
	/*
	 * The focus just arrived at the container.  Change the X focus
	 * to move it to the embedded application, if there is one. 
	 * Ignore X errors that occur during this operation (it's
	 * possible that the new focus window isn't mapped).
	 */
    
            event.xfocus.detail = NotifyNonlinear;
            event.xfocus.type = FocusIn;

        } else if (eventPtr->type == FocusOut) {
        /* When the container gets a FocusOut event, it has to  tell the embedded app
         * that it has lost the focus.
         */
         
            event.xfocus.type = FocusOut;
            event.xfocus.detail = NotifyNonlinear;
         }
         
        Tk_QueueWindowEvent(&event, TCL_QUEUE_MARK);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * EmbedGeometryRequest --
 *







|






|




















|







995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
    XEvent *eventPtr;			/* ResizeRequest event. */
{
    Container *containerPtr = (Container *) clientData;
    Display *display;
    XEvent event;

    if (containerPtr->embeddedPtr != NULL) {
    display = Tk_Display(containerPtr->parentPtr);
        event.xfocus.serial = LastKnownRequestProcessed(display);
        event.xfocus.send_event = false;
        event.xfocus.display = display;
        event.xfocus.mode = NotifyNormal;
        event.xfocus.window = containerPtr->embedded; 
        
    if (eventPtr->type == FocusIn) {
	/*
	 * The focus just arrived at the container.  Change the X focus
	 * to move it to the embedded application, if there is one. 
	 * Ignore X errors that occur during this operation (it's
	 * possible that the new focus window isn't mapped).
	 */
    
            event.xfocus.detail = NotifyNonlinear;
            event.xfocus.type = FocusIn;

        } else if (eventPtr->type == FocusOut) {
        /* When the container gets a FocusOut event, it has to  tell the embedded app
         * that it has lost the focus.
         */
         
            event.xfocus.type = FocusOut;
            event.xfocus.detail = NotifyNonlinear;
         }
         
        Tk_QueueWindowEvent(&event, TCL_QUEUE_MARK);
    } 
}

/*
 *----------------------------------------------------------------------
 *
 * EmbedGeometryRequest --
 *

Changes to mac/tkMacFont.c.

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
/* 
 * tkMacFont.c --
 *
 *	Contains the Macintosh implementation of the platform-independant
 *	font package interface.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS:@(#) tkMacFont.c 1.52 97/11/20 18:29:51 
 */
 
#include <Windows.h>
#include <Strings.h>
#include <Fonts.h>

#include <Resources.h>


#include "tkMacInt.h"
#include "tkFont.h"
#include "tkPort.h"

























































































































































/*
 * The following structure represents the Macintosh's' implementation of a
 * font.
 */



typedef struct MacFont {
    TkFont font;		/* Stuff used by generic font package.  Must
				 * be first in structure. */












    short family;
    short size;

    short style;

} MacFont;



























static GWorldPtr gWorld = NULL;




static TkFont *		AllocMacFont _ANSI_ARGS_((TkFont *tkfont, 










			    Tk_Window tkwin, int family, int size, int style));


















































































































































/*
 *---------------------------------------------------------------------------
 *
 * TkpGetNativeFont --
 *
 *	Map a platform-specific native font name to a TkFont.












|





>

>



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


|
|

>
>




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


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


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

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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
/* 
 * tkMacFont.c --
 *
 *	Contains the Macintosh implementation of the platform-independant
 *	font package interface.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacFont.c,v 1.1.4.3 1999/03/30 04:12:58 stanton Exp $
 */
 
#include <Windows.h>
#include <Strings.h>
#include <Fonts.h>
#include <Script.h>
#include <Resources.h>
#include <TextUtils.h>

#include "tkMacInt.h"
#include "tkFont.h"

/*
 * For doing things with Mac strings and Fixed numbers.  This probably should move 
 * the mac header file.
 */

#ifndef StrLength
#define StrLength(s) 		(*((unsigned char *) (s)))
#endif
#ifndef StrBody
#define StrBody(s)		((char *) (s) + 1)
#endif
#define pstrcmp(s1, s2)		RelString((s1), (s2), 1, 1)
#define pstrcasecmp(s1, s2)	RelString((s1), (s2), 0, 1)

#ifndef Fixed2Int
#define Fixed2Int(f)	((f) >> 16)
#define Int2Fixed(i)	((i) << 16)
#endif

/*
 * The preferred font encodings.
 */

static CONST char *encodingList[] = {
    "macRoman", "macJapan", NULL
};

/*
 * The following structures are used to map the script/language codes of a 
 * font to the name that should be passed to Tcl_GetTextEncoding() to obtain
 * the encoding for that font.  The set of numeric constants is fixed and 
 * defined by Apple.
 */
 
static TkStateMap scriptMap[] = {
    {smRoman,		"macRoman"},
    {smJapanese,	"macJapan"},
    {smTradChinese,	"macChinese"},
    {smKorean,		"macKorean"},
    {smArabic,		"macArabic"},
    {smHebrew,		"macHebrew"},
    {smGreek,		"macGreek"},
    {smCyrillic,	"macCyrillic"},
    {smRSymbol,		"macRSymbol"},
    {smDevanagari,	"macDevanagari"},
    {smGurmukhi,	"macGurmukhi"},
    {smGujarati,	"macGujarati"},
    {smOriya,		"macOriya"},
    {smBengali,		"macBengali"},
    {smTamil,		"macTamil"},
    {smTelugu,		"macTelugu"},
    {smKannada,		"macKannada"},
    {smMalayalam,	"macMalayalam"},
    {smSinhalese,	"macSinhalese"},
    {smBurmese,		"macBurmese"},
    {smKhmer,		"macKhmer"},
    {smThai,		"macThailand"},
    {smLaotian,		"macLaos"},
    {smGeorgian,	"macGeorgia"},
    {smArmenian,	"macArmenia"},
    {smSimpChinese,	"macSimpChinese"},
    {smTibetan,		"macTIbet"},
    {smMongolian,	"macMongolia"},
    {smGeez,		"macEthiopia"},
    {smEastEurRoman,	"macCentEuro"},
    {smVietnamese,	"macVietnam"},
    {smExtArabic,	"macSindhi"},
    {NULL,		NULL}
};    

static TkStateMap romanMap[] = {
    {langCroatian,	"macCroatian"},
    {langSlovenian,	"macCroatian"},
    {langIcelandic,	"macIceland"},
    {langRomanian,	"macRomania"},
    {langTurkish,	"macTurkish"},
    {langGreek,		"macGreek"},
    {NULL,		NULL}
};

static TkStateMap cyrillicMap[] = {
    {langUkrainian,	"macUkraine"},
    {langBulgarian,	"macBulgaria"},
    {NULL,		NULL}
};

/*
 * The following structure represents a font family.  It is assumed that
 * all screen fonts constructed from the same "font family" share certain
 * properties; all screen fonts with the same "font family" point to a
 * shared instance of this structure.  The most important shared property
 * is the character existence metrics, used to determine if a screen font
 * can display a given Unicode character.
 *
 * Under Macintosh, a "font family" is uniquely identified by its face number.
 */


#define FONTMAP_SHIFT	    	10

#define FONTMAP_PAGES	    	(1 << (sizeof(Tcl_UniChar) * 8 - FONTMAP_SHIFT))
#define FONTMAP_BITSPERPAGE	(1 << FONTMAP_SHIFT)

typedef struct FontFamily {
    struct FontFamily *nextPtr;	/* Next in list of all known font families. */
    int refCount;		/* How many SubFonts are referring to this
				 * FontFamily.  When the refCount drops to
				 * zero, this FontFamily may be freed. */
    /*
     * Key.
     */

    short faceNum;		/* Unique face number key for this FontFamily. */
    
    /*
     * Derived properties.
     */
     
    Tcl_Encoding encoding;	/* Encoding for this font family. */
    int isSymbolFont;		/* Non-zero if this is a symbol family. */
    int isMultiByteFont;	/* Non-zero if this is a multi-byte family. */
    char typeTable[256];	/* Table that identfies all lead bytes for a
    				 * multi-byte family, used when measuring chars.
    				 * If a byte is a lead byte, the value at the 
    				 * corresponding position in the typeTable is 1, 
    				 * otherwise 0.  If this is a single-byte font, 
    				 * all entries are 0. */
    char *fontMap[FONTMAP_PAGES];
    				/* Two-level sparse table used to determine
				 * quickly if the specified character exists.
				 * As characters are encountered, more pages
				 * in this table are dynamically added.  The
				 * contents of each page is a bitmask
				 * consisting of FONTMAP_BITSPERPAGE bits,
				 * representing whether this font can be used
				 * to display the given character at the
				 * corresponding bit position.  The high bits
				 * of the character are used to pick which
				 * page of the table is used. */
} FontFamily;

/*
 * The following structure encapsulates an individual screen font.  A font
 * object is made up of however many SubFonts are necessary to display a
 * stream of multilingual characters.
 */

typedef struct SubFont {
    char **fontMap;		/* Pointer to font map from the FontFamily, 
				 * cached here to save a dereference. */
    FontFamily *familyPtr;	/* The FontFamily for this SubFont. */
} SubFont;

/*
 * The following structure represents Macintosh's implementation of a font
 * object.
 */

#define SUBFONT_SPACE		3

typedef struct MacFont {
    TkFont font;		/* Stuff used by generic font package.  Must
				 * be first in structure. */
    SubFont staticSubFonts[SUBFONT_SPACE];
				/* Builtin space for a limited number of
				 * SubFonts. */
    int numSubFonts;		/* Length of following array. */
    SubFont *subFontArray;	/* Array of SubFonts that have been loaded
				 * in order to draw/measure all the characters
				 * encountered by this font so far.  All fonts
				 * start off with one SubFont initialized by
				 * AllocFont() from the original set of font
				 * attributes.  Usually points to
				 * staticSubFonts, but may point to malloced
				 * space if there are lots of SubFonts. */

    short size;			/* Font size in pixels, constructed from
				 * font attributes. */
    short style;		/* Style bits, constructed from font
				 * attributes. */
} MacFont;

/*
 * The following structure is used to map between the UTF-8 name for a font and
 * the name that the Macintosh uses to refer to the font, in order to determine
 * if a font exists.  The Macintosh names for fonts are stored in the encoding 
 * of the font itself.
 */
 
typedef struct FontNameMap {
    Tk_Uid utfName;		/* The name of the font in UTF-8. */
    StringPtr nativeName;	/* The name of the font in the font's encoding. */
    short faceNum;		/* Unique face number for this font. */
} FontNameMap;

/*
 * The list of font families that are currently loaded.  As screen fonts
 * are loaded, this list grows to hold information about what characters
 * exist in each font family.
 */

static FontFamily *fontFamilyList = NULL;

/*
 * Information cached about the system at startup time.
 */
 
static FontNameMap *gFontNameMap = NULL;
static GWorldPtr gWorld = NULL;

/*
 * Procedures used only in this file.
 */

static FontFamily *	AllocFontFamily(CONST MacFont *fontPtr, int family);
static SubFont *	CanUseFallback(MacFont *fontPtr,
			    CONST char *fallbackName, int ch);
static SubFont *	CanUseFallbackWithAliases(MacFont *fontPtr, 
			    char *faceName, int ch, Tcl_DString *nameTriedPtr);
static SubFont *	FindSubFontForChar(MacFont *fontPtr, int ch);
static void		FontMapInsert(SubFont *subFontPtr, int ch);
static void		FontMapLoadPage(SubFont *subFontPtr, int row);
static int		FontMapLookup(SubFont *subFontPtr, int ch);
static void 		FreeFontFamily(FontFamily *familyPtr);
static void		InitFont(Tk_Window tkwin, int family, int size, 
			    int style, MacFont *fontPtr);
static void		InitSubFont(CONST MacFont *fontPtr, int family, 
			    SubFont *subFontPtr);
static void		MultiFontDrawText(MacFont *fontPtr,
			    CONST char *source, int numBytes, int x, int y);
static void		ReleaseFont(MacFont *fontPtr);
static void		ReleaseSubFont(SubFont *subFontPtr);
static int		SeenName(CONST char *name, Tcl_DString *dsPtr);

static char *      	BreakLine(FontFamily *familyPtr, int flags, 
			    CONST char *source, int numBytes, int *widthPtr);
static int		GetFamilyNum(CONST char *faceName, short *familyPtr);
static int		GetFamilyOrAliasNum(CONST char *faceName, 
			    short *familyPtr);
static Tcl_Encoding	GetFontEncoding(int faceNum, int allowSymbol,
			    int *isSymbolPtr);
static Tk_Uid		GetUtfFaceName(StringPtr faceNameStr);


/*
 *-------------------------------------------------------------------------
 * 
 * TkpFontPkgInit --
 *
 *	This procedure is called when an application is created.  It
 *	initializes all the structures that are used by the 
 *	platform-dependant code on a per application basis.
 *
 * Results:
 *	None.  
 *
 * Side effects:
 *	See comments below.
 *
 *-------------------------------------------------------------------------
 */

void
TkpFontPkgInit(mainPtr)
    TkMainInfo *mainPtr;	/* The application being created. */
{
    MenuHandle fontMenu;
    FontNameMap *tmpFontNameMap, *newFontNameMap, *mapPtr;
    int i, j, numFonts, fontMapOffset, isSymbol;
    Str255 nativeName;
    Tcl_DString ds;
    Tcl_Encoding encoding;
    Tcl_Encoding *encodings;
    
    if (gWorld == NULL) {
	/* 
	 * Do the following one time only.
	 */

	Rect rect = {0, 0, 1, 1};

	SetFractEnable(0);
	
	/*
	 * Used for saving and restoring state while drawing and measuring.
	 */
	 
	if (NewGWorld(&gWorld, 0, &rect, NULL, NULL, 0) != noErr) {
	    panic("TkpFontPkgInit: NewGWorld failed");
	}
	
	/*
	 * The name of each font is stored in the encoding of that font.
	 * How would we translate a name from UTF-8 into the native encoding
	 * of the font unless we knew the encoding of that font?  We can't.
	 * So, precompute the UTF-8 and native names of all fonts on the 
	 * system.  The when the user asks for font by its UTF-8 name, we
	 * lookup the name in that table and really ask for the font by its
	 * native name.  Any unknown UTF-8 names will be mapped to the system 
	 * font.
	 */
	
	fontMenu = NewMenu('FT', "\px");
	AddResMenu(fontMenu, 'FONT');
	
	numFonts = CountMItems(fontMenu);
	tmpFontNameMap = (FontNameMap *) ckalloc(sizeof(FontNameMap) * numFonts);
	encodings = (Tcl_Encoding *) ckalloc(sizeof(Tcl_Encoding) * numFonts);

	mapPtr = tmpFontNameMap;
	for (i = 0; i < numFonts; i++) {
       	    GetMenuItemText(fontMenu, i + 1, nativeName);
       	    GetFNum(nativeName, &mapPtr->faceNum);
       	    encodings[i] = GetFontEncoding(mapPtr->faceNum, 0, &isSymbol);
       	    Tcl_ExternalToUtfDString(encodings[i], StrBody(nativeName), 
       	    	    StrLength(nativeName), &ds);
       	    mapPtr->utfName = Tk_GetUid(Tcl_DStringValue(&ds));
       	    mapPtr->nativeName = (StringPtr) ckalloc(StrLength(nativeName) + 1);
       	    memcpy(mapPtr->nativeName, nativeName, StrLength(nativeName) + 1);
       	    Tcl_DStringFree(&ds);
       	    mapPtr++;
       	}
       	DisposeMenu(fontMenu);
       	
       	/*
       	 * Reorder FontNameMap so fonts with the preferred encodings are at 
       	 * the front of the list.  The relative order of fonts that all have
       	 * the same encoding is preserved.  Fonts with unknown encodings get
       	 * stuck at the end.
       	 */
       	 
       	newFontNameMap = (FontNameMap *) ckalloc(sizeof(FontNameMap) * (numFonts + 1));
       	fontMapOffset = 0;
       	for (i = 0; encodingList[i] != NULL; i++) {
       	    encoding = Tcl_GetEncoding(NULL, encodingList[i]);
       	    if (encoding == NULL) {
       	    	continue;
       	    }
       	    for (j = 0; j < numFonts; j++) {
       	    	if (encodings[j] == encoding) {
       	    	    newFontNameMap[fontMapOffset] = tmpFontNameMap[j];
       	    	    fontMapOffset++;
       	    	    Tcl_FreeEncoding(encodings[j]);
       	    	    tmpFontNameMap[j].utfName = NULL;
       	    	}
       	    }
       	    Tcl_FreeEncoding(encoding);
       	} 
       	for (i = 0; i < numFonts; i++) {
       	    if (tmpFontNameMap[i].utfName != NULL) {
       	        newFontNameMap[fontMapOffset] = tmpFontNameMap[i];
       	        fontMapOffset++;
       	        Tcl_FreeEncoding(encodings[i]);
       	    }
       	}
       	if (fontMapOffset != numFonts) {
       	    panic("TkpFontPkgInit: unexpected number of fonts");
       	}

       	mapPtr = &newFontNameMap[numFonts];
       	mapPtr->utfName = NULL;
       	mapPtr->nativeName = NULL;
       	mapPtr->faceNum = 0;

       	ckfree((char *) tmpFontNameMap);
       	ckfree((char *) encodings);
       	
       	gFontNameMap = newFontNameMap;
    }       	    
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetNativeFont --
 *
 *	Map a platform-specific native font name to a TkFont.
69
70
71
72
73
74
75

76
77
78
79
80
81
82
83
84

85


86
87
88
89
90
91
92

TkFont *
TkpGetNativeFont(
    Tk_Window tkwin,	/* For display where font will be used. */
    CONST char *name)	/* Platform-specific font name. */
{
    short family;

    
    if (strcmp(name, "system") == 0) {
	family = GetSysFont();
    } else if (strcmp(name, "application") == 0) {
	family = GetAppFont();
    } else {
	return NULL;
    }


    return AllocMacFont(NULL, tkwin, family, 0, 0);


}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetFontFromAttributes -- 
 *







>








|
>
|
>
>







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

TkFont *
TkpGetNativeFont(
    Tk_Window tkwin,	/* For display where font will be used. */
    CONST char *name)	/* Platform-specific font name. */
{
    short family;
    MacFont *fontPtr;
    
    if (strcmp(name, "system") == 0) {
	family = GetSysFont();
    } else if (strcmp(name, "application") == 0) {
	family = GetAppFont();
    } else {
	return NULL;
    }
    
    fontPtr = (MacFont *) ckalloc(sizeof(MacFont));
    InitFont(tkwin, family, 0, 0, fontPtr);
    
    return (TkFont *) fontPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetFontFromAttributes -- 
 *
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
    TkFont *tkFontPtr,		/* If non-NULL, store the information in
				 * this existing TkFont structure, rather than
				 * allocating a new structure to hold the
				 * font; the existing contents of the font
				 * will be released.  If NULL, a new TkFont
				 * structure is allocated. */
    Tk_Window tkwin,		/* For display where font will be used. */
    CONST TkFontAttributes *faPtr)  /* Set of attributes to match. */

{



    char buf[257];
    size_t len;
    short family, size, style;



    if (faPtr->family == NULL) {
	family = 0;

    } else {
	CONST char *familyName;




	familyName = faPtr->family;
	if (strcasecmp(familyName, "Times New Roman") == 0) {
	    familyName = "Times";
	} else if (strcasecmp(familyName, "Courier New") == 0) {

	    familyName = "Courier";


	} else if (strcasecmp(familyName, "Arial") == 0) {

	    familyName = "Helvetica";

	}
	    
	len = strlen(familyName);
	if (len > 255) {
	    len = 255;
	}
	buf[0] = (char) len;
	memcpy(buf + 1, familyName, len);
	buf[len + 1] = '\0';
	GetFNum((StringPtr) buf, &family);
    }

    size = faPtr->pointsize;
    if (size <= 0) {
	size = GetDefFontSize();
    }


    style = 0;
    if (faPtr->weight != TK_FW_NORMAL) {
	style |= bold;
    }
    if (faPtr->slant != TK_FS_ROMAN) {
	style |= italic;
    }
    if (faPtr->underline) {
	style |= underline;
    }







    return AllocMacFont(tkFontPtr, tkwin, family, size, style);

}

/*
 *---------------------------------------------------------------------------
 *
 * TkpDeleteFont --
 *







|
>

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

|
>










>
>
>
>
>
|
>
|
>







475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497

498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515



516


517

518
519



520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
    TkFont *tkFontPtr,		/* If non-NULL, store the information in
				 * this existing TkFont structure, rather than
				 * allocating a new structure to hold the
				 * font; the existing contents of the font
				 * will be released.  If NULL, a new TkFont
				 * structure is allocated. */
    Tk_Window tkwin,		/* For display where font will be used. */
    CONST TkFontAttributes *faPtr)
				/* Set of attributes to match. */
{
    short faceNum, style;
    int i, j;
    char *faceName, *fallback;
    char ***fallbacks;
    MacFont *fontPtr;
        
    /*
     * Algorithm to get the closest font to the one requested.
     *
     * try fontname
     * try all aliases for fontname
     * foreach fallback for fontname
     *	    try the fallback

     *	    try all aliases for the fallback
     */
     
    faceNum = 0;
    faceName = faPtr->family;
    if (faceName != NULL) {
        if (GetFamilyOrAliasNum(faceName, &faceNum) != 0) {
            goto found;
        }
        fallbacks = TkFontGetFallbacks();
	for (i = 0; fallbacks[i] != NULL; i++) {
	    for (j = 0; (fallback = fallbacks[i][j]) != NULL; j++) {
		if (strcasecmp(faceName, fallback) == 0) {
		    for (j = 0; (fallback = fallbacks[i][j]) != NULL; j++) {
		        if (GetFamilyOrAliasNum(fallback, &faceNum)) {
		            goto found;
		        }
		    }



		}


		break;

	    }
	}



    }
    
    found:    
    style = 0;
    if (faPtr->weight != TK_FW_NORMAL) {
	style |= bold;
    }
    if (faPtr->slant != TK_FS_ROMAN) {
	style |= italic;
    }
    if (faPtr->underline) {
	style |= underline;
    }
    if (tkFontPtr == NULL) {
	fontPtr = (MacFont *) ckalloc(sizeof(MacFont));
    } else {
	fontPtr = (MacFont *) tkFontPtr;
	ReleaseFont(fontPtr);
    }
    InitFont(tkwin, faceNum, faPtr->size, style, fontPtr);
    
    return (TkFont *) fontPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpDeleteFont --
 *
190
191
192
193
194
195
196


197

198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226

227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248

249
250
251
252
253

254
255
256
257
258
259
260
261
262
263

264
265
266


267
268
269

270

271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343

344
345
346
347
348
349
350
351
352
353
354
355



356





357

358
359
360
361
362
363
364
365
366
367
368
369
370
371








372
373
374
375

376
377

378
379
380
381
382
383


384
385
386
387
388

389







390
391
392
393
394
395
396
397
398
399

400
401

402
403
404
405
406
407
408
409
410
411
412
413


414
415

416

417
418
419
420
421
422
423
424






425
426

427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442


443
444
445
446
447
448
449

450
451
452
453


454
455




456

457
458
459
460

461
462

463
464


465





















































































466



















































467
468
469
470
471
472
473
 *---------------------------------------------------------------------------
 */

void
TkpDeleteFont(
    TkFont *tkFontPtr)		/* Token of font to be deleted. */
{


    ckfree((char *) tkFontPtr);

}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetFontFamilies --
 *
 *	Return information about the font families that are available
 *	on the display of the given window.
 *
 * Results:
 *	interp->result is modified to hold a list of all the available
 *	font families.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
 
void
TkpGetFontFamilies(
    Tcl_Interp *interp,		/* Interp to hold result. */
    Tk_Window tkwin)		/* For display to query. */
{    
    MenuHandle fontMenu;
    int i;
    char itemText[257];
    

    fontMenu = NewMenu(1, "\px");
    AddResMenu(fontMenu, 'FONT');
    
    for (i = 1; i < CountMItems(fontMenu); i++) {
    	/*
    	 * Each item is a pascal string. Convert it to C and append.
    	 */
    	GetMenuItemText(fontMenu, i, (unsigned char *) itemText);
    	itemText[itemText[0] + 1] = '\0';
    	Tcl_AppendElement(interp, &itemText[1]);
    }
    DisposeMenu(fontMenu);
}


/*
 *---------------------------------------------------------------------------
 *
 * TkMacIsCharacterMissing --
 *
 *	Given a tkFont and a character determines whether the character has
 *	a glyph defined in the font or not. Note that this is potentially

 *	not compatible with Mac OS 8 as it looks at the font handle
 *	structure directly. Looks into the character array of the font
 *	handle to determine whether the glyph is defined or not.
 *
 * Results:

 *	Returns a 1 if the character is missing, a 0 if it is not.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TkMacIsCharacterMissing(

    Tk_Font tkfont,		/* The font we are looking in. */
    unsigned int searchChar)	/* The character we are looking for. */
{


    MacFont *fontPtr = (MacFont *) tkfont;
    FMInput fm;
    FontRec **fontRecHandle;

    

    fm.family = fontPtr->family;
    fm.size = fontPtr->size;
    fm.face = fontPtr->style;
    fm.needBits = 0;
    fm.device = 0;
    fm.numer.h = fm.numer.v = fm.denom.h = fm.denom.v = 1;

    /*
     * This element of the FMOutput structure was changed between the 2.0 & 3.0
     * versions of the Universal Headers.
     */
        
#if !defined(UNIVERSAL_INTERFACES_VERSION) || (UNIVERSAL_INTERFACES_VERSION < 0x0300)
    fontRecHandle = (FontRec **) FMSwapFont(&fm)->fontResult;
#else
    fontRecHandle = (FontRec **) FMSwapFont(&fm)->fontHandle;
#endif
    return *(short *) ((long) &(*fontRecHandle)->owTLoc 
    	    + ((long)((*fontRecHandle)->owTLoc + searchChar 
    	    - (*fontRecHandle)->firstChar) * sizeof(short))) == -1;
}


/*
 *---------------------------------------------------------------------------
 *
 *  Tk_MeasureChars --
 *
 *	Determine the number of characters from the string that will fit
 *	in the given horizontal span.  The measurement is done under the
 *	assumption that Tk_DrawChars() will be used to actually display
 *	the characters.
 *
 * Results:
 *	The return value is the number of characters from source that
 *	fit into the span that extends from 0 to maxLength.  *lengthPtr is
 *	filled with the x-coordinate of the right edge of the last
 *	character that did fit.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
Tk_MeasureChars(
    Tk_Font tkfont,		/* Font in which characters will be drawn. */
    CONST char *source,		/* Characters to be displayed.  Need not be
				 * '\0' terminated. */
    int numChars,		/* Maximum number of characters to consider
				 * from source string. */
    int maxLength,		/* If > 0, maxLength specifies the longest
				 * permissible line length; don't consider any
				 * character that would cross this
				 * x-position.  If <= 0, then line length is
				 * unbounded and the flags argument is
				 * ignored. */
    int flags,			/* Various flag bits OR-ed together:
				 * TK_PARTIAL_OK means include the last char
				 * which only partially fit on this line.
				 * TK_WHOLE_WORDS means stop on a word
				 * boundary, if possible.
				 * TK_AT_LEAST_ONE means return at least one
				 * character even if no characters fit. */
    int *lengthPtr)		/* Filled with x-location just after the
				 * terminating character. */
{
    short staticWidths[128];
    short *widths;
    CONST char *p, *term;
    int curX, termX, curIdx, sawNonSpace;
    MacFont *fontPtr;

    CGrafPtr saveWorld;
    GDHandle saveDevice;

    if (numChars == 0) {
	*lengthPtr = 0;
	return 0;
    }

    if (gWorld == NULL) {
	Rect rect = {0, 0, 1, 1};

	if (NewGWorld(&gWorld, 0, &rect, NULL, NULL, 0) != noErr) {



	    panic("NewGWorld failed in Tk_MeasureChars");





	}

    }
    GetGWorld(&saveWorld, &saveDevice);
    SetGWorld(gWorld, NULL);

    fontPtr = (MacFont *) tkfont;
    TextFont(fontPtr->family);
    TextSize(fontPtr->size);
    TextFace(fontPtr->style);

    if (maxLength <= 0) {
        *lengthPtr = TextWidth(source, 0, numChars);
        SetGWorld(saveWorld, saveDevice);
        return numChars;
    }









    if (numChars > maxLength) {
        /*
	 * Assume that all chars are at least 1 pixel wide, so there's no

	 * need to measure more characters than there are pixels.  This
	 * assumption could be refined to an iterative approach that would

	 * use that as a starting point and try more chars if necessary (if
	 * there actually were some zero-width chars).
	 */

	numChars = maxLength;
    }


    if (numChars > SHRT_MAX) {
	/*
	 * If they are trying to measure more than 32767 chars at one time,
	 * it would require several separate measurements.
	 */









	numChars = SHRT_MAX;
    }

    widths = staticWidths;
    if (numChars >= sizeof(staticWidths) / sizeof(staticWidths[0])) {
	widths = (short *) ckalloc((numChars + 1) * sizeof(short));
    }
    
    MeasureText((short) numChars, source, widths);
    

    if (widths[numChars] <= maxLength) {
        curX = widths[numChars];

        curIdx = numChars;
    } else {
        p = term = source;
        curX = termX = 0;

	sawNonSpace = !isspace(UCHAR(*p));
        for (curIdx = 1; ; curIdx++) {
            if (isspace(UCHAR(*p))) {
		if (sawNonSpace) {
		    term = p;
		    termX = widths[curIdx - 1];
		    sawNonSpace = 0;


		}
            } else {

		sawNonSpace = 1;

	    }
            if (widths[curIdx] > maxLength) {
                curIdx--;
                curX = widths[curIdx];
                break;
            }
            p++;
        }






        if (flags & TK_PARTIAL_OK) {
            curIdx++;

            curX = widths[curIdx];
        }
        if ((curIdx == 0) && (flags & TK_AT_LEAST_ONE)) {
	    /*
	     * The space was too small to hold even one character.  Since at
	     * least one character must always fit on a line, return the width
	     * of the first character.
	     */

	    curX = TextWidth(source, 0, 1);
	    curIdx = 1;
        } else if (flags & TK_WHOLE_WORDS) {
	    /*
	     * Break at last word that fits on the line.
	     */
	     


	    if ((flags & TK_AT_LEAST_ONE) && (term == source)) {
		/*
		 * The space was too small to hold an entire word.  This
		 * is the only word on the line, so just return the part of th
		 * word that fit.
		 */
		 

		 ;
            } else {
		curIdx = term - source;
		curX = termX;


	    }
	}




    }


    if (widths != staticWidths) {
	ckfree((char *) widths);
    }


    *lengthPtr = curX;

    
    SetGWorld(saveWorld, saveDevice);


    





















































































    return curIdx;



















































}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_DrawChars --
 *







>
>
|
>











|













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

<

|
<

|

|

<
<
>
|
<
<


>
|




|

|
|
|
>
|
<

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












|













|

|

|


|












<
<
<
<

>


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


|
<
<



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

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


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







560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597

598
599
600

601






602
603

604
605

606
607
608
609
610


611
612


613
614
615
616
617
618
619
620
621
622
623
624
625
626
627

628
629
630
631

632
633
634
635
636
637
638



639




640




641



642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689




690
691
692
693
694



695
696


697

698
699
700
701
702
703
704
705
706
707
708
709
710
711
712


713
714
715

716


717
718
719
720
721
722
723
724
725
726

727

728
729

730
731
732
733
734
735

736
737
738




739
740
741
742
743
744
745
746
747
748
749
750



751
752
753
754
755
756

757
758
759


760





761
762
763
764
765

766
767
768
769
770

771

772

773
774
775
776
777
778
779
780
781
782
783

784





785

786


787

788
789
790
791





792
793
794

795

796
797
798
799
800
801
802
803
804
805
806


807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
 *---------------------------------------------------------------------------
 */

void
TkpDeleteFont(
    TkFont *tkFontPtr)		/* Token of font to be deleted. */
{
    MacFont *fontPtr;
    
    fontPtr = (MacFont *) tkFontPtr;
    ReleaseFont(fontPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetFontFamilies --
 *
 *	Return information about the font families that are available
 *	on the display of the given window.
 *
 * Results:
 *	Modifies interp's result object to hold a list of all the available
 *	font families.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
 
void
TkpGetFontFamilies(
    Tcl_Interp *interp,		/* Interp to hold result. */
    Tk_Window tkwin)		/* For display to query. */
{    
    FontNameMap *mapPtr;
    Tcl_Obj *resultPtr, *strPtr;

        
    resultPtr = Tcl_GetObjResult(interp);
    for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) {

        strPtr = Tcl_NewStringObj(mapPtr->utfName, -1);






        Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
    }

}


/*
 *-------------------------------------------------------------------------
 *
 * TkpGetSubFonts --
 *


 *	A function used by the testing package for querying the actual 
 *	screen fonts that make up a font object.


 *
 * Results:
 *	Modifies interp's result object to hold a list containing the 
 *	names of the screen fonts that make up the given font object.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */
	
void
TkpGetSubFonts(interp, tkfont)
    Tcl_Interp *interp;		/* Interp to hold result. */
    Tk_Font tkfont;		/* Font object to query. */

{
    int i;
    Tcl_Obj *resultPtr, *strPtr;
    MacFont *fontPtr;

    FontFamily *familyPtr;
    Str255 nativeName;

    resultPtr = Tcl_GetObjResult(interp);    
    fontPtr = (MacFont *) tkfont;
    for (i = 0; i < fontPtr->numSubFonts; i++) {
	familyPtr = fontPtr->subFontArray[i].familyPtr;



    	GetFontName(familyPtr->faceNum, nativeName);




	strPtr = Tcl_NewStringObj(GetUtfFaceName(nativeName), -1);




	Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);



    }
}

/*
 *---------------------------------------------------------------------------
 *
 *  Tk_MeasureChars --
 *
 *	Determine the number of characters from the string that will fit
 *	in the given horizontal span.  The measurement is done under the
 *	assumption that Tk_DrawChars() will be used to actually display
 *	the characters.
 *
 * Results:
 *	The return value is the number of bytes from source that
 *	fit into the span that extends from 0 to maxLength.  *lengthPtr is
 *	filled with the x-coordinate of the right edge of the last
 *	character that did fit.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
Tk_MeasureChars(
    Tk_Font tkfont,		/* Font in which characters will be drawn. */
    CONST char *source,		/* UTF-8 string to be displayed.  Need not be
				 * '\0' terminated. */
    int numBytes,		/* Maximum number of bytes to consider
				 * from source string. */
    int maxLength,		/* If >= 0, maxLength specifies the longest
				 * permissible line length; don't consider any
				 * character that would cross this
				 * x-position.  If < 0, then line length is
				 * unbounded and the flags argument is
				 * ignored. */
    int flags,			/* Various flag bits OR-ed together:
				 * TK_PARTIAL_OK means include the last char
				 * which only partially fit on this line.
				 * TK_WHOLE_WORDS means stop on a word
				 * boundary, if possible.
				 * TK_AT_LEAST_ONE means return at least one
				 * character even if no characters fit. */
    int *lengthPtr)		/* Filled with x-location just after the
				 * terminating character. */
{




    MacFont *fontPtr;
    FontFamily *lastFamilyPtr;
    CGrafPtr saveWorld;
    GDHandle saveDevice;
    int curX, curByte;




    /*


     * According to "Inside Macintosh: Text", the Macintosh may

     * automatically substitute
     * ligatures or context-sensitive presentation forms when
     * measuring/displaying text within a font run.  We cannot safely
     * measure individual characters and add up the widths w/o errors.
     * However, if we convert a range of text from UTF-8 to, say,
     * Shift-JIS, and get the offset into the Shift-JIS string as to
     * where a word or line break would occur, then can we map that
     * number back to UTF-8?
     */
     
    fontPtr = (MacFont *) tkfont;

    GetGWorld(&saveWorld, &saveDevice);
    SetGWorld(gWorld, NULL);
    


    TextSize(fontPtr->size);
    TextFace(fontPtr->style);


    lastFamilyPtr = fontPtr->subFontArray[0].familyPtr; 


    
    if (numBytes == 0) {
    	curX = 0;
    	curByte = 0;
    } else if (maxLength < 0) {
    	CONST char *p, *end, *next;
    	Tcl_UniChar ch;
    	FontFamily *thisFamilyPtr;
    	Tcl_DString runString;
    	 

    	/*

    	 * A three step process:
    	 * 1. Find a contiguous range of characters that can all be 

    	 *    represented by a single screen font.
    	 * 2. Convert those chars to the encoding of that font.
	 * 3. Measure converted chars.
    	 */
    	 
        curX = 0;

        end = source + numBytes;
        for (p = source; p < end; ) {
            next = p + Tcl_UtfToUniChar(p, &ch);




            thisFamilyPtr = FindSubFontForChar(fontPtr, ch)->familyPtr;
            if (thisFamilyPtr != lastFamilyPtr) {
                TextFont(lastFamilyPtr->faceNum);
                Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source, 
                	p - source, &runString);
                curX += TextWidth(Tcl_DStringValue(&runString), 0, 
                	Tcl_DStringLength(&runString));
                Tcl_DStringFree(&runString);
                lastFamilyPtr = thisFamilyPtr;
                source = p;
            }
            p = next;



        }
	TextFont(lastFamilyPtr->faceNum);
        Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source, p - source, 
        	&runString);
        curX += TextWidth(Tcl_DStringValue(&runString), 0, 
        	Tcl_DStringLength(&runString));

        Tcl_DStringFree(&runString);
	curByte = numBytes;
    } else {


        CONST char *p, *end, *next, *sourceOrig;





        int widthLeft;
        FontFamily *thisFamilyPtr;
        Tcl_UniChar ch;
        char *rest;
        

	/*
	 * How many chars will fit in the space allotted? 
	 */
	
	if (maxLength > 32767) {

            maxLength = 32767;

        }

        
        widthLeft = maxLength; 
        sourceOrig = source;
        end = source + numBytes;      
	for (p = source; p < end; p = next) {
	    next = p + Tcl_UtfToUniChar(p, &ch);
  	    thisFamilyPtr = FindSubFontForChar(fontPtr, ch)->familyPtr;
  	    if (thisFamilyPtr != lastFamilyPtr) {
  	        if (p > source) {
  	            rest = BreakLine(lastFamilyPtr, flags, source, 
  	            	    p - source, &widthLeft);

  	            flags &= ~TK_AT_LEAST_ONE;





  	            if (rest != NULL) {

  	                p = source;


  	                break;

  	            }
  	        }
                lastFamilyPtr = thisFamilyPtr;
                source = p;





            }
        }
        

        if (p > source) {

            rest = BreakLine(lastFamilyPtr, flags, source, p - source, 
            	    &widthLeft);
        }
        
        if (rest == NULL) {
            curByte = numBytes;
        } else {
            curByte = rest - sourceOrig;
        }
        curX = maxLength - widthLeft;
    }



    SetGWorld(saveWorld, saveDevice);

    *lengthPtr = curX;
    return curByte;
}

/*
 *---------------------------------------------------------------------------
 *
 * BreakLine --
 *
 *	Determine where the given line of text should be broken so that it
 *	fits in the specified range.  Before calling this function, the 
 *	font values and graphics port must be set.
 *
 * Results:
 *	The return value is NULL if the specified range is larger that the
 *	space the text needs, and *widthLeftPtr is filled with how much 
 *	space is left in the range after measuring the whole text buffer.
 *	Otherwise, the return value is a pointer into the text buffer that 
 *	indicates where the line should be broken (up to, but not including 
 *	that character), and *widthLeftPtr is filled with how much space is 
 *	left in the range after measuring up to that character.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
 
static char *      	
BreakLine(
    FontFamily *familyPtr,	/* FontFamily that describes the font values
    				 * that are already selected into the graphics
    				 * port. */
    int flags,			/* Various flag bits OR-ed together:
				 * TK_PARTIAL_OK means include the last char
				 * which only partially fit on this line.
				 * TK_WHOLE_WORDS means stop on a word
				 * boundary, if possible.
				 * TK_AT_LEAST_ONE means return at least one
				 * character even if no characters fit. */				 
    CONST char *source,		/* UTF-8 string to be displayed.  Need not be
				 * '\0' terminated. */
    int numBytes,		/* Maximum number of bytes to consider
				 * from source string. */
    int *widthLeftPtr) 		/* On input, specifies size of range into 
    				 * which characters from source buffer should
    				 * be fit.  On output, filled with how much
    				 * space is left after fitting as many 
    				 * characters as possible into the range. 
    				 * Result may be negative if TK_AT_LEAST_ONE
    				 * was specified in the flags argument. */
{
    Fixed pixelWidth, widthLeft;
    StyledLineBreakCode breakCode;
    Tcl_DString runString;
    long textOffset;
    Boolean leadingEdge;
    Point point;
    int charOffset, thisCharWasDoubleByte;
    char *p, *end, *typeTable;
    
    TextFont(familyPtr->faceNum);
    Tcl_UtfToExternalDString(familyPtr->encoding, source, numBytes,
    	    &runString);
    pixelWidth = Int2Fixed(*widthLeftPtr) + 1;
    if (flags & TK_WHOLE_WORDS) {
        textOffset = (flags & TK_AT_LEAST_ONE);  
        widthLeft = pixelWidth;
	breakCode = StyledLineBreak(Tcl_DStringValue(&runString),
		Tcl_DStringLength(&runString), 0, Tcl_DStringLength(&runString), 
		0, &widthLeft, &textOffset);
        if (breakCode != smBreakOverflow) {
            /* 
             * StyledLineBreak includes all the space characters at the end of 
             * line that we want to suppress.
             */
             
            textOffset = VisibleLength(Tcl_DStringValue(&runString), textOffset);
            goto getoffset;
        }
    } else {
        point.v = 1;
        point.h = 1;
	textOffset = PixelToChar(Tcl_DStringValue(&runString),
		Tcl_DStringLength(&runString), 0, pixelWidth, &leadingEdge, 
		&widthLeft, smOnlyStyleRun, point, point);        
	if (Fixed2Int(widthLeft) < 0) {
	    goto getoffset;
	}
    }
    *widthLeftPtr = Fixed2Int(widthLeft);
    Tcl_DStringFree(&runString);
    return NULL;

    /*
     * The conversion routine that converts UTF-8 to the target encoding
     * must map one UTF-8 character to exactly one encoding-specific
     * character, so that the following algorithm works:
     *  
     * 1. Get byte offset of where line should be broken.
     * 2. Get char offset corresponding to that byte offset.
     * 3. Map that char offset to byte offset in UTF-8 string.
     */ 

    getoffset:
    thisCharWasDoubleByte = 0;
    if (familyPtr->isMultiByteFont == 0) {
        charOffset = textOffset;
    } else {
        charOffset = 0;
        typeTable = familyPtr->typeTable;
        
        p = Tcl_DStringValue(&runString);
        end = p + textOffset;
        thisCharWasDoubleByte = typeTable[*((unsigned char *) p)];
        for ( ; p < end; p++) {
            thisCharWasDoubleByte = typeTable[*((unsigned char *) p)];
            p += thisCharWasDoubleByte;
            charOffset++;
        }
    }
    
    if ((flags & TK_WHOLE_WORDS) == 0) {
    	if ((flags & TK_PARTIAL_OK) && (leadingEdge != 0)) {
	    textOffset += thisCharWasDoubleByte;
	    textOffset++;
	    charOffset++;
        } else if (((flags & TK_PARTIAL_OK) == 0) && (leadingEdge == 0)) {
	    textOffset -= thisCharWasDoubleByte;
	    textOffset--;
	    charOffset--;
	}
    }
    if ((textOffset == 0) && (Tcl_DStringLength(&runString) > 0) 
    	    && (flags & TK_AT_LEAST_ONE)) {
    	p = Tcl_DStringValue(&runString);
        textOffset += familyPtr->typeTable[*((unsigned char *) p)];
        textOffset++;
        charOffset++;
    }
    *widthLeftPtr = Fixed2Int(pixelWidth) 
    	    - TextWidth(Tcl_DStringValue(&runString), 0, textOffset);
    Tcl_DStringFree(&runString);
    return Tcl_UtfAtIndex(source, charOffset);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_DrawChars --
 *
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
void
Tk_DrawChars(
    Display *display,		/* Display on which to draw. */
    Drawable drawable,		/* Window or pixmap in which to draw. */
    GC gc,			/* Graphics context for drawing characters. */
    Tk_Font tkfont,		/* Font in which characters will be drawn;
				 * must be the same as font used in GC. */
    CONST char *source,		/* Characters to be displayed.  Need not be
				 * '\0' terminated.  All Tk meta-characters
				 * (tabs, control characters, and newlines)
				 * should be stripped out of the string that
				 * is passed to this function.  If they are
				 * not stripped out, they will be displayed as
				 * regular printing characters. */
    int numChars,		/* Number of characters in string. */
    int x, int y)		/* Coordinates at which to place origin of
				 * string when drawing. */
{
    MacFont *fontPtr;
    MacDrawable *macWin;
    RGBColor macColor, origColor;
    GWorldPtr destPort;







|






|







972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
void
Tk_DrawChars(
    Display *display,		/* Display on which to draw. */
    Drawable drawable,		/* Window or pixmap in which to draw. */
    GC gc,			/* Graphics context for drawing characters. */
    Tk_Font tkfont,		/* Font in which characters will be drawn;
				 * must be the same as font used in GC. */
    CONST char *source,		/* UTF-8 string to be displayed.  Need not be
				 * '\0' terminated.  All Tk meta-characters
				 * (tabs, control characters, and newlines)
				 * should be stripped out of the string that
				 * is passed to this function.  If they are
				 * not stripped out, they will be displayed as
				 * regular printing characters. */
    int numBytes,		/* Number of bytes in string. */
    int x, int y)		/* Coordinates at which to place origin of
				 * string when drawing. */
{
    MacFont *fontPtr;
    MacDrawable *macWin;
    RGBColor macColor, origColor;
    GWorldPtr destPort;
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577

578
579
580
581
582
583
584
585
586
587
588
589








































































590
591














































592
593
594
595
596
597
598
599
600
601
602
603
604



605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622


623
624
625
626
627
628
629
630
631
632
633
634
635
636
637

638
639
640
641
642
643
644
645

646


647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672




673
674









































































































































































































































































































































































































































































































































































































































































































































675











676
677
678





































































































































	pixmap = Tk_GetPixmap(display, drawable, 	
		stippleMap->bounds.right, stippleMap->bounds.bottom, 0);
		
	bufferPort = TkMacGetDrawablePort(pixmap);
	SetGWorld(bufferPort, NULL);
	
	TextFont(fontPtr->family);
	TextSize(fontPtr->size);
	TextFace(fontPtr->style);
	
	if (TkSetMacColor(gc->foreground, &macColor) == true) {
	    RGBForeColor(&macColor);
	}

	ShowPen();
	MoveTo((short) 0, (short) 0);
	FillRect(&stippleMap->bounds, &tcl_macQdPtr->white);
	MoveTo((short) x, (short) y);
	DrawText(source, 0, (short) numChars);

	SetGWorld(destPort, NULL);
	CopyDeepMask(&((GrafPtr) bufferPort)->portBits, stippleMap, 
		&((GrafPtr) destPort)->portBits, &stippleMap->bounds,
		&stippleMap->bounds, &((GrafPtr) destPort)->portRect,
		srcOr, NULL);
	
	/* TODO: this doesn't work quite right - it does a blend.   you can't
	 * draw white text when you have a stipple.
	 */
		
	Tk_FreePixmap(display, pixmap);
	ckfree(stippleMap->baseAddr);
	ckfree((char *)stippleMap);
    } else {
	TextFont(fontPtr->family);
	TextSize(fontPtr->size);
	TextFace(fontPtr->style);
	
	if (TkSetMacColor(gc->foreground, &macColor) == true) {
	    RGBForeColor(&macColor);
	}

	ShowPen();

	MoveTo((short) (macWin->xOff + x), (short) (macWin->yOff + y));
	DrawText(source, 0, (short) numChars);
    }

    TextFont(txFont);
    TextSize(txSize);
    TextFace(txFace);
    RGBForeColor(&origColor);
    SetGWorld(saveWorld, saveDevice);
}

/*








































































 *---------------------------------------------------------------------------
 *














































 * AllocMacFont --
 *
 *	Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
 *	Allocates and intializes the memory for a new TkFont that
 *	wraps the platform-specific data.
 *
 * Results:
 *	Returns pointer to newly constructed TkFont.  
 *
 *	The caller is responsible for initializing the fields of the
 *	TkFont that are used exclusively by the generic TkFont code, and
 *	for releasing those fields before calling TkpDeleteFont().
 *



 * Side effects:
 *	Memory allocated.
 *
 *---------------------------------------------------------------------------
 */ 

static TkFont *
AllocMacFont(
    TkFont *tkFontPtr,		/* If non-NULL, store the information in
				 * this existing TkFont structure, rather than
				 * allocating a new structure to hold the
				 * font; the existing contents of the font
				 * will be released.  If NULL, a new TkFont
				 * structure is allocated. */
    Tk_Window tkwin,		/* For display where font will be used. */
    int family,			/* Macintosh font family. */
    int size,			/* Point size for Macintosh font. */
    int style)			/* Macintosh style bits. */


{
    char buf[257];
    FontInfo fi;
    MacFont *fontPtr;
    TkFontAttributes *faPtr;
    TkFontMetrics *fmPtr;
    CGrafPtr saveWorld;
    GDHandle saveDevice;

    if (gWorld == NULL) {
	Rect rect = {0, 0, 1, 1};

	if (NewGWorld(&gWorld, 0, &rect, NULL, NULL, 0) != noErr) {
	    panic("NewGWorld failed in AllocMacFont");
	}

    }
    GetGWorld(&saveWorld, &saveDevice);
    SetGWorld(gWorld, NULL);

    if (tkFontPtr == NULL) {
	fontPtr = (MacFont *) ckalloc(sizeof(MacFont));
    } else {
	fontPtr = (MacFont *) tkFontPtr;

    }



    fontPtr->font.fid	= (Font) fontPtr;

    faPtr = &fontPtr->font.fa;
    GetFontName(family, (StringPtr) buf);
    buf[UCHAR(buf[0]) + 1] = '\0';
    faPtr->family	= Tk_GetUid(buf + 1);
    faPtr->pointsize	= size;
    faPtr->weight	= (style & bold) ? TK_FW_BOLD : TK_FW_NORMAL;
    faPtr->slant	= (style & italic) ? TK_FS_ITALIC : TK_FS_ROMAN;
    faPtr->underline	= ((style & underline) != 0);
    faPtr->overstrike	= 0;

    fmPtr = &fontPtr->font.fm;
    TextFont(family);
    TextSize(size);
    TextFace(style);
    GetFontInfo(&fi);
    fmPtr->ascent	= fi.ascent;	
    fmPtr->descent	= fi.descent;	
    fmPtr->maxWidth	= fi.widMax;
    fmPtr->fixed	= (CharWidth('i') == CharWidth('w'));

    fontPtr->family	= (short) family;
    fontPtr->size	= (short) size;
    fontPtr->style	= (short) style;





    SetGWorld(saveWorld, saveDevice);





















































































































































































































































































































































































































































































































































































































































































































































    return (TkFont *) fontPtr;
}












































































































































<
<
<
<



<

<

<
|














|
<
<
<
<



<

>
|
<










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


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


<
|
|
<
<





>
>
>






|
|
<
<
<
<
<
<

|

|
>
>

|

<




|
<
<

|
|
|
>
|


|
<
<
|
<
>
|
>
>



|
<
<
|
|





|
<
<
<
<




|
<
|

>
>
>
>


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

>
>
>
>
>
>
>
>
>
>
>
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1021
1022
1023
1024
1025
1026
1027




1028
1029
1030

1031

1032

1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048




1049
1050
1051

1052
1053
1054

1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187

1188
1189


1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205






1206
1207
1208
1209
1210
1211
1212
1213
1214

1215
1216
1217
1218
1219


1220
1221
1222
1223
1224
1225
1226
1227
1228


1229

1230
1231
1232
1233
1234
1235
1236
1237


1238
1239
1240
1241
1242
1243
1244
1245




1246
1247
1248
1249
1250

1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118

	pixmap = Tk_GetPixmap(display, drawable, 	
		stippleMap->bounds.right, stippleMap->bounds.bottom, 0);
		
	bufferPort = TkMacGetDrawablePort(pixmap);
	SetGWorld(bufferPort, NULL);
	




	if (TkSetMacColor(gc->foreground, &macColor) == true) {
	    RGBForeColor(&macColor);
	}

	ShowPen();

	FillRect(&stippleMap->bounds, &tcl_macQdPtr->white);

	MultiFontDrawText(fontPtr, source, numBytes, 0, 0);

	SetGWorld(destPort, NULL);
	CopyDeepMask(&((GrafPtr) bufferPort)->portBits, stippleMap, 
		&((GrafPtr) destPort)->portBits, &stippleMap->bounds,
		&stippleMap->bounds, &((GrafPtr) destPort)->portRect,
		srcOr, NULL);
	
	/* TODO: this doesn't work quite right - it does a blend.   you can't
	 * draw white text when you have a stipple.
	 */
		
	Tk_FreePixmap(display, pixmap);
	ckfree(stippleMap->baseAddr);
	ckfree((char *)stippleMap);
    } else {	




	if (TkSetMacColor(gc->foreground, &macColor) == true) {
	    RGBForeColor(&macColor);
	}

	ShowPen();
	MultiFontDrawText(fontPtr, source, numBytes, macWin->xOff + x,
		macWin->yOff + y);

    }

    TextFont(txFont);
    TextSize(txSize);
    TextFace(txFace);
    RGBForeColor(&origColor);
    SetGWorld(saveWorld, saveDevice);
}

/*
 *-------------------------------------------------------------------------
 *
 * MultiFontDrawText --
 *
 *	Helper function for Tk_DrawChars.  Draws characters, using the 
 *	various screen fonts in fontPtr to draw multilingual characters.
 *	Note: No bidirectional support.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Information gets drawn on the screen.  
 *	Contents of fontPtr may be modified if more subfonts were loaded 
 *	in order to draw all the multilingual characters in the given 
 *	string.
 *
 *-------------------------------------------------------------------------
 */

static void
MultiFontDrawText(
    MacFont *fontPtr,		/* Contains set of fonts to use when drawing
				 * following string. */
    CONST char *source,		/* Potentially multilingual UTF-8 string. */
    int numBytes,		/* Length of string in bytes. */
    int x, int y)		/* Coordinates at which to place origin *
				 * of string when drawing. */
{
    FontFamily *lastFamilyPtr, *thisFamilyPtr;
    Tcl_DString runString;
    CONST char *p, *end, *next;
    Tcl_UniChar ch;
    
    TextSize(fontPtr->size);
    TextFace(fontPtr->style);

    lastFamilyPtr = fontPtr->subFontArray[0].familyPtr;
    
    end = source + numBytes;
    for (p = source; p < end; ) {
        next = p + Tcl_UtfToUniChar(p, &ch);
        thisFamilyPtr = FindSubFontForChar(fontPtr, ch)->familyPtr;
        if (thisFamilyPtr != lastFamilyPtr) {
            if (p > source) {
		TextFont(lastFamilyPtr->faceNum);
 		Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source, 
		        p - source, &runString);
		MoveTo((short) x, (short) y);
		DrawText(Tcl_DStringValue(&runString), 0, 
		        Tcl_DStringLength(&runString));
		x += TextWidth(Tcl_DStringValue(&runString), 0, 
		        Tcl_DStringLength(&runString));
		Tcl_DStringFree(&runString);
                source = p;
	    }
            lastFamilyPtr = thisFamilyPtr;
        }
        p = next;
    }
    if (p > source) {
        TextFont(thisFamilyPtr->faceNum);
	Tcl_UtfToExternalDString(lastFamilyPtr->encoding, source, 
	        p - source, &runString);
	MoveTo((short) x, (short) y);
    	DrawText(Tcl_DStringValue(&runString), 0, 
	        Tcl_DStringLength(&runString));
	Tcl_DStringFree(&runString);
    }
}        

/*
 *---------------------------------------------------------------------------
 *
 * TkMacIsCharacterMissing --
 *
 *	Given a tkFont and a character determines whether the character has
 *	a glyph defined in the font or not. Note that this is potentially
 *	not compatible with Mac OS 8 as it looks at the font handle
 *	structure directly. Looks into the character array of the font
 *	handle to determine whether the glyph is defined or not.
 *
 * Results:
 *	Returns a 1 if the character is missing, a 0 if it is not.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TkMacIsCharacterMissing(
    Tk_Font tkfont,		/* The font we are looking in. */
    unsigned int searchChar)	/* The character we are looking for. */
{
    MacFont *fontPtr = (MacFont *) tkfont;
    FMInput fm;
    FontRec **fontRecHandle;
    
    fm.family = fontPtr->subFontArray[0].familyPtr->faceNum;
    fm.size = fontPtr->size;
    fm.face = fontPtr->style;
    fm.needBits = 0;
    fm.device = 0;
    fm.numer.h = fm.numer.v = fm.denom.h = fm.denom.v = 1;
    
#if !defined(UNIVERSAL_INTERFACES_VERSION) || (UNIVERSAL_INTERFACES_VERSION < 0x0300)
    fontRecHandle = (FontRec **) FMSwapFont(&fm)->fontResult;
#else
    fontRecHandle = (FontRec **) FMSwapFont(&fm)->fontHandle;
#endif
    return *(short *) ((long) &(*fontRecHandle)->owTLoc 
    	    + ((long)((*fontRecHandle)->owTLoc + searchChar 
    	    - (*fontRecHandle)->firstChar) * sizeof(short))) == -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * InitFont --
 *
 *	Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().

 *	Initializes the memory for a MacFont that wraps the platform-specific
 *	data.


 *
 *	The caller is responsible for initializing the fields of the
 *	TkFont that are used exclusively by the generic TkFont code, and
 *	for releasing those fields before calling TkpDeleteFont().
 *
 * Results:
 *	Fills the MacFont structure.
 *
 * Side effects:
 *	Memory allocated.
 *
 *---------------------------------------------------------------------------
 */ 

static void
InitFont(






    Tk_Window tkwin,		/* For display where font will be used. */
    int faceNum,		/* Macintosh font number. */
    int size,			/* Point size for Macintosh font. */
    int style,			/* Macintosh style bits. */
    MacFont *fontPtr)		/* Filled with information constructed from
				 * the above arguments. */
{
    Str255 nativeName;
    FontInfo fi;

    TkFontAttributes *faPtr;
    TkFontMetrics *fmPtr;
    CGrafPtr saveWorld;
    GDHandle saveDevice;
    short pixels;



    if (size == 0) {
    	size = -GetDefFontSize();
    }
    pixels = (short) TkFontGetPixels(tkwin, size);
    
    GetGWorld(&saveWorld, &saveDevice);
    SetGWorld(gWorld, NULL);
    TextFont(faceNum);


    TextSize(pixels);

    TextFace(style);

    GetFontInfo(&fi);
    GetFontName(faceNum, nativeName);

    fontPtr->font.fid	= (Font) fontPtr;

    faPtr 		= &fontPtr->font.fa;


    faPtr->family	= GetUtfFaceName(nativeName);
    faPtr->size		= TkFontGetPoints(tkwin, size);
    faPtr->weight	= (style & bold) ? TK_FW_BOLD : TK_FW_NORMAL;
    faPtr->slant	= (style & italic) ? TK_FS_ITALIC : TK_FS_ROMAN;
    faPtr->underline	= ((style & underline) != 0);
    faPtr->overstrike	= 0;

    fmPtr 		= &fontPtr->font.fm;




    fmPtr->ascent	= fi.ascent;	
    fmPtr->descent	= fi.descent;	
    fmPtr->maxWidth	= fi.widMax;
    fmPtr->fixed	= (CharWidth('i') == CharWidth('w'));
    

    fontPtr->size	= pixels;
    fontPtr->style	= (short) style;
        
    fontPtr->numSubFonts 	= 1;
    fontPtr->subFontArray	= fontPtr->staticSubFonts;
    InitSubFont(fontPtr, faceNum, &fontPtr->subFontArray[0]);

    SetGWorld(saveWorld, saveDevice);
}

/*
 *-------------------------------------------------------------------------
 *
 * ReleaseFont --
 * 
 *	Called to release the Macintosh-specific contents of a TkFont.
 *	The caller is responsible for freeing the memory used by the
 *	font itself.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is freed.
 *
 *---------------------------------------------------------------------------
 */
 
static void
ReleaseFont(
    MacFont *fontPtr)		/* The font to delete. */
{
    int i;

    for (i = 0; i < fontPtr->numSubFonts; i++) {
	ReleaseSubFont(&fontPtr->subFontArray[i]);
    }
    if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
	ckfree((char *) fontPtr->subFontArray);
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * InitSubFont --
 *
 *	Wrap a screen font and load the FontFamily that represents
 *	it.  Used to prepare a SubFont so that characters can be mapped
 *	from UTF-8 to the charset of the font.
 *
 * Results:
 *	The subFontPtr is filled with information about the font.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static void
InitSubFont(
    CONST MacFont *fontPtr,	/* Font object in which the SubFont will be
    				 * used. */
    int faceNum,		/* The font number. */
    SubFont *subFontPtr)	/* Filled with SubFont constructed from 
    				 * above attributes. */
{
    subFontPtr->familyPtr = AllocFontFamily(fontPtr, faceNum);
    subFontPtr->fontMap = subFontPtr->familyPtr->fontMap;
}

/*
 *-------------------------------------------------------------------------
 *
 * ReleaseSubFont --
 *
 *	Called to release the contents of a SubFont.  The caller is 
 *	responsible for freeing the memory used by the SubFont itself.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory and resources are freed.
 *
 *---------------------------------------------------------------------------
 */

static void
ReleaseSubFont(
    SubFont *subFontPtr)	/* The SubFont to delete. */
{
    FreeFontFamily(subFontPtr->familyPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * AllocFontFamily --
 *
 *	Find the FontFamily structure associated with the given font 
 *	family.  The information should be stored by the caller in a 
 *	SubFont and used when determining if that SubFont supports a 
 *	character. 
 *
 * Results:
 *	A pointer to a FontFamily.  The reference count in the FontFamily
 *	is automatically incremented.  When the SubFont is released, the
 *	reference count is decremented.  When no SubFont is using this
 *	FontFamily, it may be deleted.
 *
 * Side effects:
 *	A new FontFamily structure will be allocated if this font family
 *	has not been seen.  
 *
 *-------------------------------------------------------------------------
 */

static FontFamily *
AllocFontFamily(
    CONST MacFont *fontPtr,	/* Font object in which the FontFamily will
    				 * be used. */
    int faceNum)		/* The font number. */
{
    FontFamily *familyPtr;
    int i;
    
    familyPtr = fontFamilyList;
    for (; familyPtr != NULL; familyPtr = familyPtr->nextPtr) {
	if (familyPtr->faceNum == faceNum) {
	    familyPtr->refCount++;
	    return familyPtr;
	}
    }

    familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily));
    memset(familyPtr, 0, sizeof(FontFamily));
    familyPtr->nextPtr = fontFamilyList;
    fontFamilyList = familyPtr;

    /* 
     * Set key for this FontFamily. 
     */
     
    familyPtr->faceNum = faceNum;

    /* 
     * An initial refCount of 2 means that FontFamily information will
     * persist even when the SubFont that loaded the FontFamily is released.
     * Change it to 1 to cause FontFamilies to be unloaded when not in use.
     */
     
    familyPtr->refCount = 2;
    familyPtr->encoding = GetFontEncoding(faceNum, 1, &familyPtr->isSymbolFont);
    familyPtr->isMultiByteFont = 0;
    FillParseTable(familyPtr->typeTable, FontToScript(faceNum));
    for (i = 0; i < 256; i++) {
        if (familyPtr->typeTable[i] != 0) {
            familyPtr->isMultiByteFont = 1;
            break;
        }
    }
    return familyPtr;
}

/*
 *-------------------------------------------------------------------------
 *
 * FreeFontFamily --
 *
 *	Called to free a FontFamily when the SubFont is finished using it.
 *	Frees the contents of the FontFamily and the memory used by the
 *	FontFamily itself.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */
 
static void
FreeFontFamily(
    FontFamily *familyPtr)	/* The FontFamily to delete. */
{
    FontFamily **familyPtrPtr;
    int i;

    if (familyPtr == NULL) {
        return;
    }
    familyPtr->refCount--;
    if (familyPtr->refCount > 0) {
    	return;
    }
    Tcl_FreeEncoding(familyPtr->encoding);
    for (i = 0; i < FONTMAP_PAGES; i++) {
        if (familyPtr->fontMap[i] != NULL) {
            ckfree((char *) familyPtr->fontMap[i]);
        }
    }
    
    /* 
     * Delete from list. 
     */
         
    for (familyPtrPtr = &fontFamilyList; ; ) {
        if (*familyPtrPtr == familyPtr) {
  	    *familyPtrPtr = familyPtr->nextPtr;
	    break;
	}
	familyPtrPtr = &(*familyPtrPtr)->nextPtr;
    }
    
    ckfree((char *) familyPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * FindSubFontForChar --
 *
 *	Determine which physical screen font is necessary to use to 
 *	display the given character.  If the font object does not have
 *	a screen font that can display the character, another screen font
 *	may be loaded into the font object, following a set of preferred
 *	fallback rules.
 *
 * Results:
 *	The return value is the SubFont to use to display the given 
 *	character. 
 *
 * Side effects:
 *	The contents of fontPtr are modified to cache the results
 *	of the lookup and remember any SubFonts that were dynamically 
 *	loaded.
 *
 *-------------------------------------------------------------------------
 */

static SubFont *
FindSubFontForChar(
    MacFont *fontPtr,		/* The font object with which the character
				 * will be displayed. */
    int ch)			/* The Unicode character to be displayed. */
{
    int i, j, k;
    char *fallbackName;
    char **aliases;
    SubFont *subFontPtr;
    FontNameMap *mapPtr;
    Tcl_DString faceNames;
    char ***fontFallbacks;
    char **anyFallbacks;
    
    if (FontMapLookup(&fontPtr->subFontArray[0], ch)) {
	return &fontPtr->subFontArray[0];
    }

    for (i = 1; i < fontPtr->numSubFonts; i++) {
	if (FontMapLookup(&fontPtr->subFontArray[i], ch)) {
	    return &fontPtr->subFontArray[i];
	}
    }

    /*
     * Keep track of all face names that we check, so we don't check some
     * name multiple times if it can be reached by multiple paths.
     */
     
    Tcl_DStringInit(&faceNames);
        
    aliases = TkFontGetAliasList(fontPtr->font.fa.family);

    subFontPtr = NULL;
    fontFallbacks = TkFontGetFallbacks();
    for (i = 0; fontFallbacks[i] != NULL; i++) {
	for (j = 0; fontFallbacks[i][j] != NULL; j++) {
	    fallbackName = fontFallbacks[i][j];
	    if (strcasecmp(fallbackName, fontPtr->font.fa.family) == 0) {
		/*
		 * If the base font has a fallback...
		 */

		goto tryfallbacks;
	    } else if (aliases != NULL) {
		/* 
		 * Or if an alias for the base font has a fallback...
		 */

		for (k = 0; aliases[k] != NULL; k++) {
		    if (strcasecmp(aliases[k], fallbackName) == 0) {
		        goto tryfallbacks;
		    }
		}
	    }
	}
	continue;
	    
	/* 
	 * ...then see if we can use one of the fallbacks, or an
	 * alias for one of the fallbacks.
	 */

	tryfallbacks:
	for (j = 0; fontFallbacks[i][j] != NULL; j++) {
	    fallbackName = fontFallbacks[i][j];
	    subFontPtr = CanUseFallbackWithAliases(fontPtr, fallbackName,
		    ch, &faceNames);
	    if (subFontPtr != NULL) {
		goto end;
	    }
	}
    }
    
    /*
     * See if we can use something from the global fallback list. 
     */

    anyFallbacks = TkFontGetGlobalClass();
    for (i = 0; anyFallbacks[i] != NULL; i++) {
	fallbackName = anyFallbacks[i];
	subFontPtr = CanUseFallbackWithAliases(fontPtr, fallbackName, ch,
		&faceNames);
	if (subFontPtr != NULL) {
	    goto end;
	}
    }

    /*
     * Try all face names available in the whole system until we
     * find one that can be used.
     */

    for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) {
        fallbackName = mapPtr->utfName;
	if (SeenName(fallbackName, &faceNames) == 0) {
	    subFontPtr = CanUseFallback(fontPtr, fallbackName, ch);
	    if (subFontPtr != NULL) {
		goto end;
	    }
	}
    }
    
    end:
    Tcl_DStringFree(&faceNames);
    
    if (subFontPtr == NULL) {
        /* 
         * No font can display this character.  We will use the base font
         * and have it display the "unknown" character.
         */

	subFontPtr = &fontPtr->subFontArray[0];
        FontMapInsert(subFontPtr, ch);
    }
    return subFontPtr;
}

/*
 *-------------------------------------------------------------------------
 *
 * FontMapLookup --
 *
 *	See if the screen font can display the given character.
 *
 * Results:
 *	The return value is 0 if the screen font cannot display the
 *	character, non-zero otherwise.
 *
 * Side effects:
 *	New pages are added to the font mapping cache whenever the
 *	character belongs to a page that hasn't been seen before.
 *	When a page is loaded, information about all the characters on
 *	that page is stored, not just for the single character in
 *	question.
 *
 *-------------------------------------------------------------------------
 */

static int
FontMapLookup(
    SubFont *subFontPtr,	/* Contains font mapping cache to be queried
				 * and possibly updated. */
    int ch)			/* Character to be tested. */
{
    int row, bitOffset;

    row = ch >> FONTMAP_SHIFT;
    if (subFontPtr->fontMap[row] == NULL) {
	FontMapLoadPage(subFontPtr, row);
    }
    bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
    return (subFontPtr->fontMap[row][bitOffset >> 3] >> (bitOffset & 7)) & 1;
}

/*
 *-------------------------------------------------------------------------
 *
 * FontMapInsert --
 *
 *	Tell the font mapping cache that the given screen font should be
 *	used to display the specified character.  This is called when no
 *	font on the system can be be found that can display that 
 *	character; we lie to the font and tell it that it can display
 *	the character, otherwise we would end up re-searching the entire
 *	fallback hierarchy every time that character was seen.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	New pages are added to the font mapping cache whenever the
 *	character belongs to a page that hasn't been seen before.
 *	When a page is loaded, information about all the characters on
 *	that page is stored, not just for the single character in
 *	question.
 *
 *-------------------------------------------------------------------------
 */

static void
FontMapInsert(
    SubFont *subFontPtr,	/* Contains font mapping cache to be 
				 * updated. */
    int ch)			/* Character to be added to cache. */
{
    int row, bitOffset;

    row = ch >> FONTMAP_SHIFT;
    if (subFontPtr->fontMap[row] == NULL) {
	FontMapLoadPage(subFontPtr, row);
    }
    bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
    subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
}

/*
 *-------------------------------------------------------------------------
 *
 * FontMapLoadPage --
 *
 *	Load information about all the characters on a given page.
 *	This information consists of one bit per character that indicates
 *	whether the associated HFONT can (1) or cannot (0) display the
 *	characters on the page.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Mempry allocated.
 *
 *-------------------------------------------------------------------------
 */
static void 
FontMapLoadPage(
    SubFont *subFontPtr,	/* Contains font mapping cache to be 
				 * updated. */
    int row)			/* Index of the page to be loaded into 
				 * the cache. */
{
    FMInput fm;
    FontRec *fontRecPtr;
    short *widths;
    int i, end, bitOffset, isMultiByteFont;
    char src[TCL_UTF_MAX];
    unsigned char buf[16];
    int srcRead, dstWrote;
    Tcl_Encoding encoding;
     
    subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8);
    memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8);
    
    encoding = subFontPtr->familyPtr->encoding;
    
    fm.family 	= subFontPtr->familyPtr->faceNum;
    fm.size 	= 12;
    fm.face 	= 0;
    fm.needBits = 0;
    fm.device	= 0;
    fm.numer.h	= 1;
    fm.numer.v	= 1;
    fm.denom.h	= 1;
    fm.denom.v	= 1;
    
#if !defined(UNIVERSAL_INTERFACES_VERSION) || (UNIVERSAL_INTERFACES_VERSION < 0x0300)
    fontRecPtr = *((FontRec **) FMSwapFont(&fm)->fontResult);
#else
    fontRecPtr = *((FontRec **) FMSwapFont(&fm)->fontHandle);
#endif
    widths = (short *) ((long) &fontRecPtr->owTLoc 
    	    + ((long) (fontRecPtr->owTLoc - fontRecPtr->firstChar) 
    	    		* sizeof(short)));
    isMultiByteFont = subFontPtr->familyPtr->isMultiByteFont;
    	    		
    end = (row + 1) << FONTMAP_SHIFT;
    for (i = row << FONTMAP_SHIFT; i < end; i++) {
        if (Tcl_UtfToExternal(NULL, encoding, src, Tcl_UniCharToUtf(i, src), 
        	TCL_ENCODING_STOPONERROR, NULL, (char *) buf, sizeof(buf), 
		&srcRead, &dstWrote, NULL) == TCL_OK) {
            
            if (((isMultiByteFont != 0) && (buf[0] > 31))
            	    || (widths[buf[0]] != -1)) {
            	if ((buf[0] == 0x11) && (widths[0x12] == -1)) {
            	    continue;
            	}
            	
                /* 
                 * Mac's char existence metrics are only for one-byte
                 * characters.  If we have a double-byte char, just 
                 * assume that the font supports that char if the font's 
                 * encoding supports that char.
                 */
                
                bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
		subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
	    }
	}
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * CanUseFallbackWithAliases --
 *
 *	Helper function for FindSubFontForChar.  Determine if the
 *	specified face name (or an alias of the specified face name)
 *	can be used to construct a screen font that can display the
 *	given character.
 *
 * Results:
 *	See CanUseFallback().
 *
 * Side effects:
 *	If the name and/or one of its aliases was rejected, the
 *	rejected string is recorded in nameTriedPtr so that it won't
 *	be tried again.
 *
 *---------------------------------------------------------------------------
 */

static SubFont *
CanUseFallbackWithAliases(
    MacFont *fontPtr,		/* The font object that will own the new
				 * screen font. */
    char *faceName,		/* Desired face name for new screen font. */
    int ch,			/* The Unicode character that the new
				 * screen font must be able to display. */
    Tcl_DString *nameTriedPtr)	/* Records face names that have already
				 * been tried.  It is possible for the same
				 * face name to be queried multiple times when
				 * trying to find a suitable screen font. */
{
    SubFont *subFontPtr;
    char **aliases;
    int i;
    
    if (SeenName(faceName, nameTriedPtr) == 0) {
	subFontPtr = CanUseFallback(fontPtr, faceName, ch);
	if (subFontPtr != NULL) {
	    return subFontPtr;
	}
    }
    aliases = TkFontGetAliasList(faceName);
    if (aliases != NULL) {
	for (i = 0; aliases[i] != NULL; i++) {
	    if (SeenName(aliases[i], nameTriedPtr) == 0) {
		subFontPtr = CanUseFallback(fontPtr, aliases[i], ch);
		if (subFontPtr != NULL) {
		    return subFontPtr;
		}
	    }
	}
    }
    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * SeenName --
 *
 *	Used to determine we have already tried and rejected the given
 *	face name when looking for a screen font that can support some
 *	Unicode character.
 *
 * Results:
 *	The return value is 0 if this face name has not already been seen,
 *	non-zero otherwise.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
SeenName(
    CONST char *name,		/* The name to check. */
    Tcl_DString *dsPtr)		/* Contains names that have already been
				 * seen. */
{
    CONST char *seen, *end;

    seen = Tcl_DStringValue(dsPtr);
    end = seen + Tcl_DStringLength(dsPtr);
    while (seen < end) {
	if (strcasecmp(seen, name) == 0) {
	    return 1;
	}
	seen += strlen(seen) + 1;
    }
    Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1));
    return 0;
}

/*
 *-------------------------------------------------------------------------
 *
 * CanUseFallback --
 *
 *	If the specified physical screen font has not already been loaded 
 *	into the font object, determine if the specified physical screen 
 *	font can display the given character.
 *
 * Results:
 *	The return value is a pointer to a newly allocated SubFont, owned
 *	by the font object.  This SubFont can be used to display the given
 *	character.  The SubFont represents the screen font with the base set 
 *	of font attributes from the font object, but using the specified 
 *	font name.  NULL is returned if the font object already holds
 *	a reference to the specified physical font or if the specified 
 *	physical font cannot display the given character.
 *
 * Side effects:				       
 *	The font object's subFontArray is updated to contain a reference
 *	to the newly allocated SubFont.
 *
 *-------------------------------------------------------------------------
 */

static SubFont *
CanUseFallback(
    MacFont *fontPtr,		/* The font object that will own the new
				 * screen font. */
    CONST char *faceName,	/* Desired face name for new screen font. */
    int ch)			/* The Unicode character that the new
				 * screen font must be able to display. */
{
    int i;
    SubFont subFont;
    short faceNum;

    if (GetFamilyNum(faceName, &faceNum) == 0) {
        return NULL;
    }
    
    /* 
     * Skip all fonts we've already used.
     */
     
    for (i = 0; i < fontPtr->numSubFonts; i++) {
	if (faceNum == fontPtr->subFontArray[i].familyPtr->faceNum) {
	    return NULL;
	}
    }
    
    /*
     * Load this font and see if it has the desired character.
     */
     
    InitSubFont(fontPtr, faceNum, &subFont);
    if (((ch < 256) && (subFont.familyPtr->isSymbolFont)) 
	    || (FontMapLookup(&subFont, ch) == 0)) {
        ReleaseSubFont(&subFont);
        return NULL;
    }
    
    if (fontPtr->numSubFonts >= SUBFONT_SPACE) {
	SubFont *newPtr;
    	
    	newPtr = (SubFont *) ckalloc(sizeof(SubFont) 
		* (fontPtr->numSubFonts + 1));
	memcpy((char *) newPtr, fontPtr->subFontArray,
		fontPtr->numSubFonts * sizeof(SubFont));
	if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
	    ckfree((char *) fontPtr->subFontArray);
	}
	fontPtr->subFontArray = newPtr;
    }
    fontPtr->subFontArray[fontPtr->numSubFonts] = subFont;
    fontPtr->numSubFonts++;
    return &fontPtr->subFontArray[fontPtr->numSubFonts - 1];
}

/*
 *-------------------------------------------------------------------------
 *
 * GetFamilyNum --
 *
 *	Determines if any physical screen font exists on the system with 
 *	the given family name.  If the family exists, then it should be
 *	possible to construct some physical screen font with that family
 *	name.
 *
 * Results:
 *	The return value is 0 if the specified font family does not exist,
 *	non-zero otherwise.  *faceNumPtr is filled with the unique face
 *	number that identifies the screen font, or 0 if the font family
 *	did not exist.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
GetFamilyNum(
    CONST char *faceName, 	/* UTF-8 name of font family to query. */
    short *faceNumPtr)		/* Filled with font number for above family. */
{
    FontNameMap *mapPtr;
    
    if (faceName != NULL) {
        for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) {
            if (strcasecmp(faceName, mapPtr->utfName) == 0) {
                *faceNumPtr = mapPtr->faceNum;
                return 1;
            }
        }
    }
    *faceNumPtr = 0;    
    return 0;
}

static int
GetFamilyOrAliasNum(
    CONST char *faceName, 	/* UTF-8 name of font family to query. */
    short *faceNumPtr)		/* Filled with font number for above family. */
{
    char **aliases;
    int i;
    
    if (GetFamilyNum(faceName, faceNumPtr) != 0) {
        return 1;
    }
    aliases = TkFontGetAliasList(faceName);
    if (aliases != NULL) {
        for (i = 0; aliases[i] != NULL; i++) {
            if (GetFamilyNum(aliases[i], faceNumPtr) != 0) {
		return 1;
	    }
	}
    }
    return 0;
}

/*
 *-------------------------------------------------------------------------
 *
 * GetUtfFaceName --
 *
 *	Given the native name for a Macintosh font (in which the name of
 *	the font is in the encoding of the font itself), return the UTF-8
 *	name that corresponds to that font.  The specified font name must
 *	refer to a font that actually exists on the machine.  
 *
 *	This function is used to obtain the UTF-8 name when querying the
 *	properties of a Macintosh font object.
 *
 * Results:
 *	The return value is a pointer to the UTF-8 of the specified font.
 *
 * Side effects:
 *	None.
 *
 *------------------------------------------------------------------------
 */
 
static Tk_Uid
GetUtfFaceName(
    StringPtr nativeName)	/* Pascal name for font in native encoding. */
{
    FontNameMap *mapPtr;
    
    for (mapPtr = gFontNameMap; mapPtr->utfName != NULL; mapPtr++) {
        if (pstrcmp(nativeName, mapPtr->nativeName) == 0) {
            return mapPtr->utfName;
        }
    }
    panic("GetUtfFaceName: unexpected nativeName");
    return NULL;
}

/*
 *------------------------------------------------------------------------
 *
 * GetFontEncoding --
 *
 *	Return a string that can be passed to Tcl_GetTextEncoding() and
 *	used to convert bytes from UTF-8 into the encoding  of the 
 *	specified font.
 *
 *	The desired encoding to use to convert the name of a symbolic 
 *	font into UTF-8 is macRoman, while the desired encoding to use
 *	to convert bytes in a symbolic font to UTF-8 is the corresponding
 *	symbolic encoding.  Due to this dual interpretatation of symbolic
 *	fonts, the caller can specify what type of encoding to return 
 *	should the specified font be symbolic.  
 *
 * Results:
 *	The return value is a string that specifies the font's encoding.
 *	If the font's encoding could not be identified, NULL is returned.
 *
 * Side effects:
 *	None.
 *
 *------------------------------------------------------------------------
 */
  
static Tcl_Encoding
GetFontEncoding(
    int faceNum,		/* Macintosh font number. */
    int allowSymbol,		/* If non-zero, then the encoding string
    				 * for symbol fonts will be the corresponding
    				 * symbol encoding.  Otherwise, the encoding
    				 * string for symbol fonts will be 
    				 * "macRoman". */
    int *isSymbolPtr)		/* Filled with non-zero if this font is a
    				 * symbol font, 0 otherwise. */
{
    Str255 faceName;
    int script, lang;
    char *name;   
    
    if (allowSymbol != 0) {
        GetFontName(faceNum, faceName);
        if (pstrcasecmp(faceName, "\psymbol") == 0) {
            *isSymbolPtr = 1;
    	    return Tcl_GetEncoding(NULL, "symbol");
        }
        if (pstrcasecmp(faceName, "\pzapf dingbats") == 0) {
            *isSymbolPtr = 1;
            return Tcl_GetEncoding(NULL, "macDingbats");
        }
    }
    
    *isSymbolPtr = 0;
    
    script = FontToScript(faceNum);
    lang = GetScriptVariable(script, smScriptLang);
    name = NULL;
    if (script == smRoman) {
        name = TkFindStateString(romanMap, lang);
    } else if (script == smCyrillic) {
    	name = TkFindStateString(cyrillicMap, lang);
    }
    if (name == NULL) {
    	name = TkFindStateString(scriptMap, script);
    }
    return Tcl_GetEncoding(NULL, name);
}

Changes to mac/tkMacHLEvents.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkMacHLEvents.c --
 *
 *	Implements high level event support for the Macintosh.  Currently, 
 *	the only event that really does anything is the Quit event.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacHLEvents.c 1.21 97/09/17 17:19:00
 */

#include "tcl.h"
#include "tclMacInt.h"
#include "tkMacInt.h"

#include <Aliases.h>











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkMacHLEvents.c --
 *
 *	Implements high level event support for the Macintosh.  Currently, 
 *	the only event that really does anything is the Quit event.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacHLEvents.c,v 1.1.4.3 1998/11/25 23:06:57 stanton Exp $
 */

#include "tcl.h"
#include "tclMacInt.h"
#include "tkMacInt.h"

#include <Aliases.h>
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250

251
252
253
254
255
256
257
258
259
260
261
262
263

    err = AECountItems(&fileSpecList, &count);
    if (err != noErr) {
	return noErr;
    }

    Tcl_DStringInit(&command);
    Tcl_DStringInit(&pathName);
    Tcl_DStringAppend(&command, "tkOpenDocument", -1);
    for (index = 1; index <= count; index++) {
	int length;
	Handle fullPath;
	
	Tcl_DStringSetLength(&pathName, 0);
	err = AEGetNthPtr(&fileSpecList, index, typeFSS,
		&keyword, &type, (Ptr) &file, sizeof(FSSpec), &actual);
	if ( err != noErr ) {
	    continue;
	}

	err = FSpPathFromLocation(&file, &length, &fullPath);
	HLock(fullPath);
	Tcl_DStringAppend(&pathName, *fullPath, length);
	HUnlock(fullPath);
	DisposeHandle(fullPath);

	Tcl_DStringAppendElement(&command, pathName.string);

    }
    
    Tcl_GlobalEval(interp, command.string);

    Tcl_DStringFree(&command);
    Tcl_DStringFree(&pathName);
    return noErr;
}

static pascal OSErr
PrintHandler(
    AppleEvent *theAppleEvent,
    AppleEvent *reply,







<





<








|



|
>


|


<







224
225
226
227
228
229
230

231
232
233
234
235

236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254

255
256
257
258
259
260
261

    err = AECountItems(&fileSpecList, &count);
    if (err != noErr) {
	return noErr;
    }

    Tcl_DStringInit(&command);

    Tcl_DStringAppend(&command, "tkOpenDocument", -1);
    for (index = 1; index <= count; index++) {
	int length;
	Handle fullPath;
	

	err = AEGetNthPtr(&fileSpecList, index, typeFSS,
		&keyword, &type, (Ptr) &file, sizeof(FSSpec), &actual);
	if ( err != noErr ) {
	    continue;
	}

	err = FSpPathFromLocation(&file, &length, &fullPath);
	HLock(fullPath);
        Tcl_ExternalToUtfDString(NULL, *fullPath, length, &pathName);
	HUnlock(fullPath);
	DisposeHandle(fullPath);

	Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName));
	Tcl_DStringFree(&pathName);
    }
    
    Tcl_GlobalEval(interp, Tcl_DStringValue(&command));

    Tcl_DStringFree(&command);

    return noErr;
}

static pascal OSErr
PrintHandler(
    AppleEvent *theAppleEvent,
    AppleEvent *reply,
357
358
359
360
361
362
363
364

365
366
367

368
369
370
371
372
373
374

    /*
     * If we actually go to run Tcl code - put the result in the reply.
     */
    if (tclErr >= 0) {
	if (tclErr == TCL_OK)  {
	    AEPutParamPtr(reply, keyDirectObject, typeChar,
		interp->result, strlen(interp->result));

	} else {
	    AEPutParamPtr(reply, keyErrorString, typeChar,
		interp->result, strlen(interp->result));

	    AEPutParamPtr(reply, keyErrorNumber, typeInteger,
		(Ptr) &tclErr, sizeof(int));
	}
    }
	
    AEDisposeDesc(&theDesc);








|
>


|
>







355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374

    /*
     * If we actually go to run Tcl code - put the result in the reply.
     */
    if (tclErr >= 0) {
	if (tclErr == TCL_OK)  {
	    AEPutParamPtr(reply, keyDirectObject, typeChar,
		Tcl_GetStringResult(interp),
		strlen(Tcl_GetStringResult(interp)));
	} else {
	    AEPutParamPtr(reply, keyErrorString, typeChar,
		Tcl_GetStringResult(interp),
		strlen(Tcl_GetStringResult(interp)));
	    AEPutParamPtr(reply, keyErrorNumber, typeInteger,
		(Ptr) &tclErr, sizeof(int));
	}
    }
	
    AEDisposeDesc(&theDesc);

Changes to mac/tkMacInit.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkMacInit.c --
 *
 *	This file contains Mac-specific interpreter initialization
 *	functions.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacInit.c 1.30 96/12/17 15:20:16
 */

#include <Resources.h>
#include <Files.h>
#include <TextUtils.h>
#include <Strings.h>
#include "tkInt.h"






|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkMacInit.c --
 *
 *	This file contains Mac-specific interpreter initialization
 *	functions.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacInit.c,v 1.1.4.2 1998/09/30 02:18:08 stanton Exp $
 */

#include <Resources.h>
#include <Files.h>
#include <TextUtils.h>
#include <Strings.h>
#include "tkInt.h"
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 * TkpInit --
 *
 *	Performs Mac-specific interpreter initialization related to the
 *      tk_library variable.
 *
 * Results:
 *	A standard Tcl completion code (TCL_OK or TCL_ERROR).  Also
 *	leaves information in interp->result.
 *
 * Side effects:
 *	Sets "tk_library" Tcl variable, runs initialization scripts
 *	for Tk.
 *
 *----------------------------------------------------------------------
 */







|







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 * TkpInit --
 *
 *	Performs Mac-specific interpreter initialization related to the
 *      tk_library variable.
 *
 * Results:
 *	A standard Tcl completion code (TCL_OK or TCL_ERROR).  Also
 *	leaves information in the interp's result.
 *
 * Side effects:
 *	Sets "tk_library" Tcl variable, runs initialization scripts
 *	for Tk.
 *
 *----------------------------------------------------------------------
 */

Changes to mac/tkMacInt.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tkMacInt.h --
 *
 *	Declarations of Macintosh specific shared variables and procedures.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacInt.h 1.67 97/11/20 18:30:38
 */

#ifndef _TKMACINT
#define _TKMACINT

#include "tkInt.h"
#include "tkPort.h"










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tkMacInt.h --
 *
 *	Declarations of Macintosh specific shared variables and procedures.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacInt.h,v 1.1.4.3 1999/03/10 07:13:48 stanton Exp $
 */

#ifndef _TKMACINT
#define _TKMACINT

#include "tkInt.h"
#include "tkPort.h"
68
69
70
71
72
73
74


















75
76
77
78
79
80
81
 * I am reserving TK_EMBEDDED = 0x100 in the MacDrawable flags
 * This is defined in tk.h. We need to duplicate the TK_EMBEDDED flag in the
 * TkWindow structure for the window,  but in the MacWin.  This way we can still tell
 * what the correct port is after the TKWindow  structure has been freed.  This 
 * actually happens when you bind destroy of a toplevel to Destroy of a child.
 */



















/*
 * Defines used for TkMacInvalidateWindow
 */
 
#define TK_WINDOW_ONLY 0
#define TK_PARENT_WINDOW 1








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







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
 * I am reserving TK_EMBEDDED = 0x100 in the MacDrawable flags
 * This is defined in tk.h. We need to duplicate the TK_EMBEDDED flag in the
 * TkWindow structure for the window,  but in the MacWin.  This way we can still tell
 * what the correct port is after the TKWindow  structure has been freed.  This 
 * actually happens when you bind destroy of a toplevel to Destroy of a child.
 */

/*
 * This structure is for handling Netscape-type in process
 * embedding where Tk does not control the top-level.  It contains
 * various functions that are needed by Mac specific routines, like
 * TkMacGetDrawablePort.  The definitions of the function types
 * are in tclMac.h.
 */

typedef struct {
	Tk_MacEmbedRegisterWinProc *registerWinProc;
	Tk_MacEmbedGetGrafPortProc *getPortProc;
	Tk_MacEmbedMakeContainerExistProc *containerExistProc;
	Tk_MacEmbedGetClipProc *getClipProc;
	Tk_MacEmbedGetOffsetInParentProc *getOffsetProc;
} TkMacEmbedHandler;

extern TkMacEmbedHandler *gMacEmbedHandler;

/*
 * Defines used for TkMacInvalidateWindow
 */
 
#define TK_WINDOW_ONLY 0
#define TK_PARENT_WINDOW 1

186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
#else
#define TkCallMenuDefProc(userRoutine, message, theMenu, menuRectPtr, hitPt, \
	whichItemPtr, globalsPtr) \
	(*(userRoutine))((message), (theMenu), (menuRectPtr), (hitPt), \
	(whichItemPtr), (globalsPtr))
#endif

/*
 * Internal procedures shared among Macintosh Tk modules but not exported
 * to the outside world:
 */

extern int		HandleWMEvent _ANSI_ARGS_((EventRecord *theEvent));
extern void 		TkAboutDlg _ANSI_ARGS_((void));
extern void		TkCreateMacEventSource _ANSI_ARGS_((void));
extern void 		TkFontList _ANSI_ARGS_((Tcl_Interp *interp,
			    Display *display));
extern Window		TkGetTransientMaster _ANSI_ARGS_((TkWindow *winPtr));
extern int		TkGenerateButtonEvent _ANSI_ARGS_((int x, int y,
			    Window window, unsigned int state));
extern int 		TkGetCharPositions _ANSI_ARGS_((
			    XFontStruct *font_struct, char *string,
			    int count, short *buffer));
extern void		TkGenWMDestroyEvent _ANSI_ARGS_((Tk_Window tkwin));
extern void		TkGenWMConfigureEvent _ANSI_ARGS_((Tk_Window tkwin,
			    int x, int y, int width, int height, int flags));
extern unsigned int	TkMacButtonKeyState _ANSI_ARGS_((void));
extern void		TkMacClearMenubarActive _ANSI_ARGS_((void));
extern int		TkMacConvertEvent _ANSI_ARGS_((EventRecord *eventPtr));
extern int		TkMacDispatchMenuEvent _ANSI_ARGS_((int menuID, 
			    int index));
extern void		TkMacInstallCursor _ANSI_ARGS_((int resizeOverride));
extern int		TkMacConvertTkEvent _ANSI_ARGS_((EventRecord *eventPtr,
			    Window window));
extern void		TkMacHandleTearoffMenu _ANSI_ARGS_((void));
extern void		tkMacInstallMWConsole _ANSI_ARGS_((
			    Tcl_Interp *interp));
extern void		TkMacInvalClipRgns _ANSI_ARGS_((TkWindow *winPtr));
extern void		TkMacDoHLEvent _ANSI_ARGS_((EventRecord *theEvent));
extern void 		TkMacFontInfo _ANSI_ARGS_((Font fontId, short *family,
			    short *style, short *size));
extern Time		TkMacGenerateTime _ANSI_ARGS_(());
extern GWorldPtr 	TkMacGetDrawablePort _ANSI_ARGS_((Drawable drawable));
extern TkWindow * 	TkMacGetScrollbarGrowWindow _ANSI_ARGS_((
			    TkWindow *winPtr));
extern Window 		TkMacGetXWindow _ANSI_ARGS_((WindowRef macWinPtr));
extern int		TkMacGrowToplevel _ANSI_ARGS_((WindowRef whichWindow,
			    Point start));
extern void 		TkMacHandleMenuSelect _ANSI_ARGS_((long mResult,
			    int optionKeyPressed));
extern void		TkMacInitAppleEvents _ANSI_ARGS_((Tcl_Interp *interp));
extern void 		TkMacInitMenus _ANSI_ARGS_((Tcl_Interp 	*interp));
extern void		TkMacInvalidateWindow _ANSI_ARGS_((MacDrawable *macWin, int flag));
extern int		TkMacIsCharacterMissing _ANSI_ARGS_((Tk_Font tkfont,
			    unsigned int searchChar));
extern void		TkMacMakeRealWindowExist _ANSI_ARGS_((
			    TkWindow *winPtr));
extern BitMapPtr	TkMacMakeStippleMap(Drawable, Drawable);
extern void		TkMacMenuClick _ANSI_ARGS_((void));
extern void		TkMacRegisterOffScreenWindow _ANSI_ARGS_((Window window,
			    GWorldPtr portPtr));
extern int		TkMacResizable _ANSI_ARGS_((TkWindow *winPtr));
extern void		TkMacSetEmbedRgn _ANSI_ARGS_((TkWindow *winPtr, RgnHandle rgn));
extern void		TkMacSetHelpMenuItemCount _ANSI_ARGS_((void));
extern void		TkMacSetScrollbarGrow _ANSI_ARGS_((TkWindow *winPtr,
			    int flag));
extern void		TkMacSetUpClippingRgn _ANSI_ARGS_((Drawable drawable));
extern void		TkMacSetUpGraphicsPort _ANSI_ARGS_((GC gc));
extern void 		TkMacUpdateClipRgn _ANSI_ARGS_((TkWindow *winPtr));
extern void		TkMacUnregisterMacWindow _ANSI_ARGS_((GWorldPtr portPtr));
extern int		TkMacUseMenuID _ANSI_ARGS_((short macID));
extern RgnHandle 	TkMacVisableClipRgn _ANSI_ARGS_((TkWindow *winPtr));
extern void		TkMacWinBounds _ANSI_ARGS_((TkWindow *winPtr,
			    Rect *geometry));
extern void		TkMacWindowOffset _ANSI_ARGS_((WindowRef wRef, 
			    int *xOffset, int *yOffset));
extern void		TkResumeClipboard _ANSI_ARGS_((void));
extern int 		TkSetMacColor _ANSI_ARGS_((unsigned long pixel,
			    RGBColor *macColor));
extern void 		TkSetWMName _ANSI_ARGS_((TkWindow *winPtr,
			    Tk_Uid titleUid));
extern void		TkSuspendClipboard _ANSI_ARGS_((void));
extern int		TkWMGrowToplevel _ANSI_ARGS_((WindowRef whichWindow,
			    Point start));
extern int		TkMacZoomToplevel _ANSI_ARGS_((WindowPtr whichWindow, 
			    Point where, short zoomPart));
extern Tk_Window	Tk_TopCoordsToWindow _ANSI_ARGS_((Tk_Window tkwin,
			    int rootX, int rootY, int *newX, int *newY));
extern MacDrawable *	TkMacContainerId _ANSI_ARGS_((TkWindow *winPtr));
extern MacDrawable *	TkMacGetHostToplevel  _ANSI_ARGS_((TkWindow *winPtr));
/*
 * The following prototypes need to go into tkMac.h
 */
EXTERN void		Tk_UpdatePointer _ANSI_ARGS_((Tk_Window tkwin,
			    int x, int y, int state));

#endif /* _TKMACINT */







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

204
205
206
207
208
209
210

























































































211
#else
#define TkCallMenuDefProc(userRoutine, message, theMenu, menuRectPtr, hitPt, \
	whichItemPtr, globalsPtr) \
	(*(userRoutine))((message), (theMenu), (menuRectPtr), (hitPt), \
	(whichItemPtr), (globalsPtr))
#endif


























































































#endif /* _TKMACINT */

Changes to mac/tkMacKeyboard.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkMacKeyboard.c --
 *
 *	Routines to support keyboard events on the Macintosh.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacKeyboard.c 1.14 96/08/15 15:34:00
 */

#include "tkInt.h"
#include "Xlib.h"
#include "keysym.h"

#include <Events.h>





|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkMacKeyboard.c --
 *
 *	Routines to support keyboard events on the Macintosh.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacKeyboard.c,v 1.1.4.2 1998/09/30 02:18:09 stanton Exp $
 */

#include "tkInt.h"
#include "Xlib.h"
#include "keysym.h"

#include <Events.h>
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
KeySym 
XKeycodeToKeysym(
    Display* display,
    KeyCode keycode,
    int	index)
{
    register Tcl_HashEntry *hPtr;
    register char c;
    char virtualKey;
    int newKeycode;
    unsigned long dummy, newChar;

    if (!initialized) {
	InitKeyMaps();
    }
	
    c = keycode & charCodeMask;
    virtualKey = (keycode & keyCodeMask) >> 8;




    /*
     * When determining what keysym to produce we firt check to see if
     * the key is a function key.  We then check to see if the character
     * is another non-printing key.  Finally, we return the key syms
     * for all ASCI chars.
     */
    if (c == 0x10) {
	hPtr = Tcl_FindHashEntry(&vkeyTable, (char *) virtualKey);
	if (hPtr != NULL) {
	    return (KeySym) Tcl_GetHashValue(hPtr);
	}
    }
    
    
    hPtr = Tcl_FindHashEntry(&keycodeTable, (char *) virtualKey);
    if (hPtr != NULL) {
	return (KeySym) Tcl_GetHashValue(hPtr);
    }

    /* 
     * Recompute the character based on the Shift key only.







|








|
|
>
>
>













<
<







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
KeySym 
XKeycodeToKeysym(
    Display* display,
    KeyCode keycode,
    int	index)
{
    register Tcl_HashEntry *hPtr;
    int c;
    char virtualKey;
    int newKeycode;
    unsigned long dummy, newChar;

    if (!initialized) {
	InitKeyMaps();
    }
	
    virtualKey = (char) (keycode >> 16);    
    c = (keycode) & 0xffff;
    if (c > 255) {
        return NoSymbol;
    }

    /*
     * When determining what keysym to produce we firt check to see if
     * the key is a function key.  We then check to see if the character
     * is another non-printing key.  Finally, we return the key syms
     * for all ASCI chars.
     */
    if (c == 0x10) {
	hPtr = Tcl_FindHashEntry(&vkeyTable, (char *) virtualKey);
	if (hPtr != NULL) {
	    return (KeySym) Tcl_GetHashValue(hPtr);
	}
    }


    hPtr = Tcl_FindHashEntry(&keycodeTable, (char *) virtualKey);
    if (hPtr != NULL) {
	return (KeySym) Tcl_GetHashValue(hPtr);
    }

    /* 
     * Recompute the character based on the Shift key only.
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207

208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223

224




225



226


227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253

    return NoSymbol; 
}

/*
 *----------------------------------------------------------------------
 *
 * XLookupString --
 *
 *	Retrieve the string equivalent for the given keyboard event.
 *
 * Results:
 *	Returns the number of characters stored in buffer_return.
 *
 * Side effects:
 *	Retrieves the characters stored in the event and inserts them
 *	into buffer_return.
 *
 *----------------------------------------------------------------------
 */

int 

XLookupString(
    XKeyEvent* event_struct,
    char* buffer_return,
    int	bytes_buffer,
    KeySym* keysym_return,
    XComposeStatus* status_in_out)
{
    register Tcl_HashEntry *hPtr;
    char string[3];
    char virtualKey;
    char c;

    if (!initialized) {
	InitKeyMaps();
    }
	

    c = event_struct->keycode & charCodeMask;




    string[0] = c;



    string[1] = '\0';


    
    /*
     * Just return NULL if the character is a function key or another
     * non-printing key.
     */
    if (c == 0x10) {
	string[0] = '\0';
    } else {
	virtualKey = (event_struct->keycode & keyCodeMask) >> 8;
	hPtr = Tcl_FindHashEntry(&keycodeTable, (char *) virtualKey);
	if (hPtr != NULL) {
	    string[0] = '\0';
	}
    }

    if (buffer_return != NULL) {
	strncpy(buffer_return, string, bytes_buffer);
    }

    return strlen(string);
}

/*
 *----------------------------------------------------------------------
 *
 * XGetModifierMapping --
 *







|




|


<
|




<
>
|
|
|
|
|
|




|




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






|

<


|


|
<
<
<
<
<







187
188
189
190
191
192
193
194
195
196
197
198
199
200
201

202
203
204
205
206

207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244

245
246
247
248
249
250





251
252
253
254
255
256
257

    return NoSymbol; 
}

/*
 *----------------------------------------------------------------------
 *
 * TkpGetString --
 *
 *	Retrieve the string equivalent for the given keyboard event.
 *
 * Results:
 *	Returns the UTF string.
 *
 * Side effects:

 *	None.
 *
 *----------------------------------------------------------------------
 */


char *
TkpGetString(
    TkWindow *winPtr,		/* Window where event occurred:  needed to
				 * get input context. */
    XEvent *eventPtr,		/* X keyboard event. */
    Tcl_DString *dsPtr)		/* Uninitialized or empty string to hold
				 * result. */
{
    register Tcl_HashEntry *hPtr;
    char string[3];
    char virtualKey;
    int c, len;

    if (!initialized) {
	InitKeyMaps();
    }
    
    Tcl_DStringInit(dsPtr);
    
    virtualKey = (char) (eventPtr->xkey.keycode >> 16);    
    c = (eventPtr->xkey.keycode) & 0xffff;
    
    if (c < 256) {
        string[0] = (char) c;
        len = 1;
    } else {
        string[0] = (char) (c >> 8);
        string[1] = (char) c;
        len = 2;
    }
    
    /*
     * Just return NULL if the character is a function key or another
     * non-printing key.
     */
    if (c == 0x10) {
	len = 0;
    } else {

	hPtr = Tcl_FindHashEntry(&keycodeTable, (char *) virtualKey);
	if (hPtr != NULL) {
	    len = 0;
	}
    }
    return Tcl_ExternalToUtfDString(NULL, string, len, dsPtr);





}

/*
 *----------------------------------------------------------------------
 *
 * XGetModifierMapping --
 *
373
374
375
376
377
378
379
380
381
382
383
384
            virtualKeyCode = 0x06;
        } else if (keysym == ' ') {
            virtualKeyCode = 0x31;
        } else if (keysym == XK_Return) {
            virtualKeyCode = 0x24;
            keysym = '\r';
        }
	keycode = keysym + ((virtualKeyCode << 8) & keyCodeMask);
    }

    return keycode;
}







|




377
378
379
380
381
382
383
384
385
386
387
388
            virtualKeyCode = 0x06;
        } else if (keysym == ' ') {
            virtualKeyCode = 0x31;
        } else if (keysym == XK_Return) {
            virtualKeyCode = 0x24;
            keysym = '\r';
        }
	keycode = keysym + (virtualKeyCode <<16);
    }

    return keycode;
}

Changes to mac/tkMacLibrary.r.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkMacLibrary.r --
 *
 *	This file creates resources for use in most Tk applications.
 *	This is designed to be an example of using the Tcl/Tk 
 *	libraries in a Macintosh Application.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacLibrary.r 1.9 97/11/20 18:31:20
 */

/*
 * New style DLOG templates have an extra field for the positioning
 * options for the Dialog Box.  We will not use this, for now, so we
 * turn it off here.
 */












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkMacLibrary.r --
 *
 *	This file creates resources for use in most Tk applications.
 *	This is designed to be an example of using the Tcl/Tk 
 *	libraries in a Macintosh Application.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacLibrary.r,v 1.1.4.2 1998/09/30 02:18:10 stanton Exp $
 */

/*
 * New style DLOG templates have an extra field for the positioning
 * options for the Dialog Box.  We will not use this, for now, so we
 * turn it off here.
 */
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
	"::library:bgerror.tcl";
read 'TEXT' (TK_LIBRARY_RESOURCES+15, "Console", purgeable) 
	"::library:console.tcl";
read 'TEXT' (TK_LIBRARY_RESOURCES+16, "msgbox", purgeable, preload) 
	"::library:msgbox.tcl";
read 'TEXT' (TK_LIBRARY_RESOURCES+17, "comdlg", purgeable, preload) 
	"::library:comdlg.tcl";
read 'TEXT' (TK_LIBRARY_RESOURCES+18, "prolog", purgeable, preload) 
	"::library:prolog.ps";

/*
 * The following two resources define the default "About Box" for Mac Tk.
 * This dialog appears if the "About Tk..." menu item is selected from
 * the Apple menu.  This dialog may be overridden by defining a Tcl procedure
 * with the name of "tkAboutDialog".  If this procedure is defined the
 * default dialog will not be shown and the Tcl procedure is expected to







<
<







114
115
116
117
118
119
120


121
122
123
124
125
126
127
	"::library:bgerror.tcl";
read 'TEXT' (TK_LIBRARY_RESOURCES+15, "Console", purgeable) 
	"::library:console.tcl";
read 'TEXT' (TK_LIBRARY_RESOURCES+16, "msgbox", purgeable, preload) 
	"::library:msgbox.tcl";
read 'TEXT' (TK_LIBRARY_RESOURCES+17, "comdlg", purgeable, preload) 
	"::library:comdlg.tcl";



/*
 * The following two resources define the default "About Box" for Mac Tk.
 * This dialog appears if the "About Tk..." menu item is selected from
 * the Apple menu.  This dialog may be overridden by defining a Tcl procedure
 * with the name of "tkAboutDialog".  If this procedure is defined the
 * default dialog will not be shown and the Tcl procedure is expected to

Changes to mac/tkMacMDEF.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * TkMacMDEF.c --
 *
 *	This module is implements the MDEF for tkMenus. The address of the
 *	real entry proc will be blasted into the MDEF.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacMDEF.c 1.5 97/07/11 %V%
 */

#define MAC_TCL
#define NeedFunctionPrototypes 1
#define NeedWidePrototypes 0

#include <Menus.h>











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * TkMacMDEF.c --
 *
 *	This module is implements the MDEF for tkMenus. The address of the
 *	real entry proc will be blasted into the MDEF.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacMDEF.c,v 1.1.4.1 1998/09/30 02:18:10 stanton Exp $
 */

#define MAC_TCL
#define NeedFunctionPrototypes 1
#define NeedWidePrototypes 0

#include <Menus.h>

Changes to mac/tkMacMDEF.r.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 *	in menu items.  
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacMDEF.r 1.6 97/07/11 18:09:47
 */

#include <Types.r>

/*
 * This code was generated by a project file and will not need to be changed.
 * It is just a stub. The address of the real MDEF handler will be blasted







|







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 *	in menu items.  
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacMDEF.r,v 1.1.4.1 1998/09/30 02:18:10 stanton Exp $
 */

#include <Types.r>

/*
 * This code was generated by a project file and will not need to be changed.
 * It is just a stub. The address of the real MDEF handler will be blasted

Changes to mac/tkMacMenu.c.

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
/* 
 * tkMacMenu.c --
 *
 *	This module implements the Mac-platform specific features of menus.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacMenu.c 1.107 97/11/20 18:33:09
 */

#include <Menus.h>
#include <OSUtils.h>
#include <Palettes.h>
#include <Resources.h>
#include <string.h>
#include <ToolUtils.h>
#include <Balloons.h>

#undef Status
#include <Devices.h>
#include "tkMenu.h"
#include "tkMacInt.h"
#include "tkMenuButton.h"


typedef struct MacMenu {
    MenuHandle menuHdl;		/* The Menu Manager data structure. */
    Rect menuRect;		/* The rectangle as calculated in the
    				 * MDEF. This is used to figure ou the
    				 * clipping rgn before we push
    				 * the <<MenuSelect>> virtual binding
    				 * through. */
} MacMenu;







/*
 * Various geometry definitions:
 */

#define CASCADE_ARROW_HEIGHT 	10
#define CASCADE_ARROW_WIDTH 	8
#define DECORATION_BORDER_WIDTH 2
#define MAC_MARGIN_WIDTH 	8

/*
 * The following are constants relating to the SICNs used for drawing the MDEF.
 */

#define SICN_RESOURCE_NUMBER		128

#define SICN_HEIGHT 		16
#define SICN_ROWS 		2
#define CASCADE_ICON_WIDTH	7
#define	SHIFT_ICON_WIDTH	10
#define	OPTION_ICON_WIDTH	16
#define CONTROL_ICON_WIDTH	12










|









>





>










>
>
>
>
>
>













|







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
/* 
 * tkMacMenu.c --
 *
 *	This module implements the Mac-platform specific features of menus.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacMenu.c,v 1.1.4.7 1999/03/10 18:28:13 redman Exp $
 */

#include <Menus.h>
#include <OSUtils.h>
#include <Palettes.h>
#include <Resources.h>
#include <string.h>
#include <ToolUtils.h>
#include <Balloons.h>
#include <Appearance.h>
#undef Status
#include <Devices.h>
#include "tkMenu.h"
#include "tkMacInt.h"
#include "tkMenuButton.h"
#include "tkColor.h"

typedef struct MacMenu {
    MenuHandle menuHdl;		/* The Menu Manager data structure. */
    Rect menuRect;		/* The rectangle as calculated in the
    				 * MDEF. This is used to figure ou the
    				 * clipping rgn before we push
    				 * the <<MenuSelect>> virtual binding
    				 * through. */
} MacMenu;

typedef struct MenuEntryUserData {
    Drawable mdefDrawable;
    TkMenuEntry *mePtr;
    Tk_Font tkfont;
    Tk_FontMetrics *fmPtr;
} MenuEntryUserData;
/*
 * Various geometry definitions:
 */

#define CASCADE_ARROW_HEIGHT 	10
#define CASCADE_ARROW_WIDTH 	8
#define DECORATION_BORDER_WIDTH 2
#define MAC_MARGIN_WIDTH 	8

/*
 * The following are constants relating to the SICNs used for drawing the MDEF.
 */

#define SICN_RESOURCE_NUMBER	128

#define SICN_HEIGHT 		16
#define SICN_ROWS 		2
#define CASCADE_ICON_WIDTH	7
#define	SHIFT_ICON_WIDTH	10
#define	OPTION_ICON_WIDTH	16
#define CONTROL_ICON_WIDTH	12
135
136
137
138
139
140
141


142
143
144
145
146
147
148
				/* The special command char for cascade
			         * menus. */
#define SEPARATOR_TEXT "\p(-"
				/* The text for a menu separator. */

#define MENUBAR_REDRAW_PENDING 1



RgnHandle tkMenuCascadeRgn = NULL;
				/* The region to clip drawing to when the
				 * MDEF is up. */
int tkUseMenuCascadeRgn = 0;	/* If this is 1, clipping code
				 * should intersect tkMenuCascadeRgn
				 * before drawing occurs.
				 * tkMenuCascadeRgn will only







>
>







143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
				/* The special command char for cascade
			         * menus. */
#define SEPARATOR_TEXT "\p(-"
				/* The text for a menu separator. */

#define MENUBAR_REDRAW_PENDING 1

static int gNoTkMenus = 0;      /* This is used by Tk_MacTurnOffMenus as the
                                 * flag that Tk is not to draw any menus. */
RgnHandle tkMenuCascadeRgn = NULL;
				/* The region to clip drawing to when the
				 * MDEF is up. */
int tkUseMenuCascadeRgn = 0;	/* If this is 1, clipping code
				 * should intersect tkMenuCascadeRgn
				 * before drawing occurs.
				 * tkMenuCascadeRgn will only
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
				 * the current menubar. */
static char *currentMenuBarName;
				/* Malloced. Name of current menu in menu bar.
				 * NULL if no menu set. TO DO: make this a
				 * DString. */
static Tk_Window currentMenuBarOwner;
				/* Which window owns the current menu bar. */



static int helpItemCount;	/* The number of items in the help menu. 
				 * -1 means that the help menu is
				 * unavailable. This does not include
				 * the automatically generated separator. */
static int inPostMenu;		/* We cannot be re-entrant like X
				 * windows. */
static short lastMenuID;	/* To pass to NewMenu; need to figure out
				 * a good way to do this. */
static unsigned char lastCascadeID;
				/* Cascades have to have ids that are
				 * less than 256. */
static MacDrawable macMDEFDrawable;
				/* Drawable for use by MDEF code */
static MDEFScrollFlag = 0;	/* Used so that popups don't scroll too soon. */
static int menuBarFlags;	/* Used for whether the menu bar needs
				 * redrawing or not. */
static TkMenuDefUPP menuDefProc;/* The routine descriptor to the MDEF proc.

				 * The MDEF is needed to draw menus with
				 * non-standard attributes and to support
				 * tearoff menus. */
static struct TearoffSelect {
    TkMenu *menuPtr;		/* The menu that is torn off */
    Point point;		/* The point to place the new menu */
    Rect excludeRect;		/* We don't want to drag tearoff highlights
    				 * when we are in this menu */
} tearoffStruct;

static RgnHandle totalMenuRgn = NULL;
				/* Used to update windows which have been
				 * obscured by menus. */
static RgnHandle utilRgn = NULL;/* Used when creating the region that is to
				 * be clipped out while the MDEF is active. */

static TopLevelMenubarList *windowListPtr;
				/* A list of windows that have menubars set. */








				
/*
 * Forward declarations for procedures defined later in this file:
 */
 
static void		CompleteIdlers _ANSI_ARGS_((TkMenu *menuPtr));
static void		DrawMenuBarWhenIdle _ANSI_ARGS_((
			    ClientData clientData));


static void		DrawMenuEntryAccelerator _ANSI_ARGS_((
			    TkMenu *menuPtr, TkMenuEntry *mePtr, 
			    Drawable d, GC gc, Tk_Font tkfont,
			    CONST Tk_FontMetrics *fmPtr,
			    Tk_3DBorder activeBorder, int x, int y,
			    int width, int height, int drawArrow));
static void		DrawMenuEntryBackground _ANSI_ARGS_((







>
>
>
















|
>


















>
>
>
>
>
>
>
>








>
>







172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
				 * the current menubar. */
static char *currentMenuBarName;
				/* Malloced. Name of current menu in menu bar.
				 * NULL if no menu set. TO DO: make this a
				 * DString. */
static Tk_Window currentMenuBarOwner;
				/* Which window owns the current menu bar. */
static char elipsisString[TCL_UTF_MAX + 1];
				/* The UTF representation of the elipsis (�) 
				 * character. */
static int helpItemCount;	/* The number of items in the help menu. 
				 * -1 means that the help menu is
				 * unavailable. This does not include
				 * the automatically generated separator. */
static int inPostMenu;		/* We cannot be re-entrant like X
				 * windows. */
static short lastMenuID;	/* To pass to NewMenu; need to figure out
				 * a good way to do this. */
static unsigned char lastCascadeID;
				/* Cascades have to have ids that are
				 * less than 256. */
static MacDrawable macMDEFDrawable;
				/* Drawable for use by MDEF code */
static MDEFScrollFlag = 0;	/* Used so that popups don't scroll too soon. */
static int menuBarFlags;	/* Used for whether the menu bar needs
				 * redrawing or not. */
static TkMenuDefUPP menuDefProc = NULL ;
                                /* The routine descriptor to the MDEF proc.
				 * The MDEF is needed to draw menus with
				 * non-standard attributes and to support
				 * tearoff menus. */
static struct TearoffSelect {
    TkMenu *menuPtr;		/* The menu that is torn off */
    Point point;		/* The point to place the new menu */
    Rect excludeRect;		/* We don't want to drag tearoff highlights
    				 * when we are in this menu */
} tearoffStruct;

static RgnHandle totalMenuRgn = NULL;
				/* Used to update windows which have been
				 * obscured by menus. */
static RgnHandle utilRgn = NULL;/* Used when creating the region that is to
				 * be clipped out while the MDEF is active. */

static TopLevelMenubarList *windowListPtr;
				/* A list of windows that have menubars set. */
static MenuItemDrawingUPP tkThemeMenuItemDrawingUPP; 
				/* Points to the UPP for theme Item drawing. */

static GC     appearanceGC = NULL; /* The fake appearance GC.  If you
				      pass the foreground of this to TkMacSetColor, 
				      it will return false, so you will know 
				      not to set the foreground color */
					  
				
/*
 * Forward declarations for procedures defined later in this file:
 */
 
static void		CompleteIdlers _ANSI_ARGS_((TkMenu *menuPtr));
static void		DrawMenuBarWhenIdle _ANSI_ARGS_((
			    ClientData clientData));
static void 		DrawMenuBackground _ANSI_ARGS_((
    			    Rect *menuRectPtr, Drawable d, ThemeMenuType type));
static void		DrawMenuEntryAccelerator _ANSI_ARGS_((
			    TkMenu *menuPtr, TkMenuEntry *mePtr, 
			    Drawable d, GC gc, Tk_Font tkfont,
			    CONST Tk_FontMetrics *fmPtr,
			    Tk_3DBorder activeBorder, int x, int y,
			    int width, int height, int drawArrow));
static void		DrawMenuEntryBackground _ANSI_ARGS_((
236
237
238
239
240
241
242


243
244
245
246
247
248
249
			    Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, 
			    int x, int y, int width, int height));
static void		DrawTearoffEntry _ANSI_ARGS_((TkMenu *menuPtr,
			    TkMenuEntry *mePtr, Drawable d, GC gc, 
			    Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, 
			    int x, int y, int width, int height));
static void		FixMDEF _ANSI_ARGS_((void));


static void		GetMenuAccelGeometry _ANSI_ARGS_((TkMenu *menuPtr,
			    TkMenuEntry *mePtr, Tk_Font tkfont,
			    CONST Tk_FontMetrics *fmPtr, int *modWidthPtr,
			    int *textWidthPtr, int *heightPtr));
static void		GetMenuLabelGeometry _ANSI_ARGS_((TkMenuEntry *mePtr,
			    Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
			    int *widthPtr, int *heightPtr));







>
>







260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
			    Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, 
			    int x, int y, int width, int height));
static void		DrawTearoffEntry _ANSI_ARGS_((TkMenu *menuPtr,
			    TkMenuEntry *mePtr, Drawable d, GC gc, 
			    Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, 
			    int x, int y, int width, int height));
static void		FixMDEF _ANSI_ARGS_((void));
static void		GetEntryText _ANSI_ARGS_((TkMenuEntry *mePtr,
			    Tcl_DString *dStringPtr));
static void		GetMenuAccelGeometry _ANSI_ARGS_((TkMenu *menuPtr,
			    TkMenuEntry *mePtr, Tk_Font tkfont,
			    CONST Tk_FontMetrics *fmPtr, int *modWidthPtr,
			    int *textWidthPtr, int *heightPtr));
static void		GetMenuLabelGeometry _ANSI_ARGS_((TkMenuEntry *mePtr,
			    Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
			    int *widthPtr, int *heightPtr));
280
281
282
283
284
285
286









287
288
289
290
291
292
293
static void		RecursivelyDeleteMenu _ANSI_ARGS_((
			    TkMenu *menuPtr));
static void		RecursivelyInsertMenu _ANSI_ARGS_((
			    TkMenu *menuPtr));
static void		SetDefaultMenubar _ANSI_ARGS_((void));
static int		SetMenuCascade _ANSI_ARGS_((TkMenu *menuPtr));
static void		SetMenuIndicator _ANSI_ARGS_((TkMenuEntry *mePtr));











/*
 *----------------------------------------------------------------------
 *
 * TkMacUseID --
 *







>
>
>
>
>
>
>
>
>







306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
static void		RecursivelyDeleteMenu _ANSI_ARGS_((
			    TkMenu *menuPtr));
static void		RecursivelyInsertMenu _ANSI_ARGS_((
			    TkMenu *menuPtr));
static void		SetDefaultMenubar _ANSI_ARGS_((void));
static int		SetMenuCascade _ANSI_ARGS_((TkMenu *menuPtr));
static void		SetMenuIndicator _ANSI_ARGS_((TkMenuEntry *mePtr));
static void		SetMenuTitle _ANSI_ARGS_((MenuHandle menuHdl,
			    Tcl_Obj *titlePtr));
static void		AppearanceEntryDrawWrapper _ANSI_ARGS_((TkMenuEntry *mePtr, 
			    Rect * menuRectPtr, TkMenuLowMemGlobals *globalsPtr,     
			    Drawable d, Tk_FontMetrics *fmPtr, Tk_Font tkfont,
			    int x, int y, int width, int height));
pascal void 		tkThemeMenuItemDrawingProc _ANSI_ARGS_ ((const Rect *inBounds,
			    SInt16 inDepth, Boolean inIsColorDevice, 
			    SInt32 inUserData));


/*
 *----------------------------------------------------------------------
 *
 * TkMacUseID --
 *
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
 *	value.
 *
 *----------------------------------------------------------------------
 */

int
TkMacUseMenuID(
    short macID)			/* The id to take out of the table */
{
    Tcl_HashEntry *commandEntryPtr;
    int newEntry;
    
    TkMenuInit();
    commandEntryPtr = Tcl_CreateHashEntry(&commandTable, (char *) macID,
    	    &newEntry);







|







339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
 *	value.
 *
 *----------------------------------------------------------------------
 */

int
TkMacUseMenuID(
    short macID)		/* The id to take out of the table */
{
    Tcl_HashEntry *commandEntryPtr;
    int newEntry;
    
    TkMenuInit();
    commandEntryPtr = Tcl_CreateHashEntry(&commandTable, (char *) macID,
    	    &newEntry);
415
416
417
418
419
420
421

422
423
424
425
426
427
428
    }

    if (found) {
    	Tcl_SetHashValue(commandEntryPtr, (char *) menuPtr);
    	*menuIDPtr = returnID;
    	return TCL_OK;
    } else {

        Tcl_AppendResult(interp, "No more menus can be allocated.", 
        	(char *) NULL);
    	return TCL_ERROR;
    }
}

/*







>







450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
    }

    if (found) {
    	Tcl_SetHashValue(commandEntryPtr, (char *) menuPtr);
    	*menuIDPtr = returnID;
    	return TCL_OK;
    } else {
    	Tcl_ResetResult(interp);
        Tcl_AppendResult(interp, "No more menus can be allocated.", 
        	(char *) NULL);
    	return TCL_ERROR;
    }
}

/*
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
    length = strlen(Tk_PathName(menuPtr->tkwin));
    memmove(&itemText[1], Tk_PathName(menuPtr->tkwin), 
    	    (length > 230) ? 230 : length);
    itemText[0] = (length > 230) ? 230 : length;
    macMenuHdl = NewMenu(menuID, itemText);
#ifdef GENERATINGCFM
    {
        Handle mdefProc = GetResource('MDEF', 591);
        Handle sicnHandle = GetResource('SICN', SICN_RESOURCE_NUMBER);
	if ((mdefProc != NULL) && (sicnHandle != NULL)) {
    	    (*macMenuHdl)->menuProc = mdefProc;
    	}
    }
#endif
    menuPtr->platformData = (TkMenuPlatformData) ckalloc(sizeof(MacMenu));
    ((MacMenu *) menuPtr->platformData)->menuHdl = macMenuHdl;
    SetRect(&((MacMenu *) menuPtr->platformData)->menuRect, 0, 0, 0, 0);







|
<
|







531
532
533
534
535
536
537
538

539
540
541
542
543
544
545
546
    length = strlen(Tk_PathName(menuPtr->tkwin));
    memmove(&itemText[1], Tk_PathName(menuPtr->tkwin), 
    	    (length > 230) ? 230 : length);
    itemText[0] = (length > 230) ? 230 : length;
    macMenuHdl = NewMenu(menuID, itemText);
#ifdef GENERATINGCFM
    {
        Handle mdefProc = FixMDEF();

        if ((mdefProc != NULL)) {
    	    (*macMenuHdl)->menuProc = mdefProc;
    	}
    }
#endif
    menuPtr->platformData = (TkMenuPlatformData) ckalloc(sizeof(MacMenu));
    ((MacMenu *) menuPtr->platformData)->menuHdl = macMenuHdl;
    SetRect(&((MacMenu *) menuPtr->platformData)->menuRect, 0, 0, 0, 0);
651
652
653
654
655
656
657
658

659
660
661
662
663
664
665
666
667
668
669
670
671
672

673

674
675
676
677
678
679
680
681
682
683
684
685
686
687

688

689
690
691
692
693
694
695
696
697
698



699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739



740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
/*
 *----------------------------------------------------------------------
 *
 * GetEntryText --
 *
 *	Given a menu entry, gives back the text that should go in it.
 *	Separators should be done by the caller, as they have to be
 *	handled specially.

 *
 * Results:
 *	itemText points to the new text for the item.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
GetEntryText(
    TkMenuEntry *mePtr,		/* A pointer to the menu entry. */
    Str255 itemText)		/* The pascal string containing the text */

{

    if (mePtr->type == TEAROFF_ENTRY) {
	strcpy((char *)itemText, (const char *)"\p(Tear-off)");
    } else if (mePtr->imageString != NULL) {
	strcpy((char *)itemText, (const char *)"\p(Image)");
    } else if (mePtr->bitmap != None) {
	strcpy((char *)itemText, (const char *)"\p(Pixmap)");
    } else if (mePtr->label == NULL || mePtr->labelLength == 0) {
    
	/*
	 * The Mac menu manager does not like null strings.
	 */
	 
	strcpy((char *)itemText, (const char *)"\p ");
    } else {

    	char *text = mePtr->label;

    	int i;
    	
    	itemText[0] = 0;
    	for (i = 1; (*text != '\0') && (i <= 230); i++, text++) {
    	    if ((*text == '.')
    	    	    && (*(text + 1) != '\0') && (*(text + 1) == '.')
    	    	    && (*(text + 2) != '\0') && (*(text + 2) == '.')) {
    	    	itemText[i] = '�';
    	    	text += 2;
    	    } else {



    	    	itemText[i] = *text;
    	    }
    	    itemText[0] += 1;
    	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * FindMarkCharacter --
 *
 *	Finds the Macintosh mark character based on the font of the
 *	item. We calculate a good mark character based on the font
 * 	that this item is rendered in.
 *
 * 	We try the following special mac characters. If none of them
 * 	are present, just use the check mark.
 * 	'' - Check mark character
 * 	'�' - Bullet character
 * 	'' - Filled diamond
 * 	'�' - Hollow diamond
 * 	'' = Long dash ("em dash")
 * 	'-' = short dash (minus, "en dash");
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	New item is added to platform menu
 *
 *----------------------------------------------------------------------
 */

static char
FindMarkCharacter(
    TkMenuEntry *mePtr)		/* The entry we are finding the character
    				 * for. */
{
    char markChar;
    Tk_Font tkfont = (mePtr->tkfont == NULL) ? mePtr->menuPtr->tkfont



    	    : mePtr->tkfont;
    	    
    if (!TkMacIsCharacterMissing(tkfont, '')) {
    	markChar = '';
    } else if (!TkMacIsCharacterMissing(tkfont, '�')) {
    	markChar = '�';
    } else if (!TkMacIsCharacterMissing(tkfont, '')) {
    	markChar = '';
    } else if (!TkMacIsCharacterMissing(tkfont, '�')) {
    	markChar = '�';
    } else if (!TkMacIsCharacterMissing(tkfont, '')) {
    	markChar = '';
    } else if (!TkMacIsCharacterMissing(tkfont, '-')) {
    	markChar = '-';
    } else {
    	markChar = '';
    }
    return markChar;
}







|
>













|
>

>

|
|
|
|
|
|





|

>
|
>


<
|



|
|
|
>
>
>
|

<
















|


|

















|
>
>
>
|



|
|




|
|







686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730

731
732
733
734
735
736
737
738
739
740
741
742

743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
/*
 *----------------------------------------------------------------------
 *
 * GetEntryText --
 *
 *	Given a menu entry, gives back the text that should go in it.
 *	Separators should be done by the caller, as they have to be
 *	handled specially. This is primarily used to do a substitution
 *	between "..." and "�".
 *
 * Results:
 *	itemText points to the new text for the item.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
GetEntryText(
    TkMenuEntry *mePtr,		/* A pointer to the menu entry. */
    Tcl_DString *dStringPtr)	/* The DString to put the text into. This
    				 * will be initialized by this routine. */
{
    Tcl_DStringInit(dStringPtr);
    if (mePtr->type == TEAROFF_ENTRY) {
    	Tcl_DStringAppend(dStringPtr, "(Tear-off)", -1);
    } else if (mePtr->imagePtr != NULL) {
    	Tcl_DStringAppend(dStringPtr, "(Image)", -1);
    } else if (mePtr->bitmapPtr != NULL) {
    	Tcl_DStringAppend(dStringPtr, "(Pixmap)", -1);
    } else if (mePtr->labelPtr == NULL || mePtr->labelLength == 0) {
    
	/*
	 * The Mac menu manager does not like null strings.
	 */
	 
	Tcl_DStringAppend(dStringPtr, " ", -1);
    } else {
    	int length;
    	char *text = Tcl_GetStringFromObj(mePtr->labelPtr, &length);
    	char *dStringText;
    	int i;
    	

	for (i = 0; i < length; text++, i++) {
    	    if ((*text == '.')
    	    	    && (*(text + 1) != '\0') && (*(text + 1) == '.')
    	    	    && (*(text + 2) != '\0') && (*(text + 2) == '.')) {
    	    	Tcl_DStringAppend(dStringPtr, elipsisString, -1);
    	    	i += strlen(elipsisString) - 1;
   	    } else {
    	    	Tcl_DStringSetLength(dStringPtr,
			Tcl_DStringLength(dStringPtr) + 1);
    	    	dStringText = Tcl_DStringValue(dStringPtr);
    	    	dStringText[i] = *text;
    	    }

    	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * FindMarkCharacter --
 *
 *	Finds the Macintosh mark character based on the font of the
 *	item. We calculate a good mark character based on the font
 * 	that this item is rendered in.
 *
 * 	We try the following special mac characters. If none of them
 * 	are present, just use the check mark.
 * 	'' - Check mark character
 * 	'�' - Bullet character
 * 	'' - Filled diamond
 * 	'�' - Hollow diamond
 * 	'' = Long dash ("em dash")
 * 	'-' = short dash (minus, "en dash");
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	New item is added to platform menu
 *
 *----------------------------------------------------------------------
 */

static char
FindMarkCharacter(
    TkMenuEntry *mePtr)		/* The entry we are finding the character
    				 * for. */
{
    char markChar;
    Tk_Font tkfont;

    tkfont = Tk_GetFontFromObj(mePtr->menuPtr->tkwin,
    	    (mePtr->fontPtr == NULL) ? mePtr->menuPtr->fontPtr
	    : mePtr->fontPtr);
    	    
    if (!TkMacIsCharacterMissing(tkfont, '')) {
    	markChar = '';
    } else if (!TkMacIsCharacterMissing(tkfont, '�')) {
    	markChar = '�';
    } else if (!TkMacIsCharacterMissing(tkfont, '')) {
    	markChar = '';
    } else if (!TkMacIsCharacterMissing(tkfont, '�')) {
    	markChar = '�';
    } else if (!TkMacIsCharacterMissing(tkfont, '')) {
    	markChar = '';
    } else if (!TkMacIsCharacterMissing(tkfont, '-')) {
    	markChar = '-';
    } else {
    	markChar = '';
    }
    return markChar;
}
791
792
793
794
795
796
797
798

799
800
801
802
803
804
805

806
807
808
809
810
811
812
     * Also, we do reflect the tearOff menu items in the Mac menu
     * handle, so we ignore them.
     */

    if (mePtr->type == CASCADE_ENTRY) {
    	return;
    }
     

    if (((mePtr->type == RADIO_BUTTON_ENTRY) 
    	    || (mePtr->type == CHECK_BUTTON_ENTRY))
    	    && (mePtr->indicatorOn)
    	    && (mePtr->entryFlags & ENTRY_SELECTED)) {
    	markChar = FindMarkCharacter(mePtr);
    } else {
        markChar = 0;

    }
    SetItemMark(macMenuHdl, mePtr->index + 1, markChar);
}

/*
 *----------------------------------------------------------------------
 *







|
>
|
|
<
|
|
<
<
>







835
836
837
838
839
840
841
842
843
844
845

846
847


848
849
850
851
852
853
854
855
     * Also, we do reflect the tearOff menu items in the Mac menu
     * handle, so we ignore them.
     */

    if (mePtr->type == CASCADE_ENTRY) {
    	return;
    }
    
    markChar = 0;
    if ((mePtr->type == RADIO_BUTTON_ENTRY) 
    	    || (mePtr->type == CHECK_BUTTON_ENTRY)) {

    	if (mePtr->indicatorOn && (mePtr->entryFlags & ENTRY_SELECTED)) {
    	    markChar = FindMarkCharacter(mePtr);


    	}
    }
    SetItemMark(macMenuHdl, mePtr->index + 1, markChar);
}

/*
 *----------------------------------------------------------------------
 *
825
826
827
828
829
830
831
832
833
834
835


836
837
838
839
840
841
842
 *
 *----------------------------------------------------------------------
 */

static void
SetMenuTitle(
    MenuHandle menuHdl,		/* The menu we are setting the title of. */
    char *title)		/* The C string to set the title to. */
{
    int oldLength, newLength, oldHandleSize, dataLength;
    Ptr menuDataPtr;


 
    menuDataPtr = (Ptr) (*menuHdl)->menuData;

    if (strncmp(title, menuDataPtr + 1, menuDataPtr[0]) != 0) {    
    	newLength = strlen(title) + 1;
    	oldLength = menuDataPtr[0] + 1;
    	oldHandleSize = GetHandleSize((Handle) menuHdl);







|



>
>







868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
 *
 *----------------------------------------------------------------------
 */

static void
SetMenuTitle(
    MenuHandle menuHdl,		/* The menu we are setting the title of. */
    Tcl_Obj *titlePtr)	/* The C string to set the title to. */
{
    int oldLength, newLength, oldHandleSize, dataLength;
    Ptr menuDataPtr;
    char *title = (titlePtr == NULL) ? ""
    	    : Tcl_GetStringFromObj(titlePtr, NULL);
 
    menuDataPtr = (Ptr) (*menuHdl)->menuData;

    if (strncmp(title, menuDataPtr + 1, menuDataPtr[0]) != 0) {    
    	newLength = strlen(title) + 1;
    	oldLength = menuDataPtr[0] + 1;
    	oldHandleSize = GetHandleSize((Handle) menuHdl);
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
 *
 * TkpConfigureMenuEntry --
 *
 *	Processes configurations for menu entries.
 *
 * Results:
 *	Returns standard TCL result. If TCL_ERROR is returned, then
 *	interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information get set for mePtr; old resources
 *	get freed, if any need it.
 *
 *----------------------------------------------------------------------
 */







|







910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
 *
 * TkpConfigureMenuEntry --
 *
 *	Processes configurations for menu entries.
 *
 * Results:
 *	Returns standard TCL result. If TCL_ERROR is returned, then
 *	the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information get set for mePtr; old resources
 *	get freed, if any need it.
 *
 *----------------------------------------------------------------------
 */
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928


929
930
931
932
933
934
935
    	    	int error = SetMenuCascade(mePtr->childMenuRefPtr->menuPtr);
    	    	
    	    	if (error != TCL_OK) {
    	    	    return error;
    	    	}
    	    	
    	    	if (menuPtr->menuType == MENUBAR) {
    	    	    SetMenuTitle(childMenuHdl, mePtr->label);
    	    	}
    	    }
    	}
    }
	
    /*
     * We need to parse the accelerator string. If it has the strings
     * for Command, Control, Shift or Option, we need to flag it
     * so we can draw the symbols for it. We also need to precalcuate
     * the position of the first real character we are drawing.
     */
	
    if (0 == mePtr->accelLength) {
    	((EntryGeometry *)mePtr->platformEntryData)->accelTextStart = -1;
    } else {
	char *accelString = mePtr->accel;


	mePtr->entryFlags |= ~ENTRY_ACCEL_MASK;
	    
	while (1) {
	    if ((0 == strncasecmp("Control", accelString, 6))
	    	    && (('-' == accelString[6]) || ('+' == accelString[6]))) {
	  	mePtr->entryFlags |= ENTRY_CONTROL_ACCEL;
	  	accelString += 7;







|















|
>
>







950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
    	    	int error = SetMenuCascade(mePtr->childMenuRefPtr->menuPtr);
    	    	
    	    	if (error != TCL_OK) {
    	    	    return error;
    	    	}
    	    	
    	    	if (menuPtr->menuType == MENUBAR) {
    	    	    SetMenuTitle(childMenuHdl, mePtr->labelPtr);
    	    	}
    	    }
    	}
    }
	
    /*
     * We need to parse the accelerator string. If it has the strings
     * for Command, Control, Shift or Option, we need to flag it
     * so we can draw the symbols for it. We also need to precalcuate
     * the position of the first real character we are drawing.
     */
	
    if (0 == mePtr->accelLength) {
    	((EntryGeometry *)mePtr->platformEntryData)->accelTextStart = -1;
    } else {
	char *accelString = (mePtr->accelPtr == NULL) ? ""
		: Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
	char *accel = accelString;
	mePtr->entryFlags |= ~ENTRY_ACCEL_MASK;
	    
	while (1) {
	    if ((0 == strncasecmp("Control", accelString, 6))
	    	    && (('-' == accelString[6]) || ('+' == accelString[6]))) {
	  	mePtr->entryFlags |= ENTRY_CONTROL_ACCEL;
	  	accelString += 7;
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
	  	accelString += 5;
	    } else {
	  	break;
	    }
	}
	    
	((EntryGeometry *)mePtr->platformEntryData)->accelTextStart 
		= ((long) accelString - (long) mePtr->accel);
    }
    
    if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
    	menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
    	Tcl_DoWhenIdle(ReconfigureMacintoshMenu, (ClientData) menuPtr);
    }
    







|







1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
	  	accelString += 5;
	    } else {
	  	break;
	    }
	}
	    
	((EntryGeometry *)mePtr->platformEntryData)->accelTextStart 
		= ((long) accelString - (long) accel);
    }
    
    if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
    	menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
    	Tcl_DoWhenIdle(ReconfigureMacintoshMenu, (ClientData) menuPtr);
    }
    
1014
1015
1016
1017
1018
1019
1020

1021
1022
1023



1024
1025
1026
1027
1028
1029
1030
1031
1032
    				 * helpMenuItemCount for help menus. */
{
    int count;
    int index;
    TkMenuEntry *mePtr;
    Str255 itemText;
    int parentDisabled = 0;

    
    for (mePtr = menuPtr->menuRefPtr->parentEntryPtr; mePtr != NULL;
    	    mePtr = mePtr->nextCascadePtr) {



    	if (strcmp(Tk_PathName(menuPtr->tkwin), mePtr->name) == 0) {
    	    if (mePtr->state == tkDisabledUid) {
    	    	parentDisabled = 1;
    	    }
    	    break;
    	}
    }
    
    /*







>



>
>
>
|
|







1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
    				 * helpMenuItemCount for help menus. */
{
    int count;
    int index;
    TkMenuEntry *mePtr;
    Str255 itemText;
    int parentDisabled = 0;
    int state;
    
    for (mePtr = menuPtr->menuRefPtr->parentEntryPtr; mePtr != NULL;
    	    mePtr = mePtr->nextCascadePtr) {
    	char *name = (mePtr->namePtr == NULL) ? ""
    		: Tcl_GetStringFromObj(mePtr->namePtr, NULL);
    	
    	if (strcmp(Tk_PathName(menuPtr->tkwin), name) == 0) {
    	    if (mePtr->state == ENTRY_DISABLED) {
    	    	parentDisabled = 1;
    	    }
    	    break;
    	}
    }
    
    /*
1047
1048
1049
1050
1051
1052
1053



1054






1055
1056

1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095




1096
1097
1098

1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118

1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
    	 * We have to do separators separately because SetMenuItemText
    	 * does not parse meta-characters.
    	 */
    
    	if (mePtr->type == SEPARATOR_ENTRY) {
    	    AppendMenu(macMenuHdl, SEPARATOR_TEXT);
    	} else {



	    GetEntryText(mePtr, itemText);






	    AppendMenu(macMenuHdl, "\px");
	    SetMenuItemText(macMenuHdl, base + index, itemText);

	
    	    /*
    	     * Set enabling and disabling correctly.
    	     */

	    if (parentDisabled || (mePtr->state == tkDisabledUid)) {
	    	DisableItem(macMenuHdl, base + index);
	    } else {
	    	EnableItem(macMenuHdl, base + index);
	    }
    	
    	    /*
    	     * Set the check mark for check entries and radio entries.
    	     */
	
	    SetItemMark(macMenuHdl, base + index, 0);		
	    if ((mePtr->type == CHECK_BUTTON_ENTRY)
		    || (mePtr->type == RADIO_BUTTON_ENTRY)) {
	    	CheckItem(macMenuHdl, base + index, (mePtr->entryFlags
		    	& ENTRY_SELECTED) && (mePtr->indicatorOn));
		if ((mePtr->indicatorOn)
			&& (mePtr->entryFlags & ENTRY_SELECTED)) {
		    SetItemMark(macMenuHdl, base + index,
		    	    FindMarkCharacter(mePtr));
	    	}
	    }
	
	    if (mePtr->type == CASCADE_ENTRY) {
	    	if ((mePtr->childMenuRefPtr != NULL) 
	    	    	&& (mePtr->childMenuRefPtr->menuPtr != NULL)) {
	    	    MenuHandle childMenuHdl = 
	    	    	    ((MacMenu *) mePtr->childMenuRefPtr
			    ->menuPtr->platformData)->menuHdl;

		    if (childMenuHdl == NULL) {
		        childMenuHdl = ((MacMenu *) mePtr->childMenuRefPtr
			    	->menuPtr->platformData)->menuHdl;
		    }
		    if (childMenuHdl != NULL) {




	    	    	SetItemMark(macMenuHdl, base + index,
				(*childMenuHdl)->menuID);
	    	    	SetItemCmd(macMenuHdl, base + index, CASCADE_CMD);

	    	    }
	    	    /*
	    	     * If we changed the highligthing of this menu, its
	    	     * children all have to be reconfigured so that
	    	     * their state will be reflected in the menubar.
	    	     */
	    
	    	    if (!(mePtr->childMenuRefPtr->menuPtr->menuFlags 
	    	    	    	& MENU_RECONFIGURE_PENDING)) {
	    	    	mePtr->childMenuRefPtr->menuPtr->menuFlags
	    	    		|= MENU_RECONFIGURE_PENDING;
	    	    	Tcl_DoWhenIdle(ReconfigureMacintoshMenu, 
	    	    		(ClientData) mePtr->childMenuRefPtr->menuPtr);
	    	    }
	    	}
	    }
	    
    	    if ((mePtr->type != CASCADE_ENTRY) 
    	    	    && (ENTRY_COMMAND_ACCEL 
    	    	    == (mePtr->entryFlags & ENTRY_ACCEL_MASK))) {

	    	SetItemCmd(macMenuHdl, index, mePtr
			->accel[((EntryGeometry *)mePtr->platformEntryData)
	    		->accelTextStart]);
	    }
    	}
    }
}

/*
 *----------------------------------------------------------------------







>
>
>
|
>
>
>
>
>
>


>





|













|
|


















>
>
>
>



>




















>
|
<
|







1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186

1187
1188
1189
1190
1191
1192
1193
1194
    	 * We have to do separators separately because SetMenuItemText
    	 * does not parse meta-characters.
    	 */
    
    	if (mePtr->type == SEPARATOR_ENTRY) {
    	    AppendMenu(macMenuHdl, SEPARATOR_TEXT);
    	} else {
    	    Tcl_DString itemTextDString;
    	    int destWrote;
    	    
	    GetEntryText(mePtr, &itemTextDString);
	    Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&itemTextDString),
	    	    Tcl_DStringLength(&itemTextDString), 0, NULL, 
	    	    (char *) &itemText[1],
	    	    231, NULL, &destWrote, NULL);
	    itemText[0] = destWrote;
	    
	    AppendMenu(macMenuHdl, "\px");
	    SetMenuItemText(macMenuHdl, base + index, itemText);
	    Tcl_DStringFree(&itemTextDString);
	
    	    /*
    	     * Set enabling and disabling correctly.
    	     */

	    if (parentDisabled || (mePtr->state == ENTRY_DISABLED)) {
	    	DisableItem(macMenuHdl, base + index);
	    } else {
	    	EnableItem(macMenuHdl, base + index);
	    }
    	
    	    /*
    	     * Set the check mark for check entries and radio entries.
    	     */
	
	    SetItemMark(macMenuHdl, base + index, 0);		
	    if ((mePtr->type == CHECK_BUTTON_ENTRY)
		    || (mePtr->type == RADIO_BUTTON_ENTRY)) {
	    	CheckItem(macMenuHdl, base + index, (mePtr->entryFlags
		    	& ENTRY_SELECTED) && mePtr->indicatorOn);
		if (mePtr->indicatorOn
			&& (mePtr->entryFlags & ENTRY_SELECTED)) {
		    SetItemMark(macMenuHdl, base + index,
		    	    FindMarkCharacter(mePtr));
	    	}
	    }
	
	    if (mePtr->type == CASCADE_ENTRY) {
	    	if ((mePtr->childMenuRefPtr != NULL) 
	    	    	&& (mePtr->childMenuRefPtr->menuPtr != NULL)) {
	    	    MenuHandle childMenuHdl = 
	    	    	    ((MacMenu *) mePtr->childMenuRefPtr
			    ->menuPtr->platformData)->menuHdl;

		    if (childMenuHdl == NULL) {
		        childMenuHdl = ((MacMenu *) mePtr->childMenuRefPtr
			    	->menuPtr->platformData)->menuHdl;
		    }
		    if (childMenuHdl != NULL) {
		        if (TkMacHaveAppearance() > 1) {
		            SetMenuItemHierarchicalID(macMenuHdl, base + index,
				    (*childMenuHdl)->menuID);
		        } else {
	    	    	SetItemMark(macMenuHdl, base + index,
				(*childMenuHdl)->menuID);
	    	    	SetItemCmd(macMenuHdl, base + index, CASCADE_CMD);
	    	    }
	    	    }
	    	    /*
	    	     * If we changed the highligthing of this menu, its
	    	     * children all have to be reconfigured so that
	    	     * their state will be reflected in the menubar.
	    	     */
	    
	    	    if (!(mePtr->childMenuRefPtr->menuPtr->menuFlags 
	    	    	    	& MENU_RECONFIGURE_PENDING)) {
	    	    	mePtr->childMenuRefPtr->menuPtr->menuFlags
	    	    		|= MENU_RECONFIGURE_PENDING;
	    	    	Tcl_DoWhenIdle(ReconfigureMacintoshMenu, 
	    	    		(ClientData) mePtr->childMenuRefPtr->menuPtr);
	    	    }
	    	}
	    }
	    
    	    if ((mePtr->type != CASCADE_ENTRY) 
    	    	    && (ENTRY_COMMAND_ACCEL 
    	    	    == (mePtr->entryFlags & ENTRY_ACCEL_MASK))) {
    	    	char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
	    	SetItemCmd(macMenuHdl, index, accel[((EntryGeometry *)

	    		mePtr->platformEntryData)->accelTextStart]);
	    }
    	}
    }
}

/*
 *----------------------------------------------------------------------
1391
1392
1393
1394
1395
1396
1397

























1398
1399
1400
1401
1402
1403
1404
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

























 * 
 * DrawMenuBarWhenIdle --
 *
 *	Update the menu bar next time there is an idle event.
 *
 * Results:
 *	None.







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







1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * 
 * Tk_MacTurnOffMenus --
 *
 *	Turns off all the menu drawing code.  This is more than just disabling
 *      the "menu" command, this means that Tk will NEVER touch the menubar.
 *      It is needed in the Plugin, where Tk does not own the menubar.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A flag is set which will disable all menu drawing.
 *
 *----------------------------------------------------------------------
 */

EXTERN void
Tk_MacTurnOffMenus()
{
    gNoTkMenus = 1;
}

/*
 *----------------------------------------------------------------------
 *
 * 
 * DrawMenuBarWhenIdle --
 *
 *	Update the menu bar next time there is an idle event.
 *
 * Results:
 *	None.
1413
1414
1415
1416
1417
1418
1419








1420
1421
1422
1423
1424
1425
1426
DrawMenuBarWhenIdle(
    ClientData clientData)	/* ignored here */
{
    TkMenuReferences *menuRefPtr;
    TkMenu *appleMenuPtr, *helpMenuPtr;
    MenuHandle macMenuHdl;
    Tcl_HashEntry *hashEntryPtr;








    
    /*
     * We need to clear the apple and help menus of any extra items.
     */
 
    if (currentAppleMenuID != 0) {
    	hashEntryPtr = Tcl_FindHashEntry(&commandTable,







>
>
>
>
>
>
>
>







1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
DrawMenuBarWhenIdle(
    ClientData clientData)	/* ignored here */
{
    TkMenuReferences *menuRefPtr;
    TkMenu *appleMenuPtr, *helpMenuPtr;
    MenuHandle macMenuHdl;
    Tcl_HashEntry *hashEntryPtr;
    
    /*
     * If we have been turned off, exit.
     */
     
    if (gNoTkMenus) {
        return;
    }
    
    /*
     * We need to clear the apple and help menus of any extra items.
     */
 
    if (currentAppleMenuID != 0) {
    	hashEntryPtr = Tcl_FindHashEntry(&commandTable,
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
             * Null loop body.
             */
             
        }
        
        if (menuBarPtr == NULL) {
            SetDefaultMenubar();
        } else {		    
	    if (menuBarPtr->tearOff != menuPtr->tearOff) {
	    	if (menuBarPtr->tearOff) {
	    	    appleIndex = (-1 == appleIndex) ? appleIndex
	    	    	    : appleIndex + 1;
	    	    helpIndex = (-1 == helpIndex) ? helpIndex
	    	    	    : helpIndex + 1;
	    	} else {
	    	    appleIndex = (-1 == appleIndex) ? appleIndex
	    	            : appleIndex - 1;







|
|
|







1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
             * Null loop body.
             */
             
        }
        
        if (menuBarPtr == NULL) {
            SetDefaultMenubar();
        } else {
	    if (menuBarPtr->tearoff != menuPtr->tearoff) {
	    	if (menuBarPtr->tearoff) {
	    	    appleIndex = (-1 == appleIndex) ? appleIndex
	    	    	    : appleIndex + 1;
	    	    helpIndex = (-1 == helpIndex) ? helpIndex
	    	    	    : helpIndex + 1;
	    	} else {
	    	    appleIndex = (-1 == appleIndex) ? appleIndex
	    	            : appleIndex - 1;
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
	    }
	    if (helpIndex == -1) {
	    	currentHelpMenuID = 0;
	    }
	    
	    for (i = 0; i < menuBarPtr->numEntries; i++) {
	    	if (i == appleIndex) {
	    	    if (menuBarPtr->entries[i]->state == tkDisabledUid) {
	    	    	DisableItem(((MacMenu *) menuBarPtr->entries[i]
	    	    		->childMenuRefPtr->menuPtr
	    	    		->platformData)->menuHdl,
	    	    		0);
	    	    } else {
	    	    	EnableItem(((MacMenu *) menuBarPtr->entries[i]
	    	    		->childMenuRefPtr->menuPtr







|







1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
	    }
	    if (helpIndex == -1) {
	    	currentHelpMenuID = 0;
	    }
	    
	    for (i = 0; i < menuBarPtr->numEntries; i++) {
	    	if (i == appleIndex) {
	    	    if (menuBarPtr->entries[i]->state == ENTRY_DISABLED) {
	    	    	DisableItem(((MacMenu *) menuBarPtr->entries[i]
	    	    		->childMenuRefPtr->menuPtr
	    	    		->platformData)->menuHdl,
	    	    		0);
	    	    } else {
	    	    	EnableItem(((MacMenu *) menuBarPtr->entries[i]
	    	    		->childMenuRefPtr->menuPtr
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
	    	    	cascadeMenuPtr = menuBarPtr->entries[i]
			    	->childMenuRefPtr->menuPtr;
	    	    	macMenuHdl = ((MacMenu *) cascadeMenuPtr
	    	    		->platformData)->menuHdl;
		    	DeleteMenu((*macMenuHdl)->menuID);
	    	    	InsertMenu(macMenuHdl, 0);
	    	    	RecursivelyInsertMenu(cascadeMenuPtr);
	    	    	if (menuBarPtr->entries[i]->state == tkDisabledUid) {
	    	    	    DisableItem(((MacMenu *) menuBarPtr->entries[i]
	    	    	    	    ->childMenuRefPtr->menuPtr
	    	    	    	    ->platformData)->menuHdl,
				    0);
	    	    	} else {
	    	    	    EnableItem(((MacMenu *) menuBarPtr->entries[i]
	    	    	    	    ->childMenuRefPtr->menuPtr







|







1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
	    	    	cascadeMenuPtr = menuBarPtr->entries[i]
			    	->childMenuRefPtr->menuPtr;
	    	    	macMenuHdl = ((MacMenu *) cascadeMenuPtr
	    	    		->platformData)->menuHdl;
		    	DeleteMenu((*macMenuHdl)->menuID);
	    	    	InsertMenu(macMenuHdl, 0);
	    	    	RecursivelyInsertMenu(cascadeMenuPtr);
	    	    	if (menuBarPtr->entries[i]->state == ENTRY_DISABLED) {
	    	    	    DisableItem(((MacMenu *) menuBarPtr->entries[i]
	    	    	    	    ->childMenuRefPtr->menuPtr
	    	    	    	    ->platformData)->menuHdl,
				    0);
	    	    	} else {
	    	    	    EnableItem(((MacMenu *) menuBarPtr->entries[i]
	    	    	    	    ->childMenuRefPtr->menuPtr
1671
1672
1673
1674
1675
1676
1677

1678
1679
1680
1681
1682
1683
1684
1685
    
    for (i = 0; i < menuPtr->numEntries; i++) {
        if (menuPtr->entries[i]->type == CASCADE_ENTRY) {
            if ((menuPtr->entries[i]->childMenuRefPtr != NULL)
            	    && (menuPtr->entries[i]->childMenuRefPtr->menuPtr
		    != NULL)) {
            	cascadeMenuPtr = menuPtr->entries[i]->childMenuRefPtr->menuPtr;

	    	macMenuHdl = ((MacMenu *) cascadeMenuPtr->platformData)->menuHdl;
	    	InsertMenu(macMenuHdl, -1);
	    	RecursivelyInsertMenu(cascadeMenuPtr);
	    }
        }
    }
}








>
|







1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
    
    for (i = 0; i < menuPtr->numEntries; i++) {
        if (menuPtr->entries[i]->type == CASCADE_ENTRY) {
            if ((menuPtr->entries[i]->childMenuRefPtr != NULL)
            	    && (menuPtr->entries[i]->childMenuRefPtr->menuPtr
		    != NULL)) {
            	cascadeMenuPtr = menuPtr->entries[i]->childMenuRefPtr->menuPtr;
	    	macMenuHdl =
		        ((MacMenu *) cascadeMenuPtr->platformData)->menuHdl;
	    	InsertMenu(macMenuHdl, -1);
	    	RecursivelyInsertMenu(cascadeMenuPtr);
	    }
        }
    }
}

1712
1713
1714
1715
1716
1717
1718

1719
1720
1721
1722
1723
1724
1725
1726
    
    for (i = 0; i < menuPtr->numEntries; i++) {
        if (menuPtr->entries[i]->type == CASCADE_ENTRY) {
            if ((menuPtr->entries[i]->childMenuRefPtr != NULL)
            	    && (menuPtr->entries[i]->childMenuRefPtr->menuPtr
		    != NULL)) {
            	cascadeMenuPtr = menuPtr->entries[i]->childMenuRefPtr->menuPtr;

	    	macMenuHdl = ((MacMenu *) cascadeMenuPtr->platformData)->menuHdl;
	    	DeleteMenu((*macMenuHdl)->menuID);
	    	RecursivelyInsertMenu(cascadeMenuPtr);
	    }
        }
    }
}








>
|







1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
    
    for (i = 0; i < menuPtr->numEntries; i++) {
        if (menuPtr->entries[i]->type == CASCADE_ENTRY) {
            if ((menuPtr->entries[i]->childMenuRefPtr != NULL)
            	    && (menuPtr->entries[i]->childMenuRefPtr->menuPtr
		    != NULL)) {
            	cascadeMenuPtr = menuPtr->entries[i]->childMenuRefPtr->menuPtr;
	    	macMenuHdl =
		        ((MacMenu *) cascadeMenuPtr->platformData)->menuHdl;
	    	DeleteMenu((*macMenuHdl)->menuID);
	    	RecursivelyInsertMenu(cascadeMenuPtr);
	    }
        }
    }
}

1822
1823
1824
1825
1826
1827
1828
1829

1830
1831
1832
1833
1834
1835
1836
	    	for (listPtr = windowListPtr; listPtr != NULL;
	    		listPtr = listPtr->nextPtr) {
	    	    if (listPtr->tkwin == searchWindow) {
	    	    	break;
	    	    }
	    	}
	    	if (listPtr != NULL) {
	    	    menuName = Tk_PathName(listPtr->menuPtr->masterMenuPtr->tkwin);

	    	    break;
	    	}
	    }
	}
	
	if (menuName == NULL) {
	    currentMenuBarName = NULL;







|
>







1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
	    	for (listPtr = windowListPtr; listPtr != NULL;
	    		listPtr = listPtr->nextPtr) {
	    	    if (listPtr->tkwin == searchWindow) {
	    	    	break;
	    	    }
	    	}
	    	if (listPtr != NULL) {
	    	    menuName = Tk_PathName(listPtr->menuPtr->masterMenuPtr
			    ->tkwin);
	    	    break;
	    	}
	    }
	}
	
	if (menuName == NULL) {
	    currentMenuBarName = NULL;
2024
2025
2026
2027
2028
2029
2030


2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
    *modWidthPtr = 0;
    if (mePtr->type == CASCADE_ENTRY) {
        *textWidthPtr = SICN_HEIGHT;
    	*modWidthPtr = Tk_TextWidth(tkfont, "W", 1);
    } else if (0 == mePtr->accelLength) {
    	*textWidthPtr = 0;
    } else {


    	
    	if (NULL == GetResource('SICN', SICN_RESOURCE_NUMBER)) {
    	    *textWidthPtr = Tk_TextWidth(tkfont, mePtr->accel,
    	    	    mePtr->accelLength);
    	} else {
    	    int emWidth = Tk_TextWidth(tkfont, "W", 1) + 1;
    	    if ((mePtr->entryFlags & ENTRY_ACCEL_MASK) == 0) {
    	    	int width = Tk_TextWidth(tkfont, mePtr->accel,
    	    		mePtr->accelLength);
    	    	*textWidthPtr = emWidth;
    	    	if (width < emWidth) {
    	    	    *modWidthPtr = 0;
    	    	} else {
    	    	    *modWidthPtr = width - emWidth;
    	    	}   
    	    } else {







>
>


|
<



|
<







2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137

2138
2139
2140
2141

2142
2143
2144
2145
2146
2147
2148
    *modWidthPtr = 0;
    if (mePtr->type == CASCADE_ENTRY) {
        *textWidthPtr = SICN_HEIGHT;
    	*modWidthPtr = Tk_TextWidth(tkfont, "W", 1);
    } else if (0 == mePtr->accelLength) {
    	*textWidthPtr = 0;
    } else {
    	char *accel = (mePtr->accelPtr == NULL) ? ""
    		: Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
    	
    	if (NULL == GetResource('SICN', SICN_RESOURCE_NUMBER)) {
    	    *textWidthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength);

    	} else {
    	    int emWidth = Tk_TextWidth(tkfont, "W", 1) + 1;
    	    if ((mePtr->entryFlags & ENTRY_ACCEL_MASK) == 0) {
    	    	int width = Tk_TextWidth(tkfont, accel,	mePtr->accelLength);

    	    	*textWidthPtr = emWidth;
    	    	if (width < emWidth) {
    	    	    *modWidthPtr = 0;
    	    	} else {
    	    	    *modWidthPtr = width - emWidth;
    	    	}   
    	    } else {
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
    	    	}
    	    	if (mePtr->entryFlags & ENTRY_COMMAND_ACCEL) {
    	    	    *modWidthPtr += COMMAND_ICON_WIDTH;
    	    	}
    	    	if (1 == (mePtr->accelLength - length)) {
    	    	    *textWidthPtr = emWidth;
    	    	} else {
    	    	    *textWidthPtr += Tk_TextWidth(tkfont, mePtr->accel 
    		    	    + length, mePtr->accelLength - length);
    		}
    	    }
    	}
    }
}








|







2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
    	    	}
    	    	if (mePtr->entryFlags & ENTRY_COMMAND_ACCEL) {
    	    	    *modWidthPtr += COMMAND_ICON_WIDTH;
    	    	}
    	    	if (1 == (mePtr->accelLength - length)) {
    	    	    *textWidthPtr = emWidth;
    	    	} else {
    	    	    *textWidthPtr += Tk_TextWidth(tkfont, accel 
    		    	    + length, mePtr->accelLength - length);
    		}
    	    }
    	}
    }
}

2124
2125
2126
2127
2128
2129
2130




2131



2132

2133
2134
2135
2136
2137
2138
2139
    TkMenu *menuPtr,			/* The menu we are drawing */
    TkMenuEntry *mePtr,			/* The entry we are measuring */
    Tk_Font tkfont,			/* The precalculated font */
    CONST Tk_FontMetrics *fmPtr,	/* The precalcualted font metrics */
    int *widthPtr,			/* The resulting width */
    int *heightPtr)			/* The resulting height */
{




    *widthPtr = 0;



    *heightPtr = fmPtr->linespace;

}

/*
 *----------------------------------------------------------------------
 *
 * DrawMenuEntryIndicator --
 *







>
>
>
>
|
>
>
>
|
>







2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
    TkMenu *menuPtr,			/* The menu we are drawing */
    TkMenuEntry *mePtr,			/* The entry we are measuring */
    Tk_Font tkfont,			/* The precalculated font */
    CONST Tk_FontMetrics *fmPtr,	/* The precalcualted font metrics */
    int *widthPtr,			/* The resulting width */
    int *heightPtr)			/* The resulting height */
{
    if (TkMacHaveAppearance() > 1) {
        SInt16 outHeight;
        
        GetThemeMenuSeparatorHeight(&outHeight);
        *widthPtr = 0;
        *heightPtr = outHeight;
    } else {
        *widthPtr = 0;
        *heightPtr = fmPtr->linespace;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DrawMenuEntryIndicator --
 *
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177




2178


2179
2180
2181
2182









































2183
2184
2185
2186
2187
2188
2189
    Tk_Font tkfont,			/* The precalculated font */
    CONST Tk_FontMetrics *fmPtr,	/* The precalculated font metrics */
    int x,				/* topleft hand corner of entry */
    int y,				/* topleft hand corner of entry */
    int width,				/* width of entry */
    int height)				/* height of entry */
{
    if (((mePtr->type == CHECK_BUTTON_ENTRY) || 
    	    (mePtr->type == RADIO_BUTTON_ENTRY))
	    && (mePtr->indicatorOn)
    	    && (mePtr->entryFlags & ENTRY_SELECTED)) {
	int baseline;
	short markShort;
	char markChar;
    
    	baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
    	GetItemMark(((MacMenu *) menuPtr->platformData)->menuHdl,
    		mePtr->index + 1, &markShort);
        if (markShort != 0) {




            markChar = (char) markShort;


            Tk_DrawChars(menuPtr->display, d, gc, tkfont, &markChar, 1,
            	    x + 2, baseline);
	}
    }    









































}

/*
 *----------------------------------------------------------------------
 *
 * DrawSICN --
 *







|
|
|
|
|
|
<

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







2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281

2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
    Tk_Font tkfont,			/* The precalculated font */
    CONST Tk_FontMetrics *fmPtr,	/* The precalculated font metrics */
    int x,				/* topleft hand corner of entry */
    int y,				/* topleft hand corner of entry */
    int width,				/* width of entry */
    int height)				/* height of entry */
{
    if ((mePtr->type == CHECK_BUTTON_ENTRY) || 
    	    (mePtr->type == RADIO_BUTTON_ENTRY)) {
    	if (mePtr->indicatorOn
    	    	&& (mePtr->entryFlags & ENTRY_SELECTED)) {
	    int baseline;
	    short markShort;

    
    	    baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
    	    GetItemMark(((MacMenu *) menuPtr->platformData)->menuHdl,
    		    mePtr->index + 1, &markShort);
            if (markShort != 0) {
	    	char markChar;
	    	char markCharUTF[TCL_UTF_MAX + 1];
	    	int dstWrote;
	    	
            	markChar = (char) markShort;
            	Tcl_ExternalToUtf(NULL, NULL, &markChar, 1, 0, NULL,
			markCharUTF, TCL_UTF_MAX + 1, NULL, &dstWrote, NULL);
		Tk_DrawChars(menuPtr->display, d, gc, tkfont, markCharUTF,
			dstWrote, x + 2, baseline);
            }
	}
    }    
}

/*
 *----------------------------------------------------------------------
 *
 * DrawMenuBackground --
 *
 *	If Appearance is present, draws the Appearance background
 *
 * Results:
 *	Nothing
 *
 * Side effects:
 *	Commands are output to X to display the menu in its
 *	current mode.
 *
 *----------------------------------------------------------------------
 */
static void
DrawMenuBackground(
    Rect     *menuRectPtr,	/* The menu rect */
    Drawable d,			/* What we are drawing into */
    ThemeMenuType type			/* Type of menu */    
    )
{
    if (!TkMacHaveAppearance()) {
    	return;
    } else {
	CGrafPtr saveWorld;
	GDHandle saveDevice;
	GWorldPtr destPort;

	destPort = TkMacGetDrawablePort(d);
	GetGWorld(&saveWorld, &saveDevice);
	SetGWorld(destPort, NULL);
	TkMacSetUpClippingRgn(d);
	DrawThemeMenuBackground (menuRectPtr, type);
	SetGWorld(saveWorld, saveDevice);    
    	return;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DrawSICN --
 *
2285
2286
2287
2288
2289
2290
2291




2292





2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309

2310
2311
2312
2313



2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
    Tk_3DBorder activeBorder,	    /* border for menu background */
    int x,			    /* The left side of the entry */
    int y,			    /* The top of the entry */
    int width,			    /* The width of the entry */
    int height,			    /* The height of the entry */
    int drawArrow)		    /* Whether or not to draw cascade arrow */
{




    if (mePtr->type == CASCADE_ENTRY) {





    	if (0 == DrawSICN(SICN_RESOURCE_NUMBER, CASCADE_ARROW, d, gc,
    		x + width - SICN_HEIGHT, (y + (height / 2))
    		- (SICN_HEIGHT / 2))) {
	    XPoint points[3];
	    Tk_Window tkwin = menuPtr->tkwin;

	    if (mePtr->type == CASCADE_ENTRY) {
		points[0].x = width - menuPtr->activeBorderWidth
			- MAC_MARGIN_WIDTH - CASCADE_ARROW_WIDTH;
		points[0].y = y + (height - CASCADE_ARROW_HEIGHT)/2;
		points[1].x = points[0].x;
		points[1].y = points[0].y + CASCADE_ARROW_HEIGHT;
		points[2].x = points[0].x + CASCADE_ARROW_WIDTH;
		points[2].y = points[0].y + CASCADE_ARROW_HEIGHT/2;
		Tk_Fill3DPolygon(menuPtr->tkwin, d, activeBorder, points, 
			3, DECORATION_BORDER_WIDTH, TK_RELIEF_FLAT);
	    }

	}
    } else if (mePtr->accelLength != 0) {
    	int leftEdge = x + width;
    	int baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;




	if (NULL == GetResource('SICN', SICN_RESOURCE_NUMBER)) {
	    leftEdge -= ((EntryGeometry *) mePtr->platformEntryData)
	    	    ->accelTextWidth;
	    Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel,
	    	    mePtr->accelLength, leftEdge, baseline);
	} else {
	    EntryGeometry *geometryPtr = 
	    	    (EntryGeometry *) mePtr->platformEntryData;
	    int length = mePtr->accelLength - geometryPtr->accelTextStart;
	    
	    leftEdge -= geometryPtr->accelTextWidth;
	    if ((mePtr->entryFlags & ENTRY_ACCEL_MASK) == 0) {
	    	leftEdge -= geometryPtr->modifierWidth;
	    }
	    
	    Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel 
		    + geometryPtr->accelTextStart, length, leftEdge, baseline);

	    if (mePtr->entryFlags & ENTRY_COMMAND_ACCEL) {
	    	leftEdge -= COMMAND_ICON_WIDTH;
	    	DrawSICN(SICN_RESOURCE_NUMBER, COMMAND_ICON, d, gc,
	    		leftEdge, (y + (height / 2)) - (SICN_HEIGHT / 2) - 1);
	    }







>
>
>
>

>
>
>
>
>







|









>




>
>
>




|











|







2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
    Tk_3DBorder activeBorder,	    /* border for menu background */
    int x,			    /* The left side of the entry */
    int y,			    /* The top of the entry */
    int width,			    /* The width of the entry */
    int height,			    /* The height of the entry */
    int drawArrow)		    /* Whether or not to draw cascade arrow */
{
    int activeBorderWidth;
    
    Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
    	    &activeBorderWidth);
    if (mePtr->type == CASCADE_ENTRY) {
        /*
         * Under Appearance, we let the Appearance Manager draw the icon
         */
         
        if (!TkMacHaveAppearance()) {
    	if (0 == DrawSICN(SICN_RESOURCE_NUMBER, CASCADE_ARROW, d, gc,
    		x + width - SICN_HEIGHT, (y + (height / 2))
    		- (SICN_HEIGHT / 2))) {
	    XPoint points[3];
	    Tk_Window tkwin = menuPtr->tkwin;

	    if (mePtr->type == CASCADE_ENTRY) {
		points[0].x = width - activeBorderWidth
			- MAC_MARGIN_WIDTH - CASCADE_ARROW_WIDTH;
		points[0].y = y + (height - CASCADE_ARROW_HEIGHT)/2;
		points[1].x = points[0].x;
		points[1].y = points[0].y + CASCADE_ARROW_HEIGHT;
		points[2].x = points[0].x + CASCADE_ARROW_WIDTH;
		points[2].y = points[0].y + CASCADE_ARROW_HEIGHT/2;
		Tk_Fill3DPolygon(menuPtr->tkwin, d, activeBorder, points, 
			3, DECORATION_BORDER_WIDTH, TK_RELIEF_FLAT);
	    }
	}
	}
    } else if (mePtr->accelLength != 0) {
    	int leftEdge = x + width;
    	int baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
    	char *accel;
    	
    	accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);

	if (NULL == GetResource('SICN', SICN_RESOURCE_NUMBER)) {
	    leftEdge -= ((EntryGeometry *) mePtr->platformEntryData)
	    	    ->accelTextWidth;
	    Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
	    	    mePtr->accelLength, leftEdge, baseline);
	} else {
	    EntryGeometry *geometryPtr = 
	    	    (EntryGeometry *) mePtr->platformEntryData;
	    int length = mePtr->accelLength - geometryPtr->accelTextStart;
	    
	    leftEdge -= geometryPtr->accelTextWidth;
	    if ((mePtr->entryFlags & ENTRY_ACCEL_MASK) == 0) {
	    	leftEdge -= geometryPtr->modifierWidth;
	    }
	    
	    Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel 
		    + geometryPtr->accelTextStart, length, leftEdge, baseline);

	    if (mePtr->entryFlags & ENTRY_COMMAND_ACCEL) {
	    	leftEdge -= COMMAND_ICON_WIDTH;
	    	DrawSICN(SICN_RESOURCE_NUMBER, COMMAND_ICON, d, gc,
	    		leftEdge, (y + (height / 2)) - (SICN_HEIGHT / 2) - 1);
	    }
2391
2392
2393
2394
2395
2396
2397






2398


2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410

2411
2412
2413
2414
2415
2416
2417
    GDHandle saveDevice;
    GWorldPtr destPort;
   
    destPort = TkMacGetDrawablePort(d);
    GetGWorld(&saveWorld, &saveDevice);
    SetGWorld(destPort, NULL);
    TkMacSetUpClippingRgn(d);






    


    /*
     * We don't want to use the text GC for drawing the separator. It
     * needs to be the same color as disabled items.
     */
    
    TkMacSetUpGraphicsPort(mePtr->disabledGC != None ? mePtr->disabledGC
    	    : menuPtr->disabledGC);
    
    MoveTo(x, y + (height / 2));
    Line(width, 0);
    
    SetGWorld(saveWorld, saveDevice);

}

/*
 *----------------------------------------------------------------------
 *
 * MenuDefProc --
 *







>
>
>
>
>
>
|
>
>







<


<

>







2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582

2583
2584

2585
2586
2587
2588
2589
2590
2591
2592
2593
    GDHandle saveDevice;
    GWorldPtr destPort;
   
    destPort = TkMacGetDrawablePort(d);
    GetGWorld(&saveWorld, &saveDevice);
    SetGWorld(destPort, NULL);
    TkMacSetUpClippingRgn(d);
    if (TkMacHaveAppearance() > 1) {
        Rect r;
        r.top = y;
        r.left = x;
        r.bottom = y + height;
        r.right = x + width;
         
        DrawThemeMenuSeparator(&r);
    } else {
    /*
     * We don't want to use the text GC for drawing the separator. It
     * needs to be the same color as disabled items.
     */
    
    TkMacSetUpGraphicsPort(mePtr->disabledGC != None ? mePtr->disabledGC
    	    : menuPtr->disabledGC);

    MoveTo(x, y + (height / 2));
    Line(width, 0);

    SetGWorld(saveWorld, saveDevice);
}
}

/*
 *----------------------------------------------------------------------
 *
 * MenuDefProc --
 *
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
    					 * to change */
{
#define SCREEN_MARGIN 5
    TkMenu *menuPtr;
    TkMenuEntry *parentEntryPtr;
    Tcl_HashEntry *commandEntryPtr;
    GrafPtr windowMgrPort;
    Tk_Font tkfont;
    Tk_FontMetrics fontMetrics, entryMetrics;
    Tk_FontMetrics *fmPtr;
    TkMenuEntry *mePtr;
    int i;
    int maxMenuHeight;
    int oldItem;
    int newItem = -1;







|







2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
    					 * to change */
{
#define SCREEN_MARGIN 5
    TkMenu *menuPtr;
    TkMenuEntry *parentEntryPtr;
    Tcl_HashEntry *commandEntryPtr;
    GrafPtr windowMgrPort;
    Tk_Font tkfont, menuFont;
    Tk_FontMetrics fontMetrics, entryMetrics;
    Tk_FontMetrics *fmPtr;
    TkMenuEntry *mePtr;
    int i;
    int maxMenuHeight;
    int oldItem;
    int newItem = -1;
2521
2522
2523
2524
2525
2526
2527




















2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
		}
		if (searchMenuPtr->menuType == MENUBAR) {
		    break;
		}
	    }
	    UnionRgn(totalMenuRgn, tkMenuCascadeRgn, totalMenuRgn);
	    SetEmptyRgn(utilRgn);




















	    
	    /*
	     * Next, figure out scrolling information.
	     */
	    
    	    GetGWorld(&macMDEFDrawable.portPtr, &device);
	    menuClipRect = *menuRectPtr;
	    if ((menuClipRect.bottom - menuClipRect.top) 
	    	    < menuPtr->totalHeight) {
	 	if (globalsPtr->menuTop < menuRectPtr->top) {
	 	    DrawSICN(SICN_RESOURCE_NUMBER, UP_ARROW, 
	 	    	    (Drawable) &macMDEFDrawable,
	 	    	    menuPtr->textGC, 







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





<







2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728

2729
2730
2731
2732
2733
2734
2735
		}
		if (searchMenuPtr->menuType == MENUBAR) {
		    break;
		}
	    }
	    UnionRgn(totalMenuRgn, tkMenuCascadeRgn, totalMenuRgn);
	    SetEmptyRgn(utilRgn);
	    
	    /*
	     * Now draw the background if Appearance is present...
	     */
	     
    	    GetGWorld(&macMDEFDrawable.portPtr, &device);
	    if (TkMacHaveAppearance() > 1) {
	        ThemeMenuType menuType;
	        
	        if (menuPtr->menuRefPtr->topLevelListPtr != NULL) {
	            menuType = kThemeMenuTypePullDown;
	        } else if (menuPtr->menuRefPtr->parentEntryPtr != NULL) {
	            menuType = kThemeMenuTypeHierarchical;
	        } else {
	            menuType = kThemeMenuTypePopUp;
	        }
	            
	        DrawMenuBackground(menuRectPtr, (Drawable) &macMDEFDrawable, 
	        	menuType);
	    }
	    
	    /*
	     * Next, figure out scrolling information.
	     */
	    

	    menuClipRect = *menuRectPtr;
	    if ((menuClipRect.bottom - menuClipRect.top) 
	    	    < menuPtr->totalHeight) {
	 	if (globalsPtr->menuTop < menuRectPtr->top) {
	 	    DrawSICN(SICN_RESOURCE_NUMBER, UP_ARROW, 
	 	    	    (Drawable) &macMDEFDrawable,
	 	    	    menuPtr->textGC, 
2558
2559
2560
2561
2562
2563
2564

2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583

2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
	    
	    /*
	     * Now, actually draw the menu. Don't draw entries that
	     * are higher than the top arrow, and don't draw entries
	     * that are lower than the bottom.
	     */
	    

	    Tk_GetFontMetrics(menuPtr->tkfont, &fontMetrics);    	    
    	    for (i = 0; i < menuPtr->numEntries; i++) {
    	        mePtr = menuPtr->entries[i];
    	    	if (globalsPtr->menuTop + mePtr->y + mePtr->height
    	    		< menuClipRect.top) {
    	    	    continue;
    	    	} else if (globalsPtr->menuTop + mePtr->y
    	    		> menuClipRect.bottom) {
    	    	    continue;
    	    	}
	 	ClipRect(&menuClipRect);
    	    	if (mePtr->tkfont == NULL) {
    	    	    fmPtr = &fontMetrics;
    	    	    tkfont = menuPtr->tkfont;
    	    	} else {
    	    	    tkfont = mePtr->tkfont;
    	    	    Tk_GetFontMetrics(tkfont, &entryMetrics);
    	    	    fmPtr = &entryMetrics;
    	    	}

    	    	TkpDrawMenuEntry(mePtr, (Drawable) &macMDEFDrawable,
    	    		tkfont, fmPtr, menuRectPtr->left + mePtr->x, 
    	    		globalsPtr->menuTop + mePtr->y,
    	    		(mePtr->entryFlags & ENTRY_LAST_COLUMN) ?
    	    		menuPtr->totalWidth - mePtr->x : mePtr->width,
    	    		menuPtr->entries[i]->height, 0, 1);
     	    }
     	    globalsPtr->menuBottom = globalsPtr->menuTop 
     	    	    + menuPtr->totalHeight;
	    if (!EmptyRgn(utilRgn)) {
	    	SetClip(utilRgn);
	    	SetEmptyRgn(utilRgn);
	    }







>
|









|
|

|

|



>
|
|
|
|
|
|







2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
	    
	    /*
	     * Now, actually draw the menu. Don't draw entries that
	     * are higher than the top arrow, and don't draw entries
	     * that are lower than the bottom.
	     */
	    
	    menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
	    Tk_GetFontMetrics(menuFont, &fontMetrics);    	    
    	    for (i = 0; i < menuPtr->numEntries; i++) {
    	        mePtr = menuPtr->entries[i];
    	    	if (globalsPtr->menuTop + mePtr->y + mePtr->height
    	    		< menuClipRect.top) {
    	    	    continue;
    	    	} else if (globalsPtr->menuTop + mePtr->y
    	    		> menuClipRect.bottom) {
    	    	    continue;
    	    	}
	 	/* ClipRect(&menuClipRect); */
    	    	if (mePtr->fontPtr == NULL) {
    	    	    fmPtr = &fontMetrics;
    	    	    tkfont = menuFont;
    	    	} else {
		    tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
    	    	    Tk_GetFontMetrics(tkfont, &entryMetrics);
    	    	    fmPtr = &entryMetrics;
    	    	}
    	    	AppearanceEntryDrawWrapper(mePtr, menuRectPtr, globalsPtr,
    	    		(Drawable) &macMDEFDrawable, fmPtr, tkfont, 
    	    		menuRectPtr->left + mePtr->x,
     	    		globalsPtr->menuTop + mePtr->y,
   	    		(mePtr->entryFlags & ENTRY_LAST_COLUMN) ?
	        	    menuPtr->totalWidth - mePtr->x : mePtr->width,
	        	menuPtr->entries[i]->height);
     	    }
     	    globalsPtr->menuBottom = globalsPtr->menuTop 
     	    	    + menuPtr->totalHeight;
	    if (!EmptyRgn(utilRgn)) {
	    	SetClip(utilRgn);
	    	SetEmptyRgn(utilRgn);
	    }
2608
2609
2610
2611
2612
2613
2614

2615

2616
2617
2618

2619

2620
2621
2622
2623
2624
2625
2626
    	    
 	    GetGWorld(&macMDEFDrawable.portPtr, &device);
 	    GetForeColor(&origForeColor);
 	    GetBackColor(&origBackColor);

	    if (TkSetMacColor(menuPtr->textGC->foreground, 
	    	    &foreColor) == true) {

	    	RGBForeColor(&foreColor);

	    }
	    if (TkSetMacColor(menuPtr->textGC->background, 
	    	    &backColor) == true) {

	    	RGBBackColor(&backColor);

	    }

	    /*
	     * Find out which item was hit. If it is the same as the old item,
	     * we don't need to do anything.
	     */








>
|
>



>
|
>







2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
    	    
 	    GetGWorld(&macMDEFDrawable.portPtr, &device);
 	    GetForeColor(&origForeColor);
 	    GetBackColor(&origBackColor);

	    if (TkSetMacColor(menuPtr->textGC->foreground, 
	    	    &foreColor) == true) {
	    	if (!TkMacHaveAppearance()) {
	    	    RGBForeColor(&foreColor);
	    	}
	    }
	    if (TkSetMacColor(menuPtr->textGC->background, 
	    	    &backColor) == true) {
	    	if (!TkMacHaveAppearance()) {
	    	    RGBBackColor(&backColor);
	    	}
	    }

	    /*
	     * Find out which item was hit. If it is the same as the old item,
	     * we don't need to do anything.
	     */

2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654



2655
2656

2657
2658
2659
2660
2661
2662
2663
2664
2665
	    	    } else {
	    	    	itemRect.right = itemRect.left + mePtr->width;
	    	    }
	    	    itemRect.bottom = itemRect.top
			    + menuPtr->entries[i]->height;
	    	    if (PtInRect(hitPt, &itemRect)) {
	    	        if ((mePtr->type == SEPARATOR_ENTRY)
	    	        	|| (mePtr->state == tkDisabledUid)) {
	    	            newItem = -1;
	    	        } else {
	    	            TkMenuEntry *cascadeEntryPtr;
	    	            int parentDisabled = 0;
	    	            
	    	            for (cascadeEntryPtr
				    = menuPtr->menuRefPtr->parentEntryPtr;
	    	            	    cascadeEntryPtr != NULL;
	    	            	    cascadeEntryPtr 
	    	            	    = cascadeEntryPtr->nextCascadePtr) {



				if (strcmp(cascadeEntryPtr->name,
					Tk_PathName(menuPtr->tkwin)) == 0) {

				    if (cascadeEntryPtr->state
					    == tkDisabledUid) {
				    	parentDisabled = 1;
				    }
				    break;
				}
			    }
			    if (parentDisabled) {
			    	newItem = -1;







|










>
>
>
|
|
>
|
<







2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862

2863
2864
2865
2866
2867
2868
2869
	    	    } else {
	    	    	itemRect.right = itemRect.left + mePtr->width;
	    	    }
	    	    itemRect.bottom = itemRect.top
			    + menuPtr->entries[i]->height;
	    	    if (PtInRect(hitPt, &itemRect)) {
	    	        if ((mePtr->type == SEPARATOR_ENTRY)
	    	        	|| (mePtr->state == ENTRY_DISABLED)) {
	    	            newItem = -1;
	    	        } else {
	    	            TkMenuEntry *cascadeEntryPtr;
	    	            int parentDisabled = 0;
	    	            
	    	            for (cascadeEntryPtr
				    = menuPtr->menuRefPtr->parentEntryPtr;
	    	            	    cascadeEntryPtr != NULL;
	    	            	    cascadeEntryPtr 
	    	            	    = cascadeEntryPtr->nextCascadePtr) {
	    	            	char *name;
	    	            	
	    	            	name = Tcl_GetStringFromObj(
	    	            		cascadeEntryPtr->namePtr, NULL);
				if (strcmp(name, Tk_PathName(menuPtr->tkwin)) 
					== 0) {
				    if (cascadeEntryPtr->state == ENTRY_DISABLED) {

				    	parentDisabled = 1;
				    }
				    break;
				}
			    }
			    if (parentDisabled) {
			    	newItem = -1;
2705
2706
2707
2708
2709
2710
2711


2712




2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728


2729




2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758

2759
2760
2761
2762
2763
2764
2765
	    }
	    GetClip(utilRgn);
	    ClipRect(&menuClipRect);

	    if (oldItem != newItem) {
	        if (oldItem >= 0) {
		    mePtr = menuPtr->entries[oldItem];


		    tkfont = mePtr->tkfont ? mePtr->tkfont : menuPtr->tkfont;




		    Tk_GetFontMetrics(tkfont, &fontMetrics);
		    TkpDrawMenuEntry(mePtr, (Drawable) &macMDEFDrawable,
			    tkfont, &fontMetrics, 
			    menuRectPtr->left + mePtr->x,
		    	    globalsPtr->menuTop + mePtr->y,
		    	    (mePtr->entryFlags & ENTRY_LAST_COLUMN)
		    	    ? menuPtr->totalWidth - mePtr->x
		    	    : mePtr->width, mePtr->height, 0, 1);
		}
		if (newItem != -1) {
		    int oldActiveItem = menuPtr->active;
		    
		    mePtr = menuPtr->entries[newItem];
		    if (mePtr->state != tkDisabledUid) {
		    	TkActivateMenuEntry(menuPtr, newItem);
		    }


		    tkfont = mePtr->tkfont ? mePtr->tkfont : menuPtr->tkfont;




		    Tk_GetFontMetrics(tkfont, &fontMetrics);
		    TkpDrawMenuEntry(mePtr, (Drawable) &macMDEFDrawable,
		    	    tkfont, &fontMetrics, 
		    	    menuRectPtr->left + mePtr->x,
		    	    globalsPtr->menuTop + mePtr->y,
		    	    (mePtr->entryFlags & ENTRY_LAST_COLUMN)
		    	    ? menuPtr->totalWidth - mePtr->x
		    	    : mePtr->width, mePtr->height, 
		    	    0, 1);
		}

		tkUseMenuCascadeRgn = 1;
		MenuSelectEvent(menuPtr);
		Tcl_ServiceAll();
		tkUseMenuCascadeRgn = 0;
		if (mePtr->state != tkDisabledUid) {
		    TkActivateMenuEntry(menuPtr, -1);
		}
	    	*whichItem = newItem + 1;
	    }
	    globalsPtr->menuDisable = ((*menu)->menuID << 16) | (newItem + 1);
	    
	    if (scrollDirection == UP_SCROLL) {
	    	scrollAmt = menuClipRect.bottom - hitPt.v;
	    	if (scrollAmt < menuRectPtr->bottom 
	    		- globalsPtr->menuBottom) {
	    	    scrollAmt = menuRectPtr->bottom - globalsPtr->menuBottom;
	    	}
	    	if (!hasTopScroll && ((globalsPtr->menuTop + scrollAmt) < menuRectPtr->top)) {

	    	    SetRect(&updateRect, menuRectPtr->left,
	    	    	    globalsPtr->menuTop, menuRectPtr->right,
	    	    	    globalsPtr->menuTop + SICN_HEIGHT);
	    	    EraseRect(&updateRect);
	    	    DrawSICN(SICN_RESOURCE_NUMBER, UP_ARROW,
	    	    	    (Drawable) &macMDEFDrawable,
	    	    	    menuPtr->textGC, menuRectPtr->left







>
>
|
>
>
>
>

|
|
|
|
|
|
|





|


>
>
|
>
>
>
>

|
|
|
|
|
|
|
<






|












|
>







2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953

2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
	    }
	    GetClip(utilRgn);
	    ClipRect(&menuClipRect);

	    if (oldItem != newItem) {
	        if (oldItem >= 0) {
		    mePtr = menuPtr->entries[oldItem];
		    if (mePtr->fontPtr == NULL) {
			tkfont = Tk_GetFontFromObj(menuPtr->tkwin, 
				menuPtr->fontPtr);
		    } else {
			tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
				mePtr->fontPtr);
		    }
		    Tk_GetFontMetrics(tkfont, &fontMetrics);
    	    	    AppearanceEntryDrawWrapper(mePtr, menuRectPtr, globalsPtr,
    	    		(Drawable) &macMDEFDrawable, &fontMetrics, tkfont, 
    	    		menuRectPtr->left + mePtr->x,
     	    		globalsPtr->menuTop + mePtr->y,
   	    		(mePtr->entryFlags & ENTRY_LAST_COLUMN) ?
	        	    menuPtr->totalWidth - mePtr->x : mePtr->width,
	        	mePtr->height);
		}
		if (newItem != -1) {
		    int oldActiveItem = menuPtr->active;
		    
		    mePtr = menuPtr->entries[newItem];
		    if (mePtr->state != ENTRY_DISABLED) {
		    	TkActivateMenuEntry(menuPtr, newItem);
		    }
		    if (mePtr->fontPtr == NULL) {
			tkfont = Tk_GetFontFromObj(menuPtr->tkwin, 
				menuPtr->fontPtr);
		    } else {
			tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
				mePtr->fontPtr);
		    }
		    Tk_GetFontMetrics(tkfont, &fontMetrics);
    	    	    AppearanceEntryDrawWrapper(mePtr, menuRectPtr, globalsPtr,
    	    		(Drawable) &macMDEFDrawable, &fontMetrics, tkfont, 
    	    		menuRectPtr->left + mePtr->x,
     	    		globalsPtr->menuTop + mePtr->y,
   	    		(mePtr->entryFlags & ENTRY_LAST_COLUMN) ?
	        	    menuPtr->totalWidth - mePtr->x : mePtr->width,
	        	mePtr->height);

		}

		tkUseMenuCascadeRgn = 1;
		MenuSelectEvent(menuPtr);
		Tcl_ServiceAll();
		tkUseMenuCascadeRgn = 0;
		if (mePtr->state != ENTRY_DISABLED) {
		    TkActivateMenuEntry(menuPtr, -1);
		}
	    	*whichItem = newItem + 1;
	    }
	    globalsPtr->menuDisable = ((*menu)->menuID << 16) | (newItem + 1);
	    
	    if (scrollDirection == UP_SCROLL) {
	    	scrollAmt = menuClipRect.bottom - hitPt.v;
	    	if (scrollAmt < menuRectPtr->bottom 
	    		- globalsPtr->menuBottom) {
	    	    scrollAmt = menuRectPtr->bottom - globalsPtr->menuBottom;
	    	}
	    	if (!hasTopScroll && ((globalsPtr->menuTop + scrollAmt)
			< menuRectPtr->top)) {
	    	    SetRect(&updateRect, menuRectPtr->left,
	    	    	    globalsPtr->menuTop, menuRectPtr->right,
	    	    	    globalsPtr->menuTop + SICN_HEIGHT);
	    	    EraseRect(&updateRect);
	    	    DrawSICN(SICN_RESOURCE_NUMBER, UP_ARROW,
	    	    	    (Drawable) &macMDEFDrawable,
	    	    	    menuPtr->textGC, menuRectPtr->left
2783
2784
2785
2786
2787
2788
2789

2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803

2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817

2818
2819
2820
2821

2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846

2847
2848
2849
2850





2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
	    	    	    menuPtr->textGC, menuRectPtr->left
	    	    	    + menuPtr->entries[1]->indicatorSpace,
	    	    	    menuRectPtr->bottom - SICN_HEIGHT);
	    	    menuClipRect.bottom -= SICN_HEIGHT;
	    	}
	    }
	    if (scrollDirection != DONT_SCROLL) {

	    	RgnHandle updateRgn = NewRgn();
	    	ScrollRect(&menuClipRect, 0, scrollAmt, updateRgn);
	    	updateRect = (*updateRgn)->rgnBBox;
	    	DisposeRgn(updateRgn);
	    	globalsPtr->menuTop += scrollAmt;
	    	globalsPtr->menuBottom += scrollAmt;
	    	if (globalsPtr->menuTop == menuRectPtr->top) {
	    	    updateRect.top -= SICN_HEIGHT;
	    	}
	    	if (globalsPtr->menuBottom == menuRectPtr->bottom) {
	    	    updateRect.bottom += SICN_HEIGHT;
	    	}
		ClipRect(&updateRect);
		EraseRect(&updateRect);

	    	Tk_GetFontMetrics(menuPtr->tkfont, &fontMetrics);    	    
    	    	for (i = 0; i < menuPtr->numEntries; i++) {
    	            mePtr = menuPtr->entries[i];
    	    	    if (globalsPtr->menuTop + mePtr->y + mePtr->height
    	    		    < updateRect.top) {
    	    	    	continue;
    	    	    } else if (globalsPtr->menuTop + mePtr->y
    	    		    > updateRect.bottom) {
    	    	    	continue;
    	    	    }
    	    	    if (mePtr->tkfont == NULL) {
    	    	    	fmPtr = &fontMetrics;
    	    	    	tkfont = menuPtr->tkfont;
    	    	    } else {

    	    	    	tkfont = mePtr->tkfont;
    	    	    	Tk_GetFontMetrics(tkfont, &entryMetrics);
    	    	    	fmPtr = &entryMetrics;
    	    	    }

    	    	    TkpDrawMenuEntry(mePtr, (Drawable) &macMDEFDrawable,
    	    		    tkfont, fmPtr, menuRectPtr->left + mePtr->x, 
    	    		    globalsPtr->menuTop + mePtr->y,
    	    		    (mePtr->entryFlags & ENTRY_LAST_COLUMN) ?
    	    		    menuPtr->totalWidth - mePtr->x : mePtr->width,
    	    		    menuPtr->entries[i]->height, 0, 1);
     	    	}	    	
	    }

	    SetClip(utilRgn);
	    SetEmptyRgn(utilRgn);
	    RGBForeColor(&origForeColor);
	    RGBBackColor(&origBackColor);

    	    /*
    	     * If the menu is a tearoff, and the mouse is outside the menu,
    	     * we need to draw the drag rectangle.
    	     *
    	     * In order for tearoffs to work properly, we need to set
    	     * the active member of the containing menubar.
    	     */
    	    
    	    menuRefPtr = TkFindMenuReferences(menuPtr->interp,
    	    	    Tk_PathName(menuPtr->tkwin));
    	    if ((menuRefPtr != NULL) && (menuRefPtr->parentEntryPtr != NULL)) {

    	    	for (parentEntryPtr = menuRefPtr->parentEntryPtr;
    	    	    	strcmp(parentEntryPtr->name,
			Tk_PathName(menuPtr->tkwin)) == 0;
		        parentEntryPtr = parentEntryPtr->nextCascadePtr) {





    	    	}
    	    	if (parentEntryPtr != NULL) {
    	    	    TkActivateMenuEntry(parentEntryPtr->menuPtr,
			    parentEntryPtr->index);
	 	}
    	    }
    	    
	    if (menuPtr->tearOff) {
   	    	scratchRect = *menuRectPtr;
		if (tearoffStruct.menuPtr == NULL) {
   	    	    scratchRect.top -= 10;
   	    	    scratchRect.bottom += 10;
   	    	    scratchRect.left -= 10;
   	    	    scratchRect.right += 10;
   	    	}







>














>
|









|

|

>
|



>
|
|
|
|
|
|



















>

|
<
|
>
>
>
>
>



|



|







2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069

3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
	    	    	    menuPtr->textGC, menuRectPtr->left
	    	    	    + menuPtr->entries[1]->indicatorSpace,
	    	    	    menuRectPtr->bottom - SICN_HEIGHT);
	    	    menuClipRect.bottom -= SICN_HEIGHT;
	    	}
	    }
	    if (scrollDirection != DONT_SCROLL) {
	    	Tk_Font menuFont;
	    	RgnHandle updateRgn = NewRgn();
	    	ScrollRect(&menuClipRect, 0, scrollAmt, updateRgn);
	    	updateRect = (*updateRgn)->rgnBBox;
	    	DisposeRgn(updateRgn);
	    	globalsPtr->menuTop += scrollAmt;
	    	globalsPtr->menuBottom += scrollAmt;
	    	if (globalsPtr->menuTop == menuRectPtr->top) {
	    	    updateRect.top -= SICN_HEIGHT;
	    	}
	    	if (globalsPtr->menuBottom == menuRectPtr->bottom) {
	    	    updateRect.bottom += SICN_HEIGHT;
	    	}
		ClipRect(&updateRect);
		EraseRect(&updateRect);
		menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
	    	Tk_GetFontMetrics(menuFont, &fontMetrics);    	    
    	    	for (i = 0; i < menuPtr->numEntries; i++) {
    	            mePtr = menuPtr->entries[i];
    	    	    if (globalsPtr->menuTop + mePtr->y + mePtr->height
    	    		    < updateRect.top) {
    	    	    	continue;
    	    	    } else if (globalsPtr->menuTop + mePtr->y
    	    		    > updateRect.bottom) {
    	    	    	continue;
    	    	    }
    	    	    if (mePtr->fontPtr == NULL) {
    	    	    	fmPtr = &fontMetrics;
    	    	    	tkfont = menuFont;
    	    	    } else {
			tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
				mePtr->fontPtr);
    	    	    	Tk_GetFontMetrics(tkfont, &entryMetrics);
    	    	    	fmPtr = &entryMetrics;
    	    	    }
    	    	    AppearanceEntryDrawWrapper(mePtr, menuRectPtr, globalsPtr,
    	    		(Drawable) &macMDEFDrawable, fmPtr, tkfont, 
    	    		menuRectPtr->left + mePtr->x,
     	    		globalsPtr->menuTop + mePtr->y,
   	    		(mePtr->entryFlags & ENTRY_LAST_COLUMN) ?
	        	    menuPtr->totalWidth - mePtr->x : mePtr->width,
	        	menuPtr->entries[i]->height);
     	    	}	    	
	    }

	    SetClip(utilRgn);
	    SetEmptyRgn(utilRgn);
	    RGBForeColor(&origForeColor);
	    RGBBackColor(&origBackColor);

    	    /*
    	     * If the menu is a tearoff, and the mouse is outside the menu,
    	     * we need to draw the drag rectangle.
    	     *
    	     * In order for tearoffs to work properly, we need to set
    	     * the active member of the containing menubar.
    	     */
    	    
    	    menuRefPtr = TkFindMenuReferences(menuPtr->interp,
    	    	    Tk_PathName(menuPtr->tkwin));
    	    if ((menuRefPtr != NULL) && (menuRefPtr->parentEntryPtr != NULL)) {
    	    	char *name;
    	    	for (parentEntryPtr = menuRefPtr->parentEntryPtr;
    	    	        parentEntryPtr != NULL

    	    	    	; parentEntryPtr = parentEntryPtr->nextCascadePtr) {
		    name = Tcl_GetStringFromObj(parentEntryPtr->namePtr,
			    NULL);
		    if (strcmp(name, Tk_PathName(menuPtr->tkwin)) != 0) {
		        break;
		    }
    	    	}
    	    	if (parentEntryPtr != NULL) {
    	    	    TkActivateMenuEntry(parentEntryPtr->menuPtr,
    	    	    	    parentEntryPtr->index);
	 	}
    	    }
    	    
	    if (menuPtr->tearoff) {
   	    	scratchRect = *menuRectPtr;
		if (tearoffStruct.menuPtr == NULL) {
   	    	    scratchRect.top -= 10;
   	    	    scratchRect.bottom += 10;
   	    	    scratchRect.left -= 10;
   	    	    scratchRect.right += 10;
   	    	}
2959
2960
2961
2962
2963
2964
2965






































































































2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
    	    break;
    }
}

/*
 *----------------------------------------------------------------------
 *






































































































 * TkMacHandleTearoffMenu() --
 *
 *	This routine sees if the MDEF has set a menu and a mouse position
 *	for tearing off and makes a tearoff menu if it has.
 *
 * Results:
 *	menuPtr->interp will have the result of the tearoff command.
 *
 * Side effects:
 *	A new tearoff menu is created if it is supposed to be.
 *
 *----------------------------------------------------------------------
 */

void
TkMacHandleTearoffMenu(void)
{
    if (tearoffStruct.menuPtr != NULL) {
    	Tcl_DString tearoffCmdStr;
    	char intString[20];
    	short windowPart;
    	WindowRef whichWindow;
    	
    	windowPart = FindWindow(tearoffStruct.point, &whichWindow);
    	
    	if (windowPart != inMenuBar) {
    	    Tcl_DStringInit(&tearoffCmdStr);







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



















|







3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
    	    break;
    }
}

/*
 *----------------------------------------------------------------------
 *
 *   AppearanceEntryDrawWrapper --
 *
 *	This routine wraps the TkpDrawMenuEntry function.  Under Appearance, 
 *      it routes to the Appearance Managers DrawThemeEntry, otherwise it
 *      just goes straight to TkpDrawMenuEntry.
 *
 * Results:
 *	A menu entry is drawn
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */
static void 
AppearanceEntryDrawWrapper(
    TkMenuEntry *mePtr,
    Rect *menuRectPtr,
    TkMenuLowMemGlobals *globalsPtr,     
    Drawable d,
    Tk_FontMetrics *fmPtr, 
    Tk_Font tkfont, 
    int x, 
    int y, 
    int width, 
    int height)
{
    if (TkMacHaveAppearance() > 1) {
        MenuEntryUserData meData;
        Rect itemRect;
        ThemeMenuState theState;
        ThemeMenuItemType theType;
    
        meData.mePtr = mePtr;
        meData.mdefDrawable = d;
        meData.fmPtr = fmPtr;
        meData.tkfont = tkfont;
    
        itemRect.top = y;
        itemRect.left = x;
        itemRect.bottom = itemRect.top + height;
        itemRect.right = itemRect.left + width;
    
        if (mePtr->state == ENTRY_ACTIVE) {
            theState = kThemeMenuSelected;
        } else if (mePtr->state == ENTRY_DISABLED) {
    	    theState = kThemeMenuDisabled;
        } else {
    	    theState = kThemeMenuActive;
        }
        
        if (mePtr->type == CASCADE_ENTRY) {
            theType = kThemeMenuItemHierarchical;
        } else {
            theType = kThemeMenuItemPlain;
        }
        
        DrawThemeMenuItem (menuRectPtr, &itemRect,
    	        globalsPtr->menuTop, globalsPtr->menuBottom, theState,
    	        theType, tkThemeMenuItemDrawingUPP, 
    	        (unsigned long) &meData);
    	
    } else {
        TkpDrawMenuEntry(mePtr, d, tkfont, fmPtr,
	        x, y, width, height, 0, 1);
    }
}

/*
 *----------------------------------------------------------------------
 *
 *  tkThemeMenuItemDrawingProc --
 *
 *	This routine is called from the Appearance DrawThemeMenuEntry
 *
 * Results:
 *	A menu entry is drawn
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */
pascal void
tkThemeMenuItemDrawingProc (
	const Rect *inBounds,
	SInt16 inDepth, 
	Boolean inIsColorDevice, 
	SInt32 inUserData)
{
    MenuEntryUserData *meData = (MenuEntryUserData *) inUserData;

    TkpDrawMenuEntry(meData->mePtr, meData->mdefDrawable,
    	 meData->tkfont, meData->fmPtr, inBounds->left, 
    	 inBounds->top, inBounds->right - inBounds->left,
    	 inBounds->bottom - inBounds->top, 0, 1);

}

/*
 *----------------------------------------------------------------------
 *
 * TkMacHandleTearoffMenu() --
 *
 *	This routine sees if the MDEF has set a menu and a mouse position
 *	for tearing off and makes a tearoff menu if it has.
 *
 * Results:
 *	menuPtr->interp will have the result of the tearoff command.
 *
 * Side effects:
 *	A new tearoff menu is created if it is supposed to be.
 *
 *----------------------------------------------------------------------
 */

void
TkMacHandleTearoffMenu(void)
{
    if (tearoffStruct.menuPtr != NULL) {
    	Tcl_DString tearoffCmdStr;
    	char intString[TCL_INTEGER_SPACE];
    	short windowPart;
    	WindowRef whichWindow;
    	
    	windowPart = FindWindow(tearoffStruct.point, &whichWindow);
    	
    	if (windowPart != inMenuBar) {
    	    Tcl_DStringInit(&tearoffCmdStr);
3088
3089
3090
3091
3092
3093
3094

3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105

3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
    int x,				/* Left edge of entry. */
    int y,				/* Top edge of entry. */
    int width,				/* Width of entry. */
    int height)				/* Height of entry. */
{
    XPoint points[2];
    int margin, segmentWidth, maxX;


    if ((menuPtr->menuType != MASTER_MENU) || (GetResource('MDEF', 591) != NULL)) {
	return;
    }
    
    margin = (fmPtr->ascent + fmPtr->descent)/2;
    points[0].x = x;
    points[0].y = y + height/2;
    points[1].y = points[0].y;
    segmentWidth = 6;
    maxX  = width - 1;


    while (points[0].x < maxX) {
	points[1].x = points[0].x + segmentWidth;
	if (points[1].x > maxX) {
	    points[1].x = maxX;
	}
	Tk_Draw3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 2, 1,
		TK_RELIEF_RAISED);
	points[0].x += 2*segmentWidth;
    }
}

/*
 *----------------------------------------------------------------------







>

|









>






|







3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
    int x,				/* Left edge of entry. */
    int y,				/* Top edge of entry. */
    int width,				/* Width of entry. */
    int height)				/* Height of entry. */
{
    XPoint points[2];
    int margin, segmentWidth, maxX;
    Tk_3DBorder border;

    if ((menuPtr->menuType != MASTER_MENU) || (FixMDEF() != NULL)) {
	return;
    }
    
    margin = (fmPtr->ascent + fmPtr->descent)/2;
    points[0].x = x;
    points[0].y = y + height/2;
    points[1].y = points[0].y;
    segmentWidth = 6;
    maxX  = width - 1;
    border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);

    while (points[0].x < maxX) {
	points[1].x = points[0].x + segmentWidth;
	if (points[1].x > maxX) {
	    points[1].x = maxX;
	}
	Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
		TK_RELIEF_RAISED);
	points[0].x += 2*segmentWidth;
    }
}

/*
 *----------------------------------------------------------------------
3224
3225
3226
3227
3228
3229
3230

3231
3232
3233


3234
3235
3236
3237
3238
3239




3240

3241
3242
3243
3244
3245
3246
3247
3248
3249


3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261




3262

3263
3264
3265
3266




3267
3268
3269
3270


3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
    TkMenu *menuPtr = mePtr->menuPtr;
    Tk_3DBorder bgBorder, activeBorder;
    CONST Tk_FontMetrics *fmPtr;
    Tk_FontMetrics entryMetrics;
    int padY = (menuPtr->menuType == MENUBAR) ? 3 : 0;
    int adjustedY = y + padY;
    int adjustedHeight = height - 2 * padY;


    /*
     * Choose the gc for drawing the foreground part of the entry.


     */

    if ((mePtr->state == tkActiveUid)
	    && !strictMotif) {
	gc = mePtr->activeGC;
	if (gc == NULL) {




	    gc = menuPtr->activeGC;

	}
    } else {
    	TkMenuEntry *cascadeEntryPtr;
    	int parentDisabled = 0;
    	
    	for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
    		cascadeEntryPtr != NULL;
    		cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
    	    if (strcmp(cascadeEntryPtr->name, 


    	    	    Tk_PathName(menuPtr->tkwin)) == 0) {
    	    	if (cascadeEntryPtr->state == tkDisabledUid) {
    	    	    parentDisabled = 1;
    	    	}
    	    	break;
    	    }
    	}

	if (((parentDisabled || (mePtr->state == tkDisabledUid)))
		&& (menuPtr->disabledFg != NULL)) {
	    gc = mePtr->disabledGC;
	    if (gc == NULL) {




		gc = menuPtr->disabledGC;

	    }
	} else {
	    gc = mePtr->textGC;
	    if (gc == NULL) {




		gc = menuPtr->textGC;
	    }
	}
    }


    indicatorGC = mePtr->indicatorGC;
    if (indicatorGC == NULL) {
	indicatorGC = menuPtr->indicatorGC;
    }
	    
    bgBorder = mePtr->border;
    if (bgBorder == NULL) {
	bgBorder = menuPtr->border;
    }
    if (strictMotif) {
	activeBorder = bgBorder;
    } else {
	activeBorder = mePtr->activeBorder;
	if (activeBorder == NULL) {
	    activeBorder = menuPtr->activeBorder;
	}
    }

    if (mePtr->tkfont == NULL) {
	fmPtr = menuMetricsPtr;
    } else {
	tkfont = mePtr->tkfont;
	Tk_GetFontMetrics(tkfont, &entryMetrics);
	fmPtr = &entryMetrics;
    }

    /*
     * Need to draw the entire background, including padding. On Unix,
     * for menubars, we have to draw the rest of the entry taking







>



>
>


|
<


>
>
>
>
|
>








|
>
>
|
|






|
|


>
>
>
>

>




>
>
>
>
|
|
|
|
>
>




|
|
|
|
<



|
|
|
|
|
<
|


|







3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568

3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627

3628
3629
3630
3631
3632
3633
3634
3635

3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
    TkMenu *menuPtr = mePtr->menuPtr;
    Tk_3DBorder bgBorder, activeBorder;
    CONST Tk_FontMetrics *fmPtr;
    Tk_FontMetrics entryMetrics;
    int padY = (menuPtr->menuType == MENUBAR) ? 3 : 0;
    int adjustedY = y + padY;
    int adjustedHeight = height - 2 * padY;
    int state;

    /*
     * Choose the gc for drawing the foreground part of the entry.
     * Under Appearance, we pass a null (appearanceGC) to tell 
     * ourselves not to change whatever color the appearance manager has set.
     */

    if ((mePtr->state == ENTRY_ACTIVE) && !strictMotif) {

	gc = mePtr->activeGC;
	if (gc == NULL) {
	    if ((TkMacHaveAppearance() > 1) && (menuPtr->menuType != TEAROFF_MENU)) {
	        SetThemeTextColor(kThemeSelectedMenuItemTextColor,32,true);
	        gc = appearanceGC;
	    } else {
	        gc = menuPtr->activeGC;
	    }
	}
    } else {
    	TkMenuEntry *cascadeEntryPtr;
    	int parentDisabled = 0;
    	
    	for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
    		cascadeEntryPtr != NULL;
    		cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
    	    char *name = (cascadeEntryPtr->namePtr == NULL) ? ""
    	    	    : Tcl_GetStringFromObj(cascadeEntryPtr->namePtr, NULL);
    	 
    	    if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) {
    	    	if (cascadeEntryPtr->state == ENTRY_DISABLED) {
    	    	    parentDisabled = 1;
    	    	}
    	    	break;
    	    }
    	}

	if (((parentDisabled || (state == ENTRY_DISABLED)))
		&& (menuPtr->disabledFgPtr != NULL)) {
	    gc = mePtr->disabledGC;
	    if (gc == NULL) {
	        if ((TkMacHaveAppearance() > 1) && (mePtr->bitmap == NULL)) {
	            SetThemeTextColor(kThemeDisabledMenuItemTextColor,32,true);
	            gc = appearanceGC;
	        } else {
		gc = menuPtr->disabledGC;
	    }
	    }
	} else {
	    gc = mePtr->textGC;
	    if (gc == NULL) {
	        if ((TkMacHaveAppearance() > 1) && (mePtr->bitmap == NULL)) {
	            SetThemeTextColor(kThemeActiveMenuItemTextColor,32,true);
	            gc = appearanceGC;
	        } else {
		    gc = menuPtr->textGC;
	        }
	    }
        }
    }
    
    indicatorGC = mePtr->indicatorGC;
    if (indicatorGC == NULL) {
	indicatorGC = menuPtr->indicatorGC;
    }

    bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
	    (mePtr->borderPtr == NULL)
	    ? menuPtr->borderPtr : mePtr->borderPtr);

    if (strictMotif) {
	activeBorder = bgBorder;
    } else {
	activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
	    (mePtr->activeBorderPtr == NULL)
	    ? menuPtr->activeBorderPtr : mePtr->activeBorderPtr);
    }


    if (mePtr->fontPtr == NULL) {
	fmPtr = menuMetricsPtr;
    } else {
	tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
	Tk_GetFontMetrics(tkfont, &entryMetrics);
	fmPtr = &entryMetrics;
    }

    /*
     * Need to draw the entire background, including padding. On Unix,
     * for menubars, we have to draw the rest of the entry taking
3314
3315
3316
3317
3318
3319
3320

3321
3322
3323
3324
3325
3326
3327
		adjustedY, width, adjustedHeight);
	DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr,
		activeBorder, x, adjustedY, width, adjustedHeight, drawArrow);
	if (!mePtr->hideMargin) {
	    DrawMenuEntryIndicator(menuPtr, mePtr, d, gc, indicatorGC, tkfont,
		    fmPtr, x, adjustedY, width, adjustedHeight);
	}

    }
}

/*
 *--------------------------------------------------------------
 *
 * TkpComputeStandardMenuGeometry --







>







3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
		adjustedY, width, adjustedHeight);
	DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr,
		activeBorder, x, adjustedY, width, adjustedHeight, drawArrow);
	if (!mePtr->hideMargin) {
	    DrawMenuEntryIndicator(menuPtr, mePtr, d, gc, indicatorGC, tkfont,
		    fmPtr, x, adjustedY, width, adjustedHeight);
	}
    
    }
}

/*
 *--------------------------------------------------------------
 *
 * TkpComputeStandardMenuGeometry --
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360

3361



3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378

3379
3380
3381
3382
3383
3384
3385
3386
3387

3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
 *--------------------------------------------------------------
 */

void
TkpComputeStandardMenuGeometry(
    TkMenu *menuPtr)		/* Structure describing menu. */
{
    Tk_Font tkfont;
    Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
    int x, y, height, modifierWidth, labelWidth, indicatorSpace;
    int windowWidth, windowHeight, accelWidth, maxAccelTextWidth;
    int i, j, lastColumnBreak, maxModifierWidth, maxWidth, nonAccelMargin;
    int maxNonAccelMargin, maxEntryWithAccelWidth, maxEntryWithoutAccelWidth;
    int entryWidth, maxIndicatorSpace;
    TkMenuEntry *mePtr, *columnEntryPtr;
    EntryGeometry *geometryPtr;
    
    if (menuPtr->tkwin == NULL) {
	return;
    }


    x = y = menuPtr->borderWidth;



    indicatorSpace = labelWidth = accelWidth = maxAccelTextWidth = 0;
    windowHeight = windowWidth = maxWidth = lastColumnBreak = 0;
    maxModifierWidth = nonAccelMargin = maxNonAccelMargin = 0;
    maxEntryWithAccelWidth = maxEntryWithoutAccelWidth = 0;
    maxIndicatorSpace = 0;

    /*
     * On the Mac especially, getting font metrics can be quite slow,
     * so we want to do it intelligently. We are going to precalculate
     * them and pass them down to all of the measuring and drawing
     * routines. We will measure the font metrics of the menu once.
     * If an entry does not have its own font set, then we give
     * the geometry/drawing routines the menu's font and metrics.
     * If an entry has its own font, we will measure that font and
     * give all of the geometry/drawing the entry's font and metrics.
     */


    Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics);

    for (i = 0; i < menuPtr->numEntries; i++) {
    	mePtr = menuPtr->entries[i];
    	tkfont = mePtr->tkfont;
    	if (tkfont == NULL) {
    	    tkfont = menuPtr->tkfont;
    	    fmPtr = &menuMetrics;
    	} else {

    	    Tk_GetFontMetrics(tkfont, &entryMetrics);
    	    fmPtr = &entryMetrics;
    	}
    	
	if ((i > 0) && mePtr->columnBreak) {
	    if (maxIndicatorSpace != 0) {
		maxIndicatorSpace += 2;
	    }
	    for (j = lastColumnBreak; j < i; j++) {
	    	columnEntryPtr = menuPtr->entries[j];
	    	geometryPtr =
		        (EntryGeometry *) columnEntryPtr->platformEntryData;
	    	
	    	columnEntryPtr->indicatorSpace = maxIndicatorSpace;
		columnEntryPtr->width = maxIndicatorSpace + maxWidth 
			+ 2 * menuPtr->activeBorderWidth;
		geometryPtr->accelTextWidth = maxAccelTextWidth;
		geometryPtr->modifierWidth = maxModifierWidth;
		columnEntryPtr->x = x;
		columnEntryPtr->entryFlags &= ~ENTRY_LAST_COLUMN;
		if (maxEntryWithoutAccelWidth > maxEntryWithAccelWidth) {
		    geometryPtr->nonAccelMargin = maxEntryWithoutAccelWidth
		    	    - maxEntryWithAccelWidth;
		    if (geometryPtr->nonAccelMargin > maxNonAccelMargin) {
		    	geometryPtr->nonAccelMargin = maxNonAccelMargin;
		    }
		} else {
		    geometryPtr->nonAccelMargin = 0;
		}		
	    }
	    x += maxIndicatorSpace + maxWidth + 2 * menuPtr->borderWidth;
	    windowWidth = x;
	    maxWidth = maxIndicatorSpace = maxAccelTextWidth = 0;
	    maxModifierWidth = maxNonAccelMargin = maxEntryWithAccelWidth = 0;
	    maxEntryWithoutAccelWidth = 0;
	    lastColumnBreak = i;
	    y = menuPtr->borderWidth;
	}

	if (mePtr->type == SEPARATOR_ENTRY) {
	    GetMenuSeparatorGeometry(menuPtr, mePtr, tkfont,
	    	    fmPtr, &entryWidth, &height);
	    mePtr->height = height;
	} else if (mePtr->type == TEAROFF_ENTRY) {
	    GetTearoffEntryGeometry(menuPtr, mePtr, tkfont, 
	    	    fmPtr, &entryWidth, &height);
	    mePtr->height = height;
	} else {
	    
	    /*
	     * For each entry, compute the height required by that
	     * particular entry, plus three widths:  the width of the
	     * label, the width to allow for an indicator to be displayed
	     * to the left of the label (if any), and the width of the
	     * accelerator to be displayed to the right of the label
	     * (if any).  These sizes depend, of course, on the type
	     * of the entry.
	     */
	    
	    GetMenuLabelGeometry(mePtr, tkfont, fmPtr, &labelWidth,
	    	    &height);
	    mePtr->height = height;
	
	    if (mePtr->type == CASCADE_ENTRY) {
	    	GetMenuAccelGeometry(menuPtr, mePtr, tkfont, fmPtr,
	    		&modifierWidth, &accelWidth, &height);
	    	nonAccelMargin = 0;
	    } else if (mePtr->accelLength == 0) {
	    	nonAccelMargin = mePtr->hideMargin ? 0 
	    		: Tk_TextWidth(tkfont, "m", 1);
	    	accelWidth = modifierWidth = 0;
	    } else {
	    	labelWidth += Tk_TextWidth(tkfont, "m", 1);
	    	GetMenuAccelGeometry(menuPtr, mePtr, tkfont,
		    	fmPtr, &modifierWidth, &accelWidth, &height);
	        if (height > mePtr->height) {
	    	    mePtr->height = height;







|





|







>
|
>
>
>

















>
|



<
|
|
|

>















|














|





|











<



















|
|







3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735

3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788

3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
 *--------------------------------------------------------------
 */

void
TkpComputeStandardMenuGeometry(
    TkMenu *menuPtr)		/* Structure describing menu. */
{
    Tk_Font tkfont, menuFont;
    Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
    int x, y, height, modifierWidth, labelWidth, indicatorSpace;
    int windowWidth, windowHeight, accelWidth, maxAccelTextWidth;
    int i, j, lastColumnBreak, maxModifierWidth, maxWidth, nonAccelMargin;
    int maxNonAccelMargin, maxEntryWithAccelWidth, maxEntryWithoutAccelWidth;
    int entryWidth, maxIndicatorSpace, borderWidth, activeBorderWidth;
    TkMenuEntry *mePtr, *columnEntryPtr;
    EntryGeometry *geometryPtr;
    
    if (menuPtr->tkwin == NULL) {
	return;
    }

    Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
    	    &borderWidth);
    Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
    	    &activeBorderWidth);
    x = y = borderWidth;
    indicatorSpace = labelWidth = accelWidth = maxAccelTextWidth = 0;
    windowHeight = windowWidth = maxWidth = lastColumnBreak = 0;
    maxModifierWidth = nonAccelMargin = maxNonAccelMargin = 0;
    maxEntryWithAccelWidth = maxEntryWithoutAccelWidth = 0;
    maxIndicatorSpace = 0;

    /*
     * On the Mac especially, getting font metrics can be quite slow,
     * so we want to do it intelligently. We are going to precalculate
     * them and pass them down to all of the measuring and drawing
     * routines. We will measure the font metrics of the menu once.
     * If an entry does not have its own font set, then we give
     * the geometry/drawing routines the menu's font and metrics.
     * If an entry has its own font, we will measure that font and
     * give all of the geometry/drawing the entry's font and metrics.
     */

    menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
    Tk_GetFontMetrics(menuFont, &menuMetrics);

    for (i = 0; i < menuPtr->numEntries; i++) {
    	mePtr = menuPtr->entries[i];

    	if (mePtr->fontPtr == NULL) {
	    tkfont = menuFont;
	    fmPtr = &menuMetrics;
    	} else {
	    tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
    	    Tk_GetFontMetrics(tkfont, &entryMetrics);
    	    fmPtr = &entryMetrics;
    	}
    	
	if ((i > 0) && mePtr->columnBreak) {
	    if (maxIndicatorSpace != 0) {
		maxIndicatorSpace += 2;
	    }
	    for (j = lastColumnBreak; j < i; j++) {
	    	columnEntryPtr = menuPtr->entries[j];
	    	geometryPtr =
		        (EntryGeometry *) columnEntryPtr->platformEntryData;
	    	
	    	columnEntryPtr->indicatorSpace = maxIndicatorSpace;
		columnEntryPtr->width = maxIndicatorSpace + maxWidth 
			+ 2 * activeBorderWidth;
		geometryPtr->accelTextWidth = maxAccelTextWidth;
		geometryPtr->modifierWidth = maxModifierWidth;
		columnEntryPtr->x = x;
		columnEntryPtr->entryFlags &= ~ENTRY_LAST_COLUMN;
		if (maxEntryWithoutAccelWidth > maxEntryWithAccelWidth) {
		    geometryPtr->nonAccelMargin = maxEntryWithoutAccelWidth
		    	    - maxEntryWithAccelWidth;
		    if (geometryPtr->nonAccelMargin > maxNonAccelMargin) {
		    	geometryPtr->nonAccelMargin = maxNonAccelMargin;
		    }
		} else {
		    geometryPtr->nonAccelMargin = 0;
		}		
	    }
	    x += maxIndicatorSpace + maxWidth + 2 * borderWidth;
	    windowWidth = x;
	    maxWidth = maxIndicatorSpace = maxAccelTextWidth = 0;
	    maxModifierWidth = maxNonAccelMargin = maxEntryWithAccelWidth = 0;
	    maxEntryWithoutAccelWidth = 0;
	    lastColumnBreak = i;
	    y = borderWidth;
	}

	if (mePtr->type == SEPARATOR_ENTRY) {
	    GetMenuSeparatorGeometry(menuPtr, mePtr, tkfont,
	    	    fmPtr, &entryWidth, &height);
	    mePtr->height = height;
	} else if (mePtr->type == TEAROFF_ENTRY) {
	    GetTearoffEntryGeometry(menuPtr, mePtr, tkfont, 
	    	    fmPtr, &entryWidth, &height);
	    mePtr->height = height;
	} else {

	    /*
	     * For each entry, compute the height required by that
	     * particular entry, plus three widths:  the width of the
	     * label, the width to allow for an indicator to be displayed
	     * to the left of the label (if any), and the width of the
	     * accelerator to be displayed to the right of the label
	     * (if any).  These sizes depend, of course, on the type
	     * of the entry.
	     */
	    
	    GetMenuLabelGeometry(mePtr, tkfont, fmPtr, &labelWidth,
	    	    &height);
	    mePtr->height = height;
	
	    if (mePtr->type == CASCADE_ENTRY) {
	    	GetMenuAccelGeometry(menuPtr, mePtr, tkfont, fmPtr,
	    		&modifierWidth, &accelWidth, &height);
	    	nonAccelMargin = 0;
	    } else if (mePtr->accelLength == 0) {
	    	nonAccelMargin = mePtr->hideMargin ? 0
		    : Tk_TextWidth(tkfont, "m", 1);
	    	accelWidth = modifierWidth = 0;
	    } else {
	    	labelWidth += Tk_TextWidth(tkfont, "m", 1);
	    	GetMenuAccelGeometry(menuPtr, mePtr, tkfont,
		    	fmPtr, &modifierWidth, &accelWidth, &height);
	        if (height > mePtr->height) {
	    	    mePtr->height = height;
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
	    	}
	    } else {
	    	if (entryWidth > maxEntryWithoutAccelWidth) {
	    	    maxEntryWithoutAccelWidth = entryWidth;
	    	}
	    }
	    
	    mePtr->height += 2 * menuPtr->activeBorderWidth;
    	}
        mePtr->y = y;
	y += menuPtr->entries[i]->height + menuPtr->borderWidth;
	if (y > windowHeight) {
	    windowHeight = y;
	}
    }

    for (j = lastColumnBreak; j < menuPtr->numEntries; j++) {
    	columnEntryPtr = menuPtr->entries[j];
    	geometryPtr = (EntryGeometry *) columnEntryPtr->platformEntryData;
    	
    	columnEntryPtr->indicatorSpace = maxIndicatorSpace;
	columnEntryPtr->width = maxIndicatorSpace + maxWidth 
		+ 2 * menuPtr->activeBorderWidth;
	geometryPtr->accelTextWidth = maxAccelTextWidth;
	geometryPtr->modifierWidth = maxModifierWidth;
	columnEntryPtr->x = x;
	columnEntryPtr->entryFlags |= ENTRY_LAST_COLUMN;
	if (maxEntryWithoutAccelWidth > maxEntryWithAccelWidth) {
	    geometryPtr->nonAccelMargin = maxEntryWithoutAccelWidth
	    	    - maxEntryWithAccelWidth;
	    if (geometryPtr->nonAccelMargin > maxNonAccelMargin) {
	    	geometryPtr->nonAccelMargin = maxNonAccelMargin;
	    }
	} else {
	    geometryPtr->nonAccelMargin = 0;
	}		
    }
    windowWidth = x + maxIndicatorSpace + maxWidth
	    + 2 * menuPtr->activeBorderWidth + menuPtr->borderWidth;
    windowHeight += menuPtr->borderWidth;
    
    /*
     * The X server doesn't like zero dimensions, so round up to at least
     * 1 (a zero-sized menu should never really occur, anyway).
     */

    if (windowWidth <= 0) {







|


|











|















|
|







3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
	    	}
	    } else {
	    	if (entryWidth > maxEntryWithoutAccelWidth) {
	    	    maxEntryWithoutAccelWidth = entryWidth;
	    	}
	    }
	    
	    mePtr->height += 2 * activeBorderWidth;
    	}
        mePtr->y = y;
	y += menuPtr->entries[i]->height + borderWidth;
	if (y > windowHeight) {
	    windowHeight = y;
	}
    }

    for (j = lastColumnBreak; j < menuPtr->numEntries; j++) {
    	columnEntryPtr = menuPtr->entries[j];
    	geometryPtr = (EntryGeometry *) columnEntryPtr->platformEntryData;
    	
    	columnEntryPtr->indicatorSpace = maxIndicatorSpace;
	columnEntryPtr->width = maxIndicatorSpace + maxWidth 
		+ 2 * activeBorderWidth;
	geometryPtr->accelTextWidth = maxAccelTextWidth;
	geometryPtr->modifierWidth = maxModifierWidth;
	columnEntryPtr->x = x;
	columnEntryPtr->entryFlags |= ENTRY_LAST_COLUMN;
	if (maxEntryWithoutAccelWidth > maxEntryWithAccelWidth) {
	    geometryPtr->nonAccelMargin = maxEntryWithoutAccelWidth
	    	    - maxEntryWithAccelWidth;
	    if (geometryPtr->nonAccelMargin > maxNonAccelMargin) {
	    	geometryPtr->nonAccelMargin = maxNonAccelMargin;
	    }
	} else {
	    geometryPtr->nonAccelMargin = 0;
	}		
    }
    windowWidth = x + maxIndicatorSpace + maxWidth
	    + 2 * activeBorderWidth + borderWidth;
    windowHeight += borderWidth;
    
    /*
     * The X server doesn't like zero dimensions, so round up to at least
     * 1 (a zero-sized menu should never really occur, anyway).
     */

    if (windowWidth <= 0) {
3585
3586
3587
3588
3589
3590
3591

3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624

3625
3626
3627
3628
3629
3630
3631
3632
3633

3634
3635

3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651


3652
3653
3654
3655
3656
3657
3658
    int width,				/* width of entry */
    int height)				/* height of entry */
{
    int baseline;
    int indicatorSpace =  mePtr->indicatorSpace;
    int leftEdge = x + indicatorSpace;
    int imageHeight, imageWidth;

    
    /*
     * Draw label or bitmap or image for entry.
     */

    baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
    if (mePtr->image != NULL) {
    	Tk_SizeOfImage(mePtr->image, &imageWidth, &imageHeight);
    	if ((mePtr->selectImage != NULL)
	    	&& (mePtr->entryFlags & ENTRY_SELECTED)) {
	    Tk_RedrawImage(mePtr->selectImage, 0, 0,
		    imageWidth, imageHeight, d, leftEdge,
	            (int) (y + (mePtr->height - imageHeight)/2));
    	} else {
	    Tk_RedrawImage(mePtr->image, 0, 0, imageWidth,
		    imageHeight, d, leftEdge,
		    (int) (y + (mePtr->height - imageHeight)/2));
    	}
    } else if (mePtr->bitmap != None) {
    	int width, height;

        Tk_SizeOfBitmap(menuPtr->display,
	        mePtr->bitmap, &width, &height);
    	XCopyPlane(menuPtr->display,
	    	mePtr->bitmap, d,
	    	gc, 0, 0, (unsigned) width, (unsigned) height, leftEdge,
	    	(int) (y + (mePtr->height - height)/2), 1);
    } else {
    	if (mePtr->labelLength > 0) {
    	    Str255 itemText;
    	    
    	    GetEntryText(mePtr, itemText);
	    Tk_DrawChars(menuPtr->display, d, gc,

		    tkfont, (char *) itemText + 1, itemText[0],
		    leftEdge, baseline);
/*	    TkpDrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y,
		    width, height);*/
    	}
    }

    if (mePtr->state == tkDisabledUid) {
	if (menuPtr->disabledFg == NULL) {

	    XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
		    (unsigned) width, (unsigned) height);

	} else if ((mePtr->image != NULL) 
		&& (menuPtr->disabledImageGC != None)) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
		    leftEdge,
		    (int) (y + (mePtr->height - imageHeight)/2),
		    (unsigned) imageWidth, (unsigned) imageHeight);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DrawMenuEntryBackground --
 *
 *	This procedure draws the background part of a menu.


 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Commands are output to X to display the menu in its
 *	current mode.







>


















|

|

|
|
<
|



|

|

>
|

<
|



|
|
>
|
|
>















|
>
>







3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968

3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979

3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
    int width,				/* width of entry */
    int height)				/* height of entry */
{
    int baseline;
    int indicatorSpace =  mePtr->indicatorSpace;
    int leftEdge = x + indicatorSpace;
    int imageHeight, imageWidth;
    int state;
    
    /*
     * Draw label or bitmap or image for entry.
     */

    baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
    if (mePtr->image != NULL) {
    	Tk_SizeOfImage(mePtr->image, &imageWidth, &imageHeight);
    	if ((mePtr->selectImage != NULL)
	    	&& (mePtr->entryFlags & ENTRY_SELECTED)) {
	    Tk_RedrawImage(mePtr->selectImage, 0, 0,
		    imageWidth, imageHeight, d, leftEdge,
	            (int) (y + (mePtr->height - imageHeight)/2));
    	} else {
	    Tk_RedrawImage(mePtr->image, 0, 0, imageWidth,
		    imageHeight, d, leftEdge,
		    (int) (y + (mePtr->height - imageHeight)/2));
    	}
    } else if (mePtr->bitmapPtr != NULL) {
    	int width, height;
    	Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
        Tk_SizeOfBitmap(menuPtr->display,
	        bitmap, &width, &height);
    	XCopyPlane(menuPtr->display, bitmap, d, gc, 0, 0, 

    		(unsigned) width, (unsigned) height, leftEdge,
	    	(int) (y + (mePtr->height - height)/2), 1);
    } else {
    	if (mePtr->labelLength > 0) {
    	    Tcl_DString itemTextDString;
    	    
    	    GetEntryText(mePtr, &itemTextDString);
	    Tk_DrawChars(menuPtr->display, d, gc,
		    tkfont, Tcl_DStringValue(&itemTextDString), 
		    Tcl_DStringLength(&itemTextDString),
		    leftEdge, baseline);

	    Tcl_DStringFree(&itemTextDString);
    	}
    }

    if (mePtr->state == ENTRY_DISABLED) {
	if (menuPtr->disabledFgPtr == NULL) {
	    if (!TkMacHaveAppearance()) {
	        XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
		        (unsigned) width, (unsigned) height);
	    }
	} else if ((mePtr->image != NULL) 
		&& (menuPtr->disabledImageGC != None)) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
		    leftEdge,
		    (int) (y + (mePtr->height - imageHeight)/2),
		    (unsigned) imageWidth, (unsigned) imageHeight);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DrawMenuEntryBackground --
 *
 *	This procedure draws the background part of a menu entry.
 *      Under Appearance, we only draw the background if the entry's
 *      border is set, we DO NOT inherit it from the menu...
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Commands are output to X to display the menu in its
 *	current mode.
3668
3669
3670
3671
3672
3673
3674





3675
3676
3677
3678
3679

3680
3681
3682
3683
3684
3685
3686
    Tk_3DBorder activeBorder,		/* Border for active items */
    Tk_3DBorder bgBorder,		/* Border for the background */
    int x,				/* left edge */
    int y,				/* top edge */
    int width,				/* width of rectangle to draw */
    int height)				/* height of rectangle to draw */
{





    if (mePtr->state == tkActiveUid) {
	bgBorder = activeBorder;
    }
    Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder,
    	    x, y, width, height, 0, TK_RELIEF_FLAT);

}

/*
 *----------------------------------------------------------------------
 *
 * GetMenuLabelGeometry --
 *







>
>
>
>
>
|
|
|
|
|
>







4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
    Tk_3DBorder activeBorder,		/* Border for active items */
    Tk_3DBorder bgBorder,		/* Border for the background */
    int x,				/* left edge */
    int y,				/* top edge */
    int width,				/* width of rectangle to draw */
    int height)				/* height of rectangle to draw */
{
    if (!TkMacHaveAppearance()
            || (menuPtr->menuType == TEAROFF_MENU)
            || ((mePtr->state == ENTRY_ACTIVE)
		    && (mePtr->activeBorder != NULL)) 
            || ((mePtr->state != ENTRY_ACTIVE) && (mePtr->border != NULL))) {
        if (mePtr->state == ENTRY_ACTIVE) {
	    bgBorder = activeBorder;
        }
        Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder,
    	        x, y, width, height, 0, TK_RELIEF_FLAT);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * GetMenuLabelGeometry --
 *
3706
3707
3708
3709
3710
3711
3712
3713

3714
3715
3716
3717
3718
3719
3720
3721
3722


3723
3724
3725
3726
3727
3728
3729
3730
    int *heightPtr)			/* The resulting height of the label
					 * portion */
{
    TkMenu *menuPtr = mePtr->menuPtr;
 
    if (mePtr->image != NULL) {
    	Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr);
    } else if (mePtr->bitmap != (Pixmap) NULL) {

    	Tk_SizeOfBitmap(menuPtr->display, mePtr->bitmap, widthPtr, heightPtr);
    } else {
    	*heightPtr = fmPtr->linespace;
    	
    	if (mePtr->label != NULL) {
    	    Str255 itemText;
    	    
    	    GetEntryText(mePtr, itemText);
    	    *widthPtr = Tk_TextWidth(tkfont, (char *) itemText + 1,


		    itemText[0]);
    	} else {
    	    *widthPtr = 0;
    	}
    }
    *heightPtr += 1;
}








|
>
|



|
|

|
|
>
>
|







4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
    int *heightPtr)			/* The resulting height of the label
					 * portion */
{
    TkMenu *menuPtr = mePtr->menuPtr;
 
    if (mePtr->image != NULL) {
    	Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr);
    } else if (mePtr->bitmapPtr != NULL) {
    	Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
    	Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr);
    } else {
    	*heightPtr = fmPtr->linespace;
    	
    	if (mePtr->labelPtr != NULL) {
    	    Tcl_DString itemTextDString;
    	    
    	    GetEntryText(mePtr, &itemTextDString);
    	    *widthPtr = Tk_TextWidth(tkfont, 
    	    	    Tcl_DStringValue(&itemTextDString),
    	    	    Tcl_DStringLength(&itemTextDString));
    	    Tcl_DStringFree(&itemTextDString);
    	} else {
    	    *widthPtr = 0;
    	}
    }
    *heightPtr += 1;
}

3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959


3960

3961



3962


3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
















































 * 	value with a routine descriptor. When the routine descriptor
 * 	is invoked, the globals and everything will be setup, and we
 * 	can do what we need. This will not work from 68K or CFM 68k
 * 	currently, so we will conditional compile this until we
 * 	figure it out. 
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Allcates a hash table.
 *
 *----------------------------------------------------------------------
 */

static void
FixMDEF(void)
{
#ifdef GENERATINGCFM
    Handle MDEFHandle = GetResource('MDEF', 591);
    Handle SICNHandle = GetResource('SICN', SICN_RESOURCE_NUMBER);
    if ((MDEFHandle != NULL) && (SICNHandle != NULL)) {
        MoveHHi(MDEFHandle);
    	HLock(MDEFHandle);


    	menuDefProc = TkNewMenuDefProc(MenuDefProc);

    	memmove((void *) (((long) (*MDEFHandle)) + 0x24), &menuDefProc, 4);



    }


#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TkpMenuInit --
 *
 *	Initializes Mac-specific menu data.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Allcates a hash table.
 *
 *----------------------------------------------------------------------
 */

void
TkpMenuInit(void)
{
    lastMenuID = 256;
    Tcl_InitHashTable(&commandTable, TCL_ONE_WORD_KEYS);
    currentMenuBarOwner = NULL;
    tearoffStruct.menuPtr = NULL;
    currentAppleMenuID = 0;
    currentHelpMenuID = 0;
    currentMenuBarInterp = NULL;
    currentMenuBarName = NULL;
    windowListPtr = NULL;
}























































|


|




|






<
|
>
>
|
>

>
>
>

>
>














|
















|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322

4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
 * 	value with a routine descriptor. When the routine descriptor
 * 	is invoked, the globals and everything will be setup, and we
 * 	can do what we need. This will not work from 68K or CFM 68k
 * 	currently, so we will conditional compile this until we
 * 	figure it out. 
 *
 * Results:
 *	Returns the MDEF handle.
 *
 * Side effects:
 *	The MDEF is read in and massaged.
 *
 *----------------------------------------------------------------------
 */

static Handle
FixMDEF(void)
{
#ifdef GENERATINGCFM
    Handle MDEFHandle = GetResource('MDEF', 591);
    Handle SICNHandle = GetResource('SICN', SICN_RESOURCE_NUMBER);
    if ((MDEFHandle != NULL) && (SICNHandle != NULL)) {

        HLock(MDEFHandle);
    	HLock(SICNHandle);
	if (menuDefProc == NULL) {
    	    menuDefProc = TkNewMenuDefProc(MenuDefProc);
	}
    	memmove((void *) (((long) (*MDEFHandle)) + 0x24), &menuDefProc, 4);
        return MDEFHandle;
    } else {
        return NULL;
    }
#else
    return NULL;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TkpMenuInit --
 *
 *	Initializes Mac-specific menu data.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Allocates a hash table.
 *
 *----------------------------------------------------------------------
 */

void
TkpMenuInit(void)
{
    lastMenuID = 256;
    Tcl_InitHashTable(&commandTable, TCL_ONE_WORD_KEYS);
    currentMenuBarOwner = NULL;
    tearoffStruct.menuPtr = NULL;
    currentAppleMenuID = 0;
    currentHelpMenuID = 0;
    currentMenuBarInterp = NULL;
    currentMenuBarName = NULL;
    windowListPtr = NULL;
    
    /*
     * Get the GC that we will use as the sign to the font
     * routines that they should not muck with the foreground color...
     */
    
    if (TkMacHaveAppearance() > 1) {
        XGCValues tmpValues;
        TkColor *tmpColorPtr;
        
        tmpColorPtr = TkpGetColor(NULL, "systemAppearanceColor");
        tmpValues.foreground = tmpColorPtr->color.pixel;
        tmpValues.background = tmpColorPtr->color.pixel;
        appearanceGC = XCreateGC(NULL, NULL, GCForeground | GCBackground, &tmpValues);
        ckfree((char *) tmpColorPtr);
        
        tkThemeMenuItemDrawingUPP = NewMenuItemDrawingProc(tkThemeMenuItemDrawingProc);				
    }
    FixMDEF();

    
    Tcl_ExternalToUtf(NULL, NULL, "�", -1, 0, NULL, elipsisString,
	    TCL_UTF_MAX + 1, NULL, NULL, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TkpMenuThreadInit --
 *
 *	Does platform-specific initialization of thread-specific
 *      menu state.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TkpMenuThreadInit()
{
    /*
     * Nothing to do.
     */
}

Changes to mac/tkMacMenu.r.

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
/*
 * tkMacMenu.r --
 *
 *	Resources needed by menus.
 *
 *	This file also contains the icons 'SICN' used by the menu code
 *	in menu items.  
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacMenu.r 1.1 97/07/11 18:06:27
 */

#include <Types.r>

/*
 * Icons used in menu items.
 */

resource 'SICN' (128, preload) {
	{	/* array: 7 elements */
		/* [1] */
		$"0000 0000 8000 C000 E000 F000 F800 FC00"
		$"F800 F000 E000 C000 80",
		/* [2] */
		$"0000 0000 0000 0800 1400 2200 4100 8080"
		$"E380 2200 2200 2200 3E",













|








|







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
/*
 * tkMacMenu.r --
 *
 *	Resources needed by menus.
 *
 *	This file also contains the icons 'SICN' used by the menu code
 *	in menu items.  
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacMenu.r,v 1.1.4.1 1998/09/30 02:18:12 stanton Exp $
 */

#include <Types.r>

/*
 * Icons used in menu items.
 */

resource 'SICN' (128, preload, locked) {
	{	/* array: 7 elements */
		/* [1] */
		$"0000 0000 8000 C000 E000 F000 F800 FC00"
		$"F800 F000 E000 C000 80",
		/* [2] */
		$"0000 0000 0000 0800 1400 2200 4100 8080"
		$"E380 2200 2200 2200 3E",

Changes to mac/tkMacMenubutton.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkMacMenubutton.c --
 *
 *	This file implements the Macintosh specific portion of the
 *	menubutton widget.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacMenubutton.c 1.4 97/01/03 13:55:19
 */

#include "tkMenubutton.h"
#include "tkMacInt.h"
#include <Controls.h>

#define kShadowOffset				(3)	/* amount to offset shadow from frame */











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkMacMenubutton.c --
 *
 *	This file implements the Macintosh specific portion of the
 *	menubutton widget.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacMenubutton.c,v 1.1.4.4 1999/02/16 06:00:42 lfb Exp $
 */

#include "tkMenubutton.h"
#include "tkMacInt.h"
#include <Controls.h>

#define kShadowOffset				(3)	/* amount to offset shadow from frame */
106
107
108
109
110
111
112
113
114
115

116
117
118
119
120
121
122
    }

    GetGWorld(&saveWorld, &saveDevice);
    destPort = TkMacGetDrawablePort(Tk_WindowId(tkwin));
    SetGWorld(destPort, NULL);
    macDraw = (MacDrawable *) Tk_WindowId(tkwin);

    if ((mbPtr->state == tkDisabledUid) && (mbPtr->disabledFg != NULL)) {
	gc = mbPtr->disabledGC;
    } else if ((mbPtr->state == tkActiveUid) && !Tk_StrictMotif(mbPtr->tkwin)) {

	gc = mbPtr->activeTextGC;
    } else {
	gc = mbPtr->normalTextGC;
    }
    border = mbPtr->normalBorder;

    /*







|

|
>







106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
    }

    GetGWorld(&saveWorld, &saveDevice);
    destPort = TkMacGetDrawablePort(Tk_WindowId(tkwin));
    SetGWorld(destPort, NULL);
    macDraw = (MacDrawable *) Tk_WindowId(tkwin);

    if ((mbPtr->state == STATE_DISABLED) && (mbPtr->disabledFg != NULL)) {
	gc = mbPtr->disabledGC;
    } else if ((mbPtr->state == STATE_ACTIVE)
	    && !Tk_StrictMotif(mbPtr->tkwin)) {
	gc = mbPtr->activeTextGC;
    } else {
	gc = mbPtr->normalTextGC;
    }
    border = mbPtr->normalBorder;

    /*
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
    }

    /*
     * If the menu button is disabled with a stipple rather than a special
     * foreground color, generate the stippled effect.
     */

    if ((mbPtr->state == tkDisabledUid)
	    && ((mbPtr->disabledFg == NULL) || (mbPtr->image != NULL))) {
	XFillRectangle(mbPtr->display, Tk_WindowId(tkwin), mbPtr->disabledGC,
		mbPtr->inset, mbPtr->inset,
		(unsigned) (Tk_Width(tkwin) - 2*mbPtr->inset),
		(unsigned) (Tk_Height(tkwin) - 2*mbPtr->inset));
    }

    /*
     * Draw the cascade indicator for the menu button on the
     * right side of the window, if desired.







|
|
|
|







159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
    }

    /*
     * If the menu button is disabled with a stipple rather than a special
     * foreground color, generate the stippled effect.
     */

    if (mbPtr->state == STATE_DISABLED && mbPtr->disabledFg != NULL) {
            || (mbPtr->image != NULL))) {
	XFillRectangle(mbPtr->display, Tk_WindowId(tkwin), 
                mbPtr->disabledGC, mbPtr->inset, mbPtr->inset,
		(unsigned) (Tk_Width(tkwin) - 2*mbPtr->inset),
		(unsigned) (Tk_Height(tkwin) - 2*mbPtr->inset));
    }

    /*
     * Draw the cascade indicator for the menu button on the
     * right side of the window, if desired.
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
	FrameRect(&r);

	PenSize(mbPtr->borderWidth - 1, mbPtr->borderWidth - 1);
	MoveTo(r.right, r.top + kShadowOffset);
	LineTo(r.right, r.bottom);
	LineTo(r.left + kShadowOffset, r.bottom);
    }
    
	if (mbPtr->state == tkDisabledUid) {
	}
    
    if (mbPtr->highlightWidth != 0) {
	GC gc;

	if (mbPtr->flags & GOT_FOCUS) {
	    gc = Tk_GCForColor(mbPtr->highlightColorPtr, Tk_WindowId(tkwin));
	} else {







<
<
<







217
218
219
220
221
222
223



224
225
226
227
228
229
230
	FrameRect(&r);

	PenSize(mbPtr->borderWidth - 1, mbPtr->borderWidth - 1);
	MoveTo(r.right, r.top + kShadowOffset);
	LineTo(r.right, r.bottom);
	LineTo(r.left + kShadowOffset, r.bottom);
    }



    
    if (mbPtr->highlightWidth != 0) {
	GC gc;

	if (mbPtr->flags & GOT_FOCUS) {
	    gc = Tk_GCForColor(mbPtr->highlightColorPtr, Tk_WindowId(tkwin));
	} else {

Changes to mac/tkMacMenus.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkMacMenus.c --
 *
 *	These calls set up and manage the menubar for the
 *	Macintosh version of Tk.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacMenus.c 1.38 97/10/31 17:37:03
 */

#include "tcl.h"
#include "tclMacInt.h"
#include "tk.h"
#include "tkInt.h"
#include "tkMacInt.h"











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkMacMenus.c --
 *
 *	These calls set up and manage the menubar for the
 *	Macintosh version of Tk.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacMenus.c,v 1.1.4.2 1998/12/13 08:16:13 lfb Exp $
 */

#include "tcl.h"
#include "tclMacInt.h"
#include "tk.h"
#include "tkInt.h"
#include "tkMacInt.h"
76
77
78
79
80
81
82

83
84
85
86
87
88
89
    int optionKeyPressed)
{
    short theItem = LoWord(mResult);
    short theMenu = HiWord(mResult);
    Str255 name;
    Tk_Window tkwin;
    Window window;


    if (mResult == 0) {
    	TkMacHandleTearoffMenu();
	TkMacClearMenubarActive();
	return;
    }








>







76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
    int optionKeyPressed)
{
    short theItem = LoWord(mResult);
    short theMenu = HiWord(mResult);
    Str255 name;
    Tk_Window tkwin;
    Window window;
    TkDisplay *dispPtr;

    if (mResult == 0) {
    	TkMacHandleTearoffMenu();
	TkMacClearMenubarActive();
	return;
    }

116
117
118
119
120
121
122

123
124
125
126
127
128
129
130
		case kSourceItem:
		    /* TODO: source script */
		    SourceDialog();
		    break;
		case kCloseItem:
		    /* Send close event */
		    window = TkMacGetXWindow(FrontWindow());

		    tkwin = Tk_IdToWindow(tkDisplayList->display, window);
		    TkGenWMDestroyEvent(tkwin);
		    break;
		case kQuitItem:
		    /* Exit */
		    if (optionKeyPressed || gInterp == NULL) {
			Tcl_Exit(0);
		    } else {







>
|







117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
		case kSourceItem:
		    /* TODO: source script */
		    SourceDialog();
		    break;
		case kCloseItem:
		    /* Send close event */
		    window = TkMacGetXWindow(FrontWindow());
		    dispPtr = TkGetDisplayList();
		    tkwin = Tk_IdToWindow(dispPtr->display, window);
		    TkGenWMDestroyEvent(tkwin);
		    break;
		case kQuitItem:
		    /* Exit */
		    if (optionKeyPressed || gInterp == NULL) {
			Tcl_Exit(0);
		    } else {
247
248
249
250
251
252
253

254
255

256
257
258
259
260
261
262
263
GenerateEditEvent(
    int flag)
{
    XVirtualEvent event;
    Point where;
    Tk_Window tkwin;
    Window window;


    window = TkMacGetXWindow(FrontWindow());

    tkwin = Tk_IdToWindow(tkDisplayList->display, window);
    tkwin = (Tk_Window) ((TkWindow *) tkwin)->dispPtr->focusPtr;
    if (tkwin == NULL) {
	return;
    }

    event.type = VirtualEvent;
    event.serial = Tk_Display(tkwin)->request;







>


>
|







249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
GenerateEditEvent(
    int flag)
{
    XVirtualEvent event;
    Point where;
    Tk_Window tkwin;
    Window window;
    TkDisplay *dispPtr;

    window = TkMacGetXWindow(FrontWindow());
    dispPtr = TkGetDisplayList();
    tkwin = Tk_IdToWindow(dispPtr->display, window);
    tkwin = (Tk_Window) ((TkWindow *) tkwin)->dispPtr->focusPtr;
    if (tkwin == NULL) {
	return;
    }

    event.type = VirtualEvent;
    event.serial = Tk_Display(tkwin)->request;

Changes to mac/tkMacPort.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkMacPort.h --
 *
 *	This file is included by all of the Tk C files.  It contains
 *	information that may be configuration-dependent, such as
 *	#includes for system include files and a few other things.
 *
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacPort.h 1.52 97/07/28 11:18:59
 */

#ifndef _TKMACPORT
#define _TKMACPORT

/*
 * Macro to use instead of "void" for arguments that must have












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkMacPort.h --
 *
 *	This file is included by all of the Tk C files.  It contains
 *	information that may be configuration-dependent, such as
 *	#includes for system include files and a few other things.
 *
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacPort.h,v 1.1.4.4 1999/03/10 07:13:49 stanton Exp $
 */

#ifndef _TKMACPORT
#define _TKMACPORT

/*
 * Macro to use instead of "void" for arguments that must have
86
87
88
89
90
91
92
93
94
95
96
97

98
99
100
101
102
103
104
105
106
107
108
#define XNoOp(display) {display->request++;}
#define XUngrabServer(display)
#define XSynchronize(display, bool) {display->request++;}
#define XSync(display, bool) {display->request++;}
#define XVisualIDFromVisual(visual) (visual->visualid)

/*
 * The following functions are not used on the Mac, so we stub it out.
 */

#define TkFreeWindowId(dispPtr,w)
#define TkInitXId(dispPtr)

#define TkpCmapStressed(tkwin,colormap) (0)
#define TkpFreeColor(tkColPtr)
#define TkSetPixmapColormap(p,c) {}
#define Tk_FreeXId(display,xid)
#define TkpSync(display)

/*
 * The following macro returns the pixel value that corresponds to the
 * RGB values in the given XColor structure.
 */








|




>



<







86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101

102
103
104
105
106
107
108
#define XNoOp(display) {display->request++;}
#define XUngrabServer(display)
#define XSynchronize(display, bool) {display->request++;}
#define XSync(display, bool) {display->request++;}
#define XVisualIDFromVisual(visual) (visual->visualid)

/*
 * The following functions are not used on the Mac, so we stub them out.
 */

#define TkFreeWindowId(dispPtr,w)
#define TkInitXId(dispPtr)
#define TkpButtonSetDefaults(specPtr) {}
#define TkpCmapStressed(tkwin,colormap) (0)
#define TkpFreeColor(tkColPtr)
#define TkSetPixmapColormap(p,c) {}

#define TkpSync(display)

/*
 * The following macro returns the pixel value that corresponds to the
 * RGB values in the given XColor structure.
 */

137
138
139
140
141
142
143

144
145
#define CONTROL_FRAME_PIXEL		39
#define WINDOW_BODY_PIXEL		41
#define MENU_ACTIVE_PIXEL		43
#define MENU_ACTIVE_TEXT_PIXEL		45
#define MENU_BACKGROUND_PIXEL		47
#define MENU_DISABLED_PIXEL		49
#define MENU_TEXT_PIXEL			51


#endif /* _TKMACPORT */







>


137
138
139
140
141
142
143
144
145
146
#define CONTROL_FRAME_PIXEL		39
#define WINDOW_BODY_PIXEL		41
#define MENU_ACTIVE_PIXEL		43
#define MENU_ACTIVE_TEXT_PIXEL		45
#define MENU_BACKGROUND_PIXEL		47
#define MENU_DISABLED_PIXEL		49
#define MENU_TEXT_PIXEL			51
#define APPEARANCE_PIXEL		52

#endif /* _TKMACPORT */

Added mac/tkMacProjects.sea.hqx.



















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
(This file must be converted with BinHex 4.0)
:#d&bBfKTGQ8ZFf9K!%&38%aKGA0d)!#3!j4j!!"Cp%[#8dP8)3!$!!#8HA*-BA8
#G`#3!aChG`!0#94VAde%48BZZ8pD"c0i4!FliN)!N!J(1q4%%'!!N"30'`#3"2q
3"%e08(*$9dP&!3#[m-k-XQqlHJ#3"QGr!*!'$*8!!%QD!*!'j0-1!&eeIK1,FUm
c*q,Cl62DCG(0*S6(SS6G9P[lcNXja42kR5AKj'KiDRMQb@kGl0@M66DjVH4j*VP
00Z'566Kj&YRNpT00EVrN0YR2##IELqb6h$j'0Z%AfH6fN@dHi@56r@5625#rh`J
RNdhfK'bfl5L`!&pHPhA&cXj"@S4GIT'YK"mCF2*E`Md!XS(a`(J0+,2,D#S9Cib
&'01@-@EYCkclXib9r*TLeQUk4Vr#`UNHZp2+C'+TM'&Q8R[XU*Z09D6B9)d0$(L
(!`-D$%H,a5rXXFFBZfF!(i9SE2V85#TT490MU%VB-MC0qkjq12YI-%)bKE(T(AZ
l)[80M6@(BQR9#ZeHYje0TY&FYld1[L*LZjR8IMZcec'DVAf@dEkdc9LZV6cfZ,C
bpmCYV8EEPMlfAU-GIjZUUpBclGj[-VENKl1VQPQ[XDf9i,b(r%E'p,q!T2`m@ZX
Z@hhRUJqZ@Ek"rkpG[S(THDk#pKT4&Kqj&IT"GM4dJXj##ii5&#CCA0[3%h06QHa
aBbVTCJpjZV`+k`@CPK1eiNBiP8M(iVCrXibM`Tb-*AXG2dlFEc3FF$1@(aEZGpa
8`YKU(pbIb[6iFAA4U1diKQQjIAl3T[jB['F)`9hVYP)@HZc0GM)I8apc,-Ha%pf
jl##`*CEF@`JC5Qli!q%9+dlP9S5G6'fi-8)Jr%bEiC-*3FcTK##`N!!3K*J0MB2
R3q`c`h91JZL4Y12CS$Eld+QFG9LCAYXefQhAc5HYN@ia)PBkcD-mG[+SPTMM)fe
U-eV6EL`41a5!LPM4eRBMBK1d3JlUlHlqhPilB`MF2Y`1Xh$6JA9h%C@M0S&,*F(
dA2!USm9+p[CEK1pNjPCcGKP%,cYMiI*Xj*T6h&aVe293DD0EU#JKNB491D05EL0
I4GiJ[i6m8[,Pj+H4Rdjq"[P5mQANCj+I4Ek#r&6b#b@'HG!Dj"H4RdmH)Q3"H4,
aA+[-*Rm6q8Vb0j1I3hiZH4+5l"EbYj*IV'M)2Q8))TQa"lL8$[j)ARXL+RZ#Re,
58YcamaNmb1p+M0LT1dUiB[IJSH("49TH[hN#$Sc5"mAG'&Dr"6#4'l!jHmZdE@C
666TMliiG1*p*6GCAYMQ6kNmEUkMHNLC!4%f8FA93%ipeXeTj68h'b84C5kcED%U
N8aRAJ&k+Q*fjide@2*j+*BdYGMc0)Tf'%&[mSNj5"ea9iT48$L0jP%I#j8LJlBC
8jD#D,#LL35@8ejK$DLDR08pUc!"r6P-@Y'4"3dVYk-ZM[0l++cSeTARD!YV3dbE
3HY"p-1K$hUXLHapjk$hB@[,3Ml!`HHK,@*[%!ZXL$ad+3d-BHK4fL$ad+HbMj+&
2BCmN$hd+q`aj6pPmP6cd+ZaTQ4rB$mK$Nm*q4KlD&2BlmY#SX,q5KeC&UT&ID&D
F)4kk&@I3VG#[1,Z$IU#&FABhr8"Eif`,r8!Ai`bY2'KMR0dR1B+chI3$rAc&FMS
DZ3$2N!"cF!Pj48k3!![N!,a!IT&lj!'m43l!4r!(I!8I`6e`$[`#hj!!'h$RV1l
dq*ql!hGkr&m9m,mTi,m9m"p5dq2rNB$rA`Mirkf!rcm+q2rlJ2mRI2jVi)(N[hD
lchpY[FprED[2I`fe4[*I3ciNrl92"2crG-$rV`AmIbEJ2qU)armrq[cAN9r*Iad
aN[pkMFpr(69#mPrI46qb(k*$qD%rJl0(k!Gp'TapQAl3Vm(CXr5$[Jh1INSrD"@
VMUb-5TrSaj43JCZ+RNLY!SPdUJZ$'"SJSaN0('UebVH#i08$qJf48P$,k3-qN!"
9@e[V4Z2VDPBUf`U$9`qSIc#&GmBZ6T%S6kbFk62b3b0['DjpqqV6KPcSD0ULPEP
01k+9kap4(V$!DjRQ5iAkalUk(0I++"jQa2N8,Y2D@PXlmQ'EflDChPQT0e*&rFA
'TTB'ZP'6rhTff[Zd8BXK1j!!pbTdMMdN"qMP!*XIcP[,iKlHe26[mAVjJrG`[16
Pp"[1d,bQjV4'!jDmJ"@''6SDGR63G&M!K()a3GVDrcBTlb'V-md@RXZ5qTE01k*
lBcdB[1TX0m1jXr%#LYLC00E(lhLRd[)+ShBS-plSK(V'5&bAHK1,a9V#0(Va!"k
cpMZ1+a"bS`'j201C+@Ie&6##EdjeZ,@qSGUSVUrVU+0IXbRF8DeDS3#A9[Q*i"*
q0Z@*e02l"JBHa%#5'Xi`d$C,MYa95!di@il8h56(mLVPk0h0XTV-NH0hFqAj,I+
q@qA)h6`j9RHEl%A0Prm,j(d,jIqLl0LI'&5RB`*bFL"EZ@S6[3B9LLRKTL'jkDa
mYK#$`80("CX[fQl['JDQkp*T["1J!-!4LE4X+Yi6['9#Q6ec4m4XQC3!Ph"dKZ[
9!(PYDfmE4[J'$Yl)lqjM8FICa8,22m`U&hmpHd(PXbrL0rqDLeF-RM3rarmc$r%
Cp[a!`,"P(i)ja`i2aiS9UJ!Fja2b1SlcVq,p"mFiN!#V11`$#S"RqML1[RIjLPi
9ac'4$Ir0Rj(%#Kcd6)mL!%Gd2,2&['*H`--a9SQZiTMSQH%9T%YmG9MI@*d@$mN
aAULpd+%k[52F1UPMF%If6DEKh2DNS[dhDK$dKaTJZ!miR,jiGr'Hi+@TF`A%FIX
9!6KJ0855Gr++-6+TZ%IDVqS2a8fC2A2(0F8pJN-CS,KE0cA,eeT'V2!-fQP6I#M
hFeQpTY`RF9a@lT-i,L[h#cKH8qj&(1S&j6kFMlH8qdKLhe$Z44bAPIX`M$H9Ha'
(3N#jfleXY%i$#(qCpl4bra5[dmS2aAf1q0F8pfL&93BSlXjBFXeU!drDRP(Fdrk
VQ!M(H'@iSTJQF9a@1KG`[+CdLMLZ92*K('p@mL+1LD*(1)Mh&j6jM3U6aB%R98F
Yk'b--Se`T,VhM1&SlGicLD-mFRDF3eTC*",'LhB+!,Y81HR&E6$k!SliHFe*11,
dSZ[C4eHcPD((aQZ0+S#mAUm-@8dqSHf[iLK@i!QHCIRKUJ!HfCl1aHeSMCR&ZjJ
2r$0*URG%*EpU1C@Fl@)U!A#%iil$U-43!6Q(Jc3$mXV'qZfmqkJ%b!I['LS"F(K
G`c%F9lZ'I@iLcPi`"Bl1irVpY3rV4qLmXZ+Bh[3EJaejiFGdIN5rlqjMG#@pT9R
eCcSrV&X[cG#E5rJb#Kc((V"S*"mAH5Dl0E(d+&r4V4RTXJJF@21!B3q'klcRh4S
P!&pjYdB*J!-QbKNeErkA9ik$k$(@cEU)ipj8dKkA$&SNBLS!CXhaHZ2Nr2S#pGX
%aCMp@`X0QH*fJL+G(TpD+1C986#*FGh85C-B`@BLCbiT98mSGd@&-P8#9%ke3U@
kD-9R+"3J24f&bcX8BkBJk-@S9pqKZ0U,130%5I#HaEM*pbc'6EheRJ8C(MI%rKr
i,k2R,kPBl2c($FiSbN`*mh5Z)XC8F99!M@0cj5B!`C*EmLhIV2%0Y03caNQLPG$
lalPYZmkDYh85fHJ5Ad2lIbNMmUbDX4$e&dYB`R%,2Fd+fPJTK,M#p%FThDFK,PR
!J3f5PP&FE$#ZR("iq%)[qA%c+8il,2$PiLU`i4,L#&mZ$ZXcXT9Bjia9a"leQDc
YS*pQ%GIp5cU6"8Rl2(QAamekmAY)N!$-"rUTkm4pDl(TNPa2)r3K*%AFpb[XP#L
hH`TKUkNjiMlp56U6Qck9!FGmFGp6f&K*E[e85ANY-m9pUel'45*Z2LdkU*@+Z-k
95)6%mA(kQ5ILlX3c`h)cU""QbkB*I-Fr4QGb5kJb@Kq5c4,hp@#L4Qi-YH!9`MG
9a08H4#lPI9qKRr8L,[3FlTCaImMLQ28+*Y2P9P',)!&q,ZlV`QCEXYDArFhRJ3A
1b'fMbT%ANDH+[Rq"!#,1f%Frc`Km,cp%Ch),U5@8BdhQqm2)Rpa)DLQfjATFa'h
(XK9b1kPbr2-ehPK&'eE'N!#E5LfP$DRd'3,IYl'"P0aDU[Sl4&%Cpm5I`#d4phl
DN!$VMND"BbFkjR+EU5Um#@-NA!Ge,P!(9G[TadbiI2STL+[q"LHr'dH0b0hh4A#
&lN2p#q*ZThUK,dbi[B8kYi2iSpqC5$YdAbjZm5rSCk2C3PX,9Mb#'L3hVDTkbUq
[ZIZU82-S(fR-%J5ibp((PMcilGp4)14pf!LX@r#J!kZIb#8lGQkJI*6a1(B81CB
,EpcI3(KALlM[SbE*6Dl+X85+U(qX"c&bUbX$ZU!X3C0+JcUJ'YYK2CL`KUE*ZQJ
P6Nh8pG"cQ-L5%r+l[N3r(5,Za%p31'3F1Z@2mVL5cFqM%)JiLeEjd'E,1!`3m+f
arJm!N!30#P4V8fKPE'ac,VPD"c0i4!FliN)!N!J(1q4%+'N!N"%@!!"Dj!#3"2q
3"%e08(*$9dP&!3#[`82,XQqlDJ#3"30Q9!#3"NeC!!$G,`#3"TC9"J"Vh1e4RZX
LB3GPj*BMQfbbAIG,Z0h#DQ9qPbGh@c,2[PYC9+B,pGLQlGjE0jjk!1Z&Cq,cB[L
[[,U5hBk64FNQ1lE`K5rQfB4X&`QrcS8r@BlRiNAiC@5ILbjf(PPiEprab'*fh-A
Vl(`A(qk-E,+2l+4!KeIUGCYGRC+&eX+9RdG@XXNQ#q&NGf5iQ2(&`fqb@[CHGCl
FmcZ[kbNI02%kYPNfmVDAjjPeG[3fFl0"AJ1MR(*2lXR25AVeEV*lIS[R,A`!jF[
aS&l2Qm#G!l[iGCCQSlciFQ5A,pc3GYIZ[1akfjG`AeF,fG"1"m@,,-"B!'HVJr,
+3Al[YpR@h!0@(VJ3H**Eq,X!-!M3kH9lRC8pce&+RD&8iJ*eaXMEe4RE2kR8dfG
KEdjd*H"U6j0Ad41@lpZHRmVlhPjG$PZqRT56DGG#N!$%[e'TThj"UDH*2A@$iLf
PhU*@4IIl9I["[9'943pP[[[HhT0'(9I&"'5EA-Lrh%TlcC1&IS&*REhSI@ALkX6
CACF[451Kb0mNZ#+KjZFA(2pK2X'$k6KcjIcbDj9khM`rF8NIUcjVeb1`a@-TpG)
ST1MQNbQqI*DTR"pAAk$12M2RZ9EC1jQ`V,T!26RahUk$VAYI4J1e2r'(LArTqUc
DJ$5mAkR2le*2@8aikXQlmpPd`pG9'q4M9eP`#j!!4ENC6$&TFrr8@3YJBqa(LH2
Nh%5T1,e$@aAYEqkrl1()"[cN&f*2*JTB5mEH(DcPii"*fHc%m"FFaDh`C9HBkD-
2l!B(MGqpE#1YaIp8+B5'4h$4RAmU[5MT)A`+UK3,bDBS5E2I!AZZ60bEZ1Z--aD
aCcrJDrf(81SeS3Q9%@Jj21h(cVCmjV[BZ3XPr3le[qri*QTE%qF0U1fbVL@k&'B
V3-hX1R-L4R,#ra#&9#RapiR2R9&Ga0`#BM4%1E$R,'C*E8XA8LTR2IlPBU1b+m6
fCL+@fMi@SB!p[ipr6QarcS5TlArM2dR#Vm2&pQT5LBfi(#ff9P`df`(MRL)fiUi
@feY`18CX(m*PUYMq!bl6a2EIFDQ4%L0(8$0X-h%KGQaRi$*GE-Y`Q5'fkh#T&pY
25BeJqb9FH"rE"h#KlB6Y-lJF+lDr**CU`9-raiX0(qP@'GYmA%i3fh*F6K6EpEL
F*,EAiR+bf0k'br2%pNPFRLqf2m6P"@,l#e`84mUqLFZ,"&$*h5PL1aZA8mAf5Pa
H,$ELISRBL(Zff(i&&m%0Bk1qjiMY2q*bQYLqMXYFBbYRE92,f-JlpBAY(&c1&0Z
PJM2B0Z0#6V#p"KIH`IBQA1D*MIUQAV"p&THALHf[F6RAf#U)1qH*METkZGM`2ep
X+aC`@QcNHi(BL(ZKf0k+Ll+VLMYa@53fm+aCE2m&Pm9LqcBZ&aTE*A(R)V&4-d[
%KXr&BZ[!46XIPA1iY)MY$EL!HpMHLiYLG1Al")HaJD0YBRX-&qSAb!8V`5jXi!*
iJSdmNR0XPq1b8Qc8($@)lACF9SQ0h+m@fdG`Z8aXRm1&pl&*TcAe5mCQi2e+XB'
cDm3'6PdP0QUqA@c8c09L)`CU!GY@A+i4fkYa@5XfFV01E1"ZTpJHa19DXIfQF"0
XB0)'XAd&PbkaI4-Am"`D!YqJpV'"hI6FXB&pQm3',P!Mf+JCTEe9c"Hj`VB0Pa[
%GJFZf,'4Tfka[4-AjBa9a,$YB[YGA'i8faGaZ8PXi+M5Z8RNBq!$0QVV9@)$Pj9
46L,Z8#rBU-1I%"[q2bQfeq-#Im(f2Pb8P8qk'jGEaIBPA(jDE1!+H#MR+1)CA!!
E(1-fXB'$e#BfX10Ra%EY83[Bb2@GB[YAZ0`P0QVhEV(p(LliBS-crDba(8fZGSr
Bi$mr*cD`qqI&4LhH+cCUi(9LSrlqYGJqM-X[L1f2FD%@X-%E`&XjNmP,Ie&XB#I
[B`-l6H01E'$9I@+MaYiS0VJ[2!AE*h$"MZe2F)'IBS2[JUYbTT!!IriEXB%hF$T
Xm!4i&MC`lHeLS`lI)6Em`40Xm,phLBeBlaIE0h"jYl&9Npqq4fa`X&m9'hMfJ0M
!*ZS4'r8$lm$f%#jJ"EBr`!8l0ZT'qJHFBeJh[bBfZ#9F'"Xmjf'aJHNI&"ZimiM
BU"2`%"XFLcV&"Xq!Gf$l&LiI0EDTj14`6fa`3Yl%"SIjGE'"Qp3J0QUH'X&'6Rp
$E*r'j9'aI3dAZ)1FDHaPr*EBi1GJ)cCikDI%"YH#Lf'$9raEXC(Aha%EQ!+fBk-
f`$GX[%AXf'5Q*r9RBU0Hk4[)U5'(qrGLJcI$0l("NqPTB)-V`Rqa`C'S6@aJ,Ad
!E'!L2!JEG8j0B50hIb5f2m8&2-3'0rUmXG@5Zhp"E23b`"CXm(Pi#MEUQrHaJF(
N%aYmicq*$Ccpcf+MYZ(,f-J&("BE[CRrDQael2[!3E$4XrLbf1$Yp$5``4[KG0M
)phm6'rcNUf)$FkPVE03rR!)E1IdVXIdp,X3ZCcVl-IqIf-!9m!dEI"@HL`d1"Lr
$"Mrj(f)$0rp'E06Yra3EmI`[Bj["hXrILJeZ3EeMJlG4GpM!Hl!1'c9%2`%E21(
[a!CQ`51`89G`0'c%maeMUbIHNeYXp"lSrf#$FfZ[Yajik9TqpH#aVJGC$l`-T2p
A$e`1T2pA$h`*T2pAMh`&d[pV32mVN!$qA`2k,)(draV3)`LNrpF!A!bNrpH!ZJb
NrpF!(!qNrpF!A$-6@ck@)j8dhP%q(fG"2Jr-Tqr*Rpl9DZ%[AS-6-(+e&@B4E)G
6qY'QAA`5,p+f02I`r'L'CR3qCQ+84C!!U3lr@IMAiRrX%k-5d630k*Ff8&G'q+Z
,qYiqJ*N%$mLTE)mlrG0T,`@K&9ffa69-VEU4'%@IRH-BHbDfk-5G3S#3!2r*VFN
D6LrJ(EmbdV%,fa+iYI0XC6qBqpL9kX*lMCcNQ,,6QV%bMK8%1NJIX+A('Cl,XrR
8cS(RXbm+eqXirSC[jVL+i6mPTd2Ifkrpk5$&3QXX2(-mG@'LjpBE%ch9EE[(8Z-
lTY4jU3*[#pHGHkP+l%,Rki4l9Tql8p95Zdhh2eqf#p(9DF,%5K1kLNhSU#a#9h%
4ZT!!Lp$K@36@hiaTJfD!3c-kEiXa0E%BACm,d8@k%'pFK2Y&k"aHK%l(%R3GPk$
lZJ4GNS[4hESBAHL,dHQl'*fN5p$Y[36[YB$qY+"chS,ZB3[m@M&KdGSmRP-C8T!
!bBfPb%NETNhDd%&T3qHb$Gf59b)IVd4AiCAS)#a$Pf8C`(8Cr*DM5l%FhDS9Q1j
CJFQ"&HLHV8!RCb8kP#[4E9f*cY'PL2p56#4FLNle+X5e#The9HJJV3B1VdE19U-
6ZaTaABCmABC1d'AS@Pi'rm[4pEJFhIc,`CD[`'6+&HK+Ai%1d*@BRVJ5hI!VdE&
EJaTD!hDp"KhP0HM@AB8mA)8Zde@SJACdSGV4e@j(,&FMPU[4bHX!R(HJDpq"A(D
Jdh)0f2Jek%aIJfl9@R3+eb+ZYHJdVN11ek'M[!jGZ%jJGbFkLTfB81K%"lF6RCY
V-Eeb,HVl@Vbl(M@`(ThapHLdV%IAD!1QQ$DJhV[34HP#EAE"lcT-)9f([&b(MZ$
eU+[V%G[ek#"Z42ifS[1l%E@d#Aap%bB30U%cYaPGqmhS['j'4hB,Q1X@6**X36G
X#r+r&ChlVFMh9R4+Y`)$EX!%e3fS[4[3jGb'$Xdfe03fG*!!Yk(ce)dmG+1$hid
1A!rmHS!(fe&,fp(Phii1lhE8kShSr0k)VY+0U0FEd@@l#9Kd%qVP*Y6,cCK8Z"P
GbTZ"2c[3*GU"qYJ"[eIKM9HaS`L61$!5Z1Yi)1KNL8kC3fpX%KYRTLeaL&mGDTp
i!&SHb8&P!SCVHRid$XeJNj[kBiTT#9iSIj)m6#[BM#Qj&qK2QaNQECJ`lf"LJF+
d`D&Li@Qkk@CLb6h0b*)C9A)1c1ZB'5AMm#0fIDL%iM*`iqcUj2jbl(Le"T@I3mC
JfN94iRJ)!!$HD)CUYm!-+*l#4q62J"S$%%*2UN"E6!m8qjYPP2)Y%UJG($N%)'%
M+aR#Taq3!%qMk@,6[DCV6EHD(J06PNaA-P9*4ZM+Nc5QJ%!&ZVCdrJQ,2L$*TIY
2KjcT*,Up6"iaM81H+3)3J-id%jC-F6"4b65LQ`CPNY))GfJ4-8&!X8KKd8QQJdc
Rf(5-QD*JdS)*#bBVQ0KJUS(*#LBUQ+4JSS-Z2P-EG2$Tc$0*`33&Na0-6$!T`B3
%d`K-4$!*`33%8`*-2$$T`!5)G2dY&0MZZ1Q+-jA%0"*65%aD-0A%9!$6-d`G-AR
#e"-6#8`f-Bh!0!56)8`C-9e%FiPT)UD)Q"jL'SE*"BUGVMp638cl-#A&*"!63%`
b-2h$e!m6"A6qQ5"JFS!*6UD*Q!bMmmmd$K1H6'SbSFPN*P-96!i`QFId*0-)6'8
`cF68!G0G6)R4C@EkP+NV1"U63dc`-BA#0!c6Q3![Na0-6$#9bE3+8c0-GJ"X6,,
5R'+5J3N'*KHB@)!Z-2RS@),K%dSK$%&3`X&8#!b'k81Q,jN-B9+0#68QcjL+BZS
$X'0Udh%*4b'BF))j3'#BrQ4#MDP'TN1C#Q@kK2kfm(IDZd`e--eJTKLBkQ"LL1N
RTTkBTQ++KUNR*RUBFQ,DLQN5*UUB*'(DL5NRTTX!F5CHQ'*LHSQT*DD9Q&*L1SQ
T&+D4k1)cRF@d#"-F6'i`X8'EN5Nk*SaJ3%`U-L(#K#16LN`S-TR)*#56-8cJ-$h
)T"A6-8cS-CR(G""6H8cM-Fh#p!a6M"!(TKDC9Q4+%GE-K#A6R8c9-*A)Y"[6K%c
B-0'TNjbHJ32ZZ(Tbp82YJkmkp@L`!QbJ&Q*F""2*)EN%Lm&Iq!Hj*(rN(b`'mmJ
V'!KZJGG`%h!(E!#$`#*`#G`$Am!9X!Xm!PI!&2!%r+$fU#Y`$qb'am#6U$2`%K`
'Xad(!02"ER!E[J!h!Y2!+(!FlJ-2!2IK!03Rf!*A!RI!FE!E$JD(JN2!(m!LZ!5
F#%i&6`22`(c`MIS&Pm%qkKLFC()5r!2li3TJ1pJ"C`$Mi@9`!r!EIJ*h!1r"@h!
#6JK@Jp&J,GJ(,XCi#8m!-q%'%'-i"A`%R)-,J5r`4[J$Q!1'`DRJ31!Ar"'H#3q
%6m!M`"l`'ii#"`$li5RJ(*`,RJ!(!b2"3A!0h!3[`9%`'E`%rq#Fm&(i$CJ)YX%
Ii"M`96J42"Jq#Ql#KH%%m',i"(`A6JX1Jm[`1VJa*"%1T"2Yhcf5k5N&Zpj`G+S
iRES!8MJkUIrpXbSEl$$63FHNmV%!-d(4c)mJANQh!VM4b8b1*f!B*P4cm3Y%jAd
jISGQD,k-R3D)IqCiBqE)T!4b1HhAG'TX49*Rp15()qR1CBC'YqmT6pX9bL'Z+U$
p26,$94L+1ML!))aY3J(SLC6*,1IUEfXMrCpimXB"aQCQ4[d#4r!VjUdbD&$LV5%
[K6kAXImT@I!$-04a8)RUSAmUBkr'%Tf)p)Tr"LrXpLr(#b2qAJ6)fcRI&`ke&JA
bNZ%)2mJJ6Q&3@90pD("#1drb+!qE#Y(C#Aq!qTRJjp4&r1bHHRDM86i+SCi)r1c
Yc%K$l-N4&!m#fY(p$4DdYrUc'5*IDNrL`iN2!"kTDkYqPNBIdrTkB0KicEV-f0$
`ZY5kSB(L!+jYf8a4j-4m+3Gi@@8(8cr%UMaQ$f,9MmE4T(0a)[l9q+Ia,mFrLhm
YrRAi0q!r(ImCq0IM2a2r@IJILrpaq"q2Iq1hCp0$pMHjVD(``ePbqlkC)$X'rkR
i6m1r$[rTq-r![alr"R)Fq62H,S3Xp92i6m'r'[mUr#G&HTE#JV+XZ-EqY)M*M95
8hi%&@IhBK#*)kSl([aTr&#,+mDr([`(rQIM2`[pBr)r$r`5Q@Ikeq0IK2`2rkDe
jc@-@jc@E4R)2LH(ZR0Id)l60qN32Z)%UBZTiV)Gb$AMLE[qeD$AXlF&)R(3Mj*r
"(%QK5p%V4@*m5)V25B`JXfh6PMk9h'rjVZh@5T0f'+KNaYG@U!IYX'ie90,AqjU
fVbX&qi"@bESAK!@l0Q6Al&!PKh5!91`SP#d([LZQ5pYeq(`lD&U15QChjkaD[K$
k#%c#VICecFCV1i"9@l8IcURZi[4%2HY@MqGdRHUZk%BiP3ppe6eL1mii4I+ckCS
1be-@I-khA-rYhE4425fGQE*FT3HYmR60pjTZCF*f+plqM1Gi[PUE,Nih#MSd2Uh
DE3lLpFbfM9ZfU#4mF@hGCG9ep&*lcT[4icT!TZf$TMj19dR,V6NkkilM,RQ@&TR
N39iJ1j,R*UrHN!!mCr4X`f'fZmZqjcJ$jG$fA'4mV9UG(Uj2iXfQ+9fHMMbbaE*
6bPQfUhifA5U92AF'CG&HpEekbGAl(G[935[2Cd3j1bI+"lBcYr4!S'mcZ!I[Y,*
1HkDhDkq1-YU4,L-$fBERc"@X'Dfk`lN'NRHYTlThZrDqTXi1SC*k['B$GCL2m%b
ebY(98+fD'kY@SfMR4G'+Rd4l@P3I6CBlN`F!5(+l'Q'QAN(f0pAb8elSMILD053
jAP+hDRV)$KU1a9SR&c2`GUY9cMMDmPQ$eeJq+d0b8dh(kc@GY1+U!5%8j$V8iCD
QAdEq0%0R4IRJGLBaDl-AfY@j)4eDGU3!kA%I4R)keY%a9@%l0A)AkQ(l00eTdCE
YIbij46*aU([ZNCNemQ6-5VMcIcZVFCp@$8jbdBm`48'2QIRb8F@Af-%S[XL6G3X
k,SRLLcJb$adU[X42$bUqb*-0#l%8&&rm)'*c6dmJa5PRVYpe3+P4TmV2r,TM'-c
ZZi*LpYqa'@V5UI+lfA@1Ql2RS'IJG&M3A&"96U1"i&3jd@039AkMBq#dk0#a8&9
qSl'LU[a'[d99qBd1LkVb'`d3TmT26P@9hf`!S+Vm!HIp9C8rS%D"U[)(e&Y39Ik
!%+@Ur!'e)9592q!X[kVb"qcRk'433*DLU[`"G4T8P6qJ2S5UmJI8@P"9rS#D(DV
+(e!V4PAj!fU5U#Tr`,bU+Rp!M409j6FE"UJUIjVje6'D01rDp8j6Nd&*6*VBUDV
mDHC29IR6c*qUmKZ@TDVmD@S5U#TrQYS$UXUITKk'$P+NU4qKU[aTDT'S+RqDZMQ
UbTqQhSfUmUHTKD+Ur'RU!DQ'3CTj99Aq-Z+&U[+AX3j9PEq-19*9rM+qUkVmCDa
,9H8[Sqk#U[+A8BG"9IR,U1@J$+U-HKQUbPp',3P&`M,b1&AP,k0HMkTDP9'h4PA
jbkMaSkVmCG4489Aq$2&19INca"G9jFq`YP@92m0D8PAq$(1R)aLC"BdDE1KqU#U
rfC!!3&Aj-`XD)GM3'e&9rJ`e+9592d20%PAPce!R3eAj-p448&Aq$(@+9*AIE&5
JU[`CDVQS+Rq'H+1Ur"RQ@&AjcDB&UXTI6Za69IjbiS+UmTFclkV+Adl0#p9b+5I
fUbTr1I8d9*@rR$SPUXTI6Sd59H8[TdD,U[+A8iG*9IR,UEQNU[cPV%Y9j5qRVT5
UmTF[D0T!6m!59H@[)0DV+Rm&F9C9q5Z)JkV+Ad&X8PAq#Z+)U[*AX%Ce(,1#Z9C
@9F&i9*@rBN(R"KXD*UV+Am&m+aqXS(D-U[+Ec3p8PEq#pDUUr"A8P&)DAd'Y+G@
RUD"qP+Vb9e#M5$XL&G4R8PAq5R)c9H@[*'p49Ij+mKC9jDpN[V9l8NP-9&Aq5Q+
%U[*AXQC8PEq5r%a9qFh@#+V+AdN0&PAPVb5289Aq5[)c9H@[T(kAU[*A8U0+9IN
VLIfUbPp*(5*9jFq5qkNUIjBm5PAjXm4l9HA2%QG9P6p,V&&9rLcV6eAjXiaI9IQ
ca(Y9jFp5'dC9qE2-QDVbCiNaUXUIT6DAU[*RfH049IiXkda9qE28Q9*9rK`a4PA
jFm3B9HA2NCZT+Rq1r%G9qA2N'kV+Rb0fUbTrMVP89IiFF8G9qA1XIeAPcl(f9*8
rajbU+Rq1EkNUIijD1DV+Rk21NDVbQmd99*8r4idb9HA28Ap-9IPce*G59AkcaB+
UmZGBSkV+Ad81VkVm9H6-UXTI4CkTU[a9a%j9jDmLEe&9rLVb"eAPVb+HULUrYq(
ic)B`mU@mGfaE$Ub(B@dk$@&A8KcbXT1$AFRB)HP+bY-`Vp'ZT,b3!"HQh+Y$+5r
"JXa64ST0()k6Tp1)F#c3f'&[S")%&2'(EGRK![$-MEYllkDKr"Pl+HbDfKSTiAr
dI'U9KF(TqAiPJ85KT0qYk3HkrlkBqE&GKiiQdbe1TTRUKK3a[8&(RHN91SKde95
*f*!!JeJKQ8N@0pRL*cKS5rai+LYf-24IM02CQT!!qiqRXQ)(djB`qKADjT!!SX&
Jr)%BdcjhVp%r0hecj`"DQBBjZL!F1ZDQpYd,Y-T0Le`eSbP)-qS%)TKHZ(ZDCVK
TJVZRkB+ElVGaH*bqq34fZFVq"c2`VCaR*QIhe(#LEHCpN[i`mKkY9K"#"#)cfr!
Jr)%JaB)U()bd3p[J@%1l3b1&1EHXNP$+@0"S1+0f(F)I)R#"A-BLN!$Cc6V6p!0
)E@6cMKGQ)@-K[Qf$1r$HBST1Q0FcJHe#XQ'E$TZqUbY&#&+)M--jrFGcQYR@e`Y
a#`Q[cI)$2H$AC[M@()TIc1Z(')H)Bl4!U@)*e#pZaMXTTj6hGD"pb%Q)9X"'Vca
GUVU"@PfhCR0HaDlDfTq`+q%8mY,NZ9@le[6eB$--N5Q%+GUTDY%4$2R@IQ[5d4R
2mbX3hT!!eaI1KC6Jk(DJSQ'%5*TbSj!!-1Pd9AF@6fiFVlQ4,!E5&PDpBmAdm)a
f)D)KZ6AjQN2jM00kSpXm#RI-lHhPE9j2P&-N0ZEe`fqjAB&m"[@hb#L*52QdD,H
'V*QUE%Di)S0L-Vc9#M2315(+ZCF`QR2k,d%HPNH+)bUYSD)MC!$"M,QpI9%HX*e
f#E-aVrpLb,GBPBjQ&k)KU56MDl@JVh*KGN5Y,@6(GZp"&VBhLRT@p&05bG%Fj$N
NdNZKcT&+MS-E,)*8c!SE!LT(P8T34@QRf%KAK3JKBM+#-'M+Y+1NN!!D%F'5,GP
3ee8h#Rk9U60%4jSVN!"9L4"&T@HbNj2HE*6(DYD!*'2Tj&i%[Yf"&!`H4R3N9Gc
F2hf$'64I-DfS5j@#mdXaFpjL6rU@Eb09bqG3YjX@(Cbk5,F+@Em#E8YF1i4b5Xp
d%D)faL"qHG[bI8h,ec"*D#p"`,-GHe)9Tf'k*$,*@dX,N@A"VN*fa,TJNlfK[h*
K*Xd(*'ajS'F+Gc%hYVb0SiR6BQKhfMIQeFIX,PYLPaRk-0N5lbD)Vk3QY-9XEej
+1BN5I8qA+'I5*fGA8&C,A'$pY9CC,bBSPC[)M!0GT+40HNKRBbDpm,b4e@Qcbp2
DEb@[G@Ki"*RTRQSR4K"j,94aZKaE9e*#)8eT0T*%G*8Y3T3Vdq93p*&R`Y4&dPU
c'q@SR%9TE(B`j6#9HC1%%QHUG8+XqF4%X8TqmLAIH(i+&Gc)06a6$iTichr33B*
Tc0BERKrLd8Y8,MqaC&jS1BlRZ8MaaJB5d*MCN!"C[pimY#U9Y`)))aRV-Re!jBG
(PTk1)c8kV&'NBJqM8D0'JeAq#i+kfT-C'fQ&C2c##$((%6VeKINYhEE@`LMU1Sp
(l3YiK*m"ra#kc%XJJ,0USF8Za@,XKEXN[1Mj4D1M5biZj*jT-+TZca(%c82$l$X
!!,%91,6f(@VV%Z4"#K*("pUm+2EP%GMK+FA!S`C5*2k5Xe9hXrlUiKklrSD&E""
Nb!C-M)QR5i[eG2'&@'D$l(@0)hHH[3Qc$qA0'NBHKf-)X,i[1PDY'U-Vc4K%VDY
&h(b%I6@a-e@0K3KT"@K$RL83PT!!%h&1+*T"TKL2AEjfSPK2f9NNCfZGSaCKL@+
-bbPIdQKm`9D!%@1KJ+c,YX!(ePb2M)P-9EG1$6CYTk*'E$m)8`9GUj2AccGparN
QS%l(@B!J,ELe6V[L*--@ed0H9(4hkA64'(LaPSM6&Pme49%Sp2!*mi+V(!,V!!I
U0)*GC$ea#'%ZIX@9HH4M!K)dfHRPDMla01bMj**rDH&f5AH8eSAE6E8)-SP+@)G
V5+RPPk)1*[c0&'6M!0kejEpJZ$K-Y`Y,5p@BVlD&B`0,T52Q3Y'&&EEVTEj#+la
NV@'jNGQP!`qPGZQ!bDdBNP`Pd'-k#$"$3q5PA@)Gj1'#Ja'85HhbA+dbc5$dkUR
,p0cqU*QbS!bJl3C6l*N#a"U91S'ZRK$pT'iJQD4$P1+f4PCE6-fcS@m&DNK20QX
elDI-Qd#RBFFASY@&6IT%L*pX3RYX@q5J#F(N&YLeA"8T2)PcQjKPbeed"EZPLP)
Ma6bbXeNl+MZH'QZ!CiM8(Xcm9HfA5EJ,(PX5I&30Q)6`fVXQ`4*M$6%U&r8i,68
+"ErYd+F,bf*Z&'`MSZhd69ILp(EDcNJ09#Sf[B4jNbmKTBjPd*KDk&AQ$0[`2"f
rh(LXcdb")+F55hTbq5E($dkS0cIP'r%!mkllTL,YY,E")&9)mJC8JmHK$YeiUpY
%@"IElYh6@"a8k8HhrXeehQ%)X+Ve$XTfiEPem4fcRG9hhf(#l+M@1l+bF*,(m"d
Q4DHdhSQfdqjpKqR5kXil6+FHdhQ(5GDARFK2C'"UpB,11dbf,Zbm`i4XdiPkM0j
KJMAEHBITe-V11fLU,@Ur-cKmU9YR0AIH34YSI5GZ0(8fG0j"XD5Vm`iL)AGhhN%
!j)lf1dNpp[&8HHFIF2B"X2Ih(@'&T9klGr8N%l0qPL0XA)92I@r(1lG(M2G!VIh
*Y4D(2Ae2bLN"9&'D))%J@LDLHV(5TH*)QcfV(5KLE'e13R'JhH%f(kRc5U9+@#V
eE5k9'TLHkE+FNZAlePbT`V9*YTG$caqCLE48V"b*d3l4C8&N0(3j"T'0P!GU,09
QVC*&#&Xm1[cM1ChA4c@3!0-fmREf4QU,R0-(PBq1d(,l5RkTi6Gm4*Y03m*MmDi
Qe#pR$d29BQ-HDKShfpcD3qBB4GQN+pcZ@e8SFkae-,JYXkbXj-&iTSbFESEXLL`
5NTQLrSHSL-b0G%91jqfF[XeBUF4Xrk%D+M9&ViDp5D6&eXNG6GEV+,HLl),(#Qm
!DkDJ'V,13p&dPL#i3RBNS9ChT6Sr1)V+-MZA,!JL&CQe9Z-&8G5R4e&c1kG[#aB
A%4@E9,,+8@df1$&VQ8M1%#j4PCMZr6D%66U$mjLVSkV3$A&k,eCeC6(d6GJkT,X
"0Ba,X5++U0mX3[hek*EkcI+`NQ%#C9a@YM@4ZTkRCm[B88A+FI&iCY1@55Y!j8Y
Kbq6SZH@,HMGa8C9fc0I+6LhRPRrqSYiqDN@)'X8@(qDA-pGGRULC9%054@DN,l,
F#UCF9qEcDR@P@Dr2$8E#+6H*HSh+YD"A3fT6hCb5PJPJ89ECh+`ASbPkdASj(GS
bCPf@Q[3H9)(6`0(4hp3U&0VUU)S+ID$j-N6EQ,-$6Xp(RU,qXSa$Z6UKQrMHh,p
jF9Diec%r*pcVTk(faQm&,JE$91ImC'lLh)`CADQ#a'HaKhRpa-2!rQ$NQRNGKdj
mLc2@LA-bF*ei*[29L@GKZ,VAXAI5ZYHl[jcL'Ha#iJS$f6Yp"iY*4l8,"4,0C*F
F4h)@6@ZAr"MGlR-DU-jiU$[a61E'%mrLm(X"'T**q&K3Ti#"L@F["LDq-3D@(,8
!5RiZeiAiHc'`hcPIYSQcBQ$LBc!`m8J`F#$c#PQ*Ea%$%qF%!a22"!-6caJ$5ii
*RT5mqmXTaX"#iJSBZ00hX*J8!`X&%Q&JbA%NCa%'P[c!`$kRJHU--6$a6$!`m5a
LB!%D%Jb-T*X+%"JlpL*Jl"S$B0&2NepdFfP13Zp&[jfqqAU0I4AlBKF$IE&$JRc
pq9DFLPf,Z"Il*V!A1bDS&c['S&Id5r#Mk,bcJQ,%5c*@!,`qei(k8EK,UL*#Zk,
IF,)LV#Zk!A8PRrjUM)%ZGNa`,RBX`Pb#!JR+)6"8J$IMdBYVaLF'Y,b$TMC[GrQ
cFI9L9qb8,cVMT'KPE!DQM#A"Tb46#LA'TiK)aLQ")Z14B*!!mBM"*qq3!"4bhLY
1Fi`c0J%&J)Pm#NP@5,'*M,!Nlp!AHi3HH6Z`%4U6kSL"`RJN#'%mLY"J5bl""&G
NaJYead+V)*'TkHXQbD$!9X`+p$PHQM[Ue+G&Nl#a*-`q`UjKpMP+Q)P6AjJa'LC
4PVL4"PRbNaKMRli3698PXB@!TN'&$K+0-ID&d5YG9S+kSRq#HNARBZ8Ar3XJ824
1i,2S(#0T[fm#E2d2+-EeZqE&P)Ued#ZZ01$H+lC8SRG&Yk4NLmjap3lilNU9Ur+
Lhlk#,c+S)IrK0-FdSpph6f&'j+2I&4ibi$G8"3Nl+6SR4+ASh-Y'Lqia-Hhh(FT
K6&H,'RFPT#dp80!9+hSAXEEd3!&X5qi*fTDmBlJGF%l+HZ!&VBN"hj'L+%$ZN!"
r(Sckr*eiBUpIJVSPlaKf"jf(%qD!Yq6BKlbP*iV3ZqZ"NA6(i$[J[,G-)rJGm!9
r"aehP81#`#A["),c`S)P*!`p%`J-hBVB&hVfbqhKPk"Gk"E$A-%V+Cb#UeC-`FP
94*69!T39(I0&(6PDm!SG%Y3+h@+ik[AU5i-$U0#M$jP#hb)NP6ahTLd'SB,A8"&
&X&0`!Qpk28Vj6"!QG"XC5ZQ6@BbF3fR%dV48mm+F'IK6kKd9SdUF`kK+mbHPU1)
Z6c'Sf$H-UGM6,i9N@Mh&@)a6'%5qR9Tk[8KLLi%8rF1BqZP[+E`5+5M'edGNm`'
@A!FL$%'K'&V%%r)aK6i$`55`d+pNQ6c3*fZCZ%FDPiRIJ1"P!KhpN5F2p%@HZ%H
4*hi$NFF!dapil0mAGq`GK4fl$84Y%+NrA12B&kGaL`)dpS()LVM8(f6aMEjiLbp
%S4GG"l*3!Urq0*3HkFY$kBNS%5AIJ8b%N!$ARi,3Zbrfd$F+1R3DL0C,Fr*D5"%
6pUkHC+%'2m[aafNKH@'jB,c#L+IPH1LiS0df`Xr+"Fdk+RkAiihMJLc)+(p8q$2
iPq0IJAmPrPRmFrKAiAmdrT2a2`(r+IKAicm9rfRieq"ILhmGrY2aEm"r*[kcm'r
%rd6mG6GEXjX!H`bJYFKH"ZaF`$C[k1@laG*dcc5MJmQ#$HaE`#i&EX-hpKCJ*`(
f$@#A!2B%B!F!GQa&ZapGIV6qpk`aqG3aHc%%V*&NcE'KirEYeE51aZ5I!!4[c++
&hS*bpa!F!8i`X,1pKd*Tp36h$MKjlI)lqHhqG%R1LIdFG!(1LAdIj"e`H-(bRJc
a1fcZZDEc$VMIh0S$B#4Zcm8lHZ*Y"ahrF4X0aKc)E6`)AiSh(B42`BH)@IGhpLD
FJCdCapq8G2,'2ki2+%p6),eV$HV62eaV8"f5Y3BP1+V1j)9eHXdD[5i@pZ8eHr)
k"aEP03[bZPL+$QkcDkrED5eNKpG%'lKYKS*)mf`$LlApZ-Zq4*YRCqYCfH(CahD
J*5cDc),0,0Cm(cCl&N+GL39S*U6"GpaqkFmGFT(&*4hae(,NE(SmA(mC@0"G6F#
VB1[@'L8HZXUaEF!3i8'C`B2jf,C-eX[cYZ'#``26-dh`B*-9cmB4)MbS45mKf,U
i!F9bV$Qac[)ApXMFX69D@h,qS1h'Q3&&K!Hjlq'"Z@fTecehDcjDeU-akjDG*PE
bm),"4)3(9BrMJBbkHmR!S)!(N``H'&'$jFd'Pf5G,i[*qY3D#3i2C"@rc%0iN!"
I4Y@IKJJ4(T3Il5qb[A"(',r@BSciBThJ35['kp$blNleTMHP0mDY)8+%"pAJLj0
@Ra,)Dc$EC6jhVXDIeDAp!('djNB(6lh6ZhMd`'R0Mh+0I4p!(+Xb3r%!H9e@'&q
1m&!F+iEh&0168kSF"&p5LDpGUC)lflYrC@q+E-Q5e`iCr[ae2G(pcIFa$"[(f"U
ib8EA3mI'FHVkZ)!ipLENqh(XA66X"h(X#H4J($,eR0T`B*ZTeiH16-erG9XAl6@
IJ&E#MPZLKik$pN"fHi8QmIdXrPZl0Pb45Ma`Ab4VBH)BdhFDc`Ib#LD1[HA4Zlc
hD&khBL8%6d!FXM2j2qF9h38AafiN1KM(f&5la-&qj(Z1LD0E6Ch%D9f,h!#eFbh
L0$Z6lih8[T%X8Vlcb2VX4PrLQ80#c1V2AS!ic'V9BkGh2I5"dadfB`,Li*JGirr
jY1'[M(YN98[r"q1@c!kqm56M(SR$'m#iP`lZ6*ekThFlqS(Mq@$Z`ePpNVP2a('
!Z8r%FB#jli[MFHBq(XF2Q([`kBrha!!`pk&m2-hF4a*lL,Q2ah'!Z3q&m44c(ip
MM,P2d(BA4lHZrEMZ[4q-QrhT"mk6M(Xi$SiRJ((,"N+Rpk8@P`RU2ER[-bD*B`m
b2-'B*Z)i`(6faI%idaQ2i`NN(iVM+53IMf--p#31XhR51%,-GV#9rqL*1K+M&5*
aE*RFHc)1fDTq)SjFlV%p"E+jA'E(ir!hI,k(H,*l$T@i,`jC&(-X$PPSXVZp4-j
34Dr6eCL!["lQ$(NZI9JY1H6NBmJj9QIjqZL*!pMiC&+dXp!SaNb1ZSm2Z)F64el
lF"HUri4GU#qpZ09pp!,%dH3%J3,%#)!-ab&B6ej6*r[NTQ[S"FL(kICj!H*`hEl
GF4cXpQd)kiikK-e[LH2fHq&p6q*qf1[fp55Z[DDK$L4Z[Z@U3`F60jj$-"'Pi#N
Zr'p*h(cpfX5elm"l'XGeV++4I1b[-qfbG$8HU9Hk,!D)4Z0Jep889i)pA2HQbq)
&U&I6CI%#a-'aF*Ck)UmQ$LQ2e)rUia9BJR82C3KbZA`-`+i%V)Sr6Me5Dq)R*Kq
DaPjjHQd+9f1lMq%`AS!i,YlV9p2i2j0A@+QrBQCapqRR3X86FU(RkL2N3Xr9Ucq
Jifbid'(m!)%[YaZR*h$fjp8rdERQ++Gk0UmQMV%YP2I(-E'0qmciYaQ[hHFJdr%
VcAJG2TkP'DqYM49f1TjA6m'Xf1(M!CN9'`+3!+GQaBD4fKF`+aE[L$0`+Z-RQ,Z
RJTPk!C!!dkq!92[2a#CCrSqHMXG&+@Ihm4$dB[a!5MQ(MfG*+HGJ,fB`%"p",fE
['kUiXqIiYa4haXIr8k[M+ZEr$c!iriD1`"2-DbL1TjRA5%)1-Dra1,`6qJJ(QGG
J)(i"R38E4qG+R4'%D**D8M$kMKq!%CJi["+k$lfET-b)UGXFa0F'!reiS*[&H13
f5DQ0RGXNT5i'Ic1))qq&6A0mFjZNf%hhr(+ET)6cDa9YI2$BckreEUENVpq%m!K
kBAl02cH[P)fGQfI-aGj[3XKQqHa"cfEJh,1hHAID%(6q[3IIp-)Y1@rA8dp1S%k
['1("1HfP),4@G"mp##G3Cf&I,k%&ck`CEr,SGdJQ[5r2cj(b!3!UZJ`-##)8m#"
`@qr!"(+GGmTaV@fr!mA-ReXAhkR!YDlc$M4df[)l`H)l@9bR,qFRISHjl4R,mF4
jK"rAGq)q'YGCbqq8,lic'GGM1[Q"RdrT[)-dF(ARRDQiRRFLMa%16-2ejCehDR!
p[r01,Dj0*r!LHUF1efcRRHQi9REHNAfI8N2YG`B*JRM9ipVFHDF"er@GZ'ILZU(
ccLaFZcV[()[VaNjqMX2e$Heh%X*qkq)ld2Bl6q"&p-i*Z0lGHHG%A1pBaS&m%Z5
GNh$pd+PmKm#9Rj[fTEk$PNJ3FG+bGUpq2#VIfBQd)f5bbc1R(6%YGNilSZBR(Jc
Y#,GVKdp11b+0PB+B'qIc[TbDGCQaSH&eUA9$!m8"A0ZbQH+kZ"9Jm-"JJ#IQ1"5
`DK,*K+r9Q2$4e%Z3!%LXS[E#f$JdKcPr2D0L&kJZH'%U63CTbkfderbK(-Rj1(D
jaH$J(Zi&G[J36pki-R&eiZbZbirKJ4FJbN*!AJmX%"d"B'j#N86H!I-Q&%RN(C4
"*K3ra!ZNR9#XN!"h805B8*L3!(G3e*K3Q*!!Ge$+'&BiLGj"+H1NjAIb5JrLK9,
'X(**p!j+'40+(Z+&8XD#cMXSCCcFb3p+'41+(r)15KN6LKrb$NSC%`SGmJj+'4-
+(I,1mEK1+(6)1bKU[1#88SDmJe,',N@01*k6FGfPU&%k(PDP$*r$1bK3m8`SVF0
1DLReFlGjlmc0clrPEDGLp*UGUD*N&Z2#A1"#crcmpA1aEVK`R25RBPbB"eai!q"
L@D`E,U4")SZiX!kim)K5,cUp[l$Al&`18!J&PbdZA!&Fq1Emr$ZrVF(V96YEd&`
)'mB@&hi5LYfL`[RUjmDkiF*G)![pZ2!m6",-LA&$"5DGd!b8(S1SrhMQ0T%52-$
SN9-2P+Y9Lr1a3F!!(JJr#)j[qq!$1Kk*E4m1el-ABYX(AmhabfRbp*p*q,20"1L
!#)(E!!Dfab`5mi[-RS#[+0%IK6pE6CL0*H3I+C!!H!Z1(i5Gf%4k8-$%Jh0D#pR
K09Nhe,kV`p6`E-1"H0kfriaKL6E2cYDc1VB-*XC1@TfcfZKiYq8c8'2G22dG$*P
TC)UH1eIM[k$4F1)"iQM0MCkHB49KfFCXRFVNC(E`MGEmk%K-3"bV-N2a!(PG9KK
IM["3(#Z'pa66Ne1U(!4I8SQ[ADQ51pYF0AY6C&YS1BlRZDNGfQNXZ!C(AKI0G!9
[[)pKf$M@2KT[kd3UXb'cI[fr9iH,ip6eF3&al%h)pq2)TreIiYJ6b-%iK)UP0Kc
BCZVeS506merGeN9lc5I3+GPaLaVA"p66dEr)EUr`6I(p,2jEZcCFN8SmF&r886G
aE2LrHU8*Bq,B@al%d@B&CFYj*,%fMSiJ,L#1Y5ZC(FmVfQFZMYe)G$#1-DT0ZBi
I%dHhQMU*dj+'"8&G48$YA!G`@UDY*J)H1kXcBkIj%'mXIS`4VI2+c4rRJX4Z#rc
(f-IMFA421C1RhQNE2T99LD1R'4-3"fFfLZ5C[,EKVmcpV2l,PTPl3q`(FjI-$Vl
a*(-ILF-E`0bA$Zim[DjBDhlLG$im(af!iD`qf3'BL10!"f!LMJ-GJ(ea20i"')p
M[!2!d3j!m1Q2pm3!G!#'m[&d"f!NXBFk!10a(1J!$)Aa9!GJ2)ka$S$%-G%%X"f
!cYU2kpll`EM2kTrqYcHHC0c$FA!m!BalPHeZl%[0pQpHCYbjlc-QL@-2-Mc"Q#E
L1-"dpXAa10-CMq-**"q+ibNN(ipM$23N$URlIFamYQ1[S&A8N4LY%)PMbq6HNh%
XRGal1SjFlX3iKjjX,TICm6Mm$Cr[)9k6UF4pF@amP#Y+("ZY)1#@)&Za+%3aZIQ
+AUHV-3&j2F`CmPakM*-IM'-F1FIU,&mI25YPpVdcDDFeBjh%Q-P4pr%"ph$Lb'X
IlN,eRl!,pD8AYlU2AS!iQT`J8)!B!C!!i6J%kmPVkQ5rhA30[3$j-0dq,d!FVYZ
h1ik$hEi0BGe4Kc$T64bhh`[[Ha,h`ekhVbGal680pE,%c@qli0$"a)hR%%a%fhZ
+#rpE%MHrpCl%YHr!HaV(GDbLNAcXVc2YXR3e(UPA@L`'L%EMZ$bE6kRdJC8ipZI
$G&Qm!29UZLaHJ$Ji&Xj56q69a#(PNIT4IEc#FamG)`ebZIarMDMf(45'aUP(DNh
ma14$dpJV(qP0fH0UE2Fa(-B,%-I&HreU'[pRmJSVp9I-2Ziqr9bSH%)Zp&apK&c
SZAVe"mbF'5jd'$p!i-[YaZN*R2ejp8pdVMR+UCl0UiN$6R@i2XC([$`JdpNHS"Q
[hHFJdr%VcAJG2TkP'DqYM49f1TjA(m'dZ-b+(6iHN!"CX5%!H@T@E"LTI3'cBTD
jYfUrYY`8VBbIB1kH#QEU"8"1[`*5l6rMJMXq,m@GhFG$d)[a!bRZ($kH*F@GJlf
B`8#m"-SpHiiUpq`jrLh&RI(arp6UZ)Vjr`--cVqK)r!%maU+ifRQ0C+3!%2-Dc`
1li3q`N(Q04L)Ad"R`FE4Z9*R"#%l4&T5-2U1(i!4Q$Lm%VS22Jj&6iDU[$U+RR2
-K2Db5!A5R1b19r%k-1(rYeq1E-'E$er(ZiHT[cKDVc5DA-(feHYplAVeG5Pk$YI
pJ+*R2dllka8pI3SG!$r3Y2GB"k#NAI4-"m![THKjZ1k2D"N82GprrSI!9NIBlFi
6XpYmpp%,%%HNk$NFai"bB@pAc(30[3$j-0dq,d!FH8A2d6J1G[Z-LPh,e@e&6aN
5@`fl+(UQel``XNpjrqKGADRlMX#%SZGRi2pSeiBcRDieKb+&ae$&EL3IqqXX8[3
FMQ0!dE-hMNM4mpPmQ#k,&k"H6CI&#a!(4pARRXfVLF-UHMiEaa'LMD+R,2YUjR"
hciaj6mq+D5J[EG4@S&1$6GYTcl,l8iiAEX0kFm,0qc0ahC[hqa6`3+jP-A5EpjI
$kS(ChYfXRejZTEhQ$eFi2ar($R8'"rH`(hli%%rHZ$*aGH,XVXZ2&E)A)-S5-[K
QMU`TcqEb&9fQ0)40&fSNF&[[b#peGZFG1MBc@Zp8F#(kJAFBA@Nk%8q8RkQi,QU
r3lS'hTQ'Dh2RR9TFVec16ci*mNiGVQXkldc(YEhe6Z@hhVPem4h4Q8ZpZ2012Dl
C6Pddi&VCH@FQVZXllmc#G82RR@0alHUmFabZ,eKq*kkIih'pZa22#EMHdAkRJ#[
&3aMD%r"Y[q1EhXpqY&i(YMQ*pMA0ah'Nll#Ir9J(B'36jIqr!q#EfZENfESrSQA
BjX66YCpp[-e*qUa[EA2bTDi0GepeI*Z6MehdR@e1MXKdpV223[)c63(be*0@F6l
EE'b`AV[DYq2CYMAJ*"XEH18fZT!!DqES4KFq0ji!(JKIV)fAfr"$m+!Zf[$$$L`
YEcEBHjLr3eX9l3GaDX!3EIL4H3J2T,fecI*Y(D1'#"%HP"Xmk!apElrfTi08)E6
FLZ9A-#!"+ZcBQLZ-TM*E"fdhcJ`G)VjBp6dmi#BXBRkq1HRBj96@,6[05R`BJiM
`)2Xi(SLQibE2M5@$K!J2FNIlLfXKipN4aUqe'#-mQ#jid1VjHJ5#VYfTh[5Qp-D
i085)m'"+21`fJQB&`FB"*`C!ZXAIFIaaf`J+)5`F(me'B8qIpP)3@LYcm4k%%d4
ELrPT$SZIM5d1&bm'Crm)mUkq+`kKDU-9iY)32a#@CMl[bkPCPaNE'PkA@MFd8"c
!Y5fE+Dk,9bN!,``'H'-1Zmqp%4S6R$F*ahXc1lTbhK*Y[TG5EiSffdZTk`3ehUE
1M1kr)[Dhbh[[L$4-8ZS'PBcZlj*Z`2ebIlHmpakjrkV%p`'a2bch$mVp%ENr)2P
j81c[PAMI*rPk52,cISRRek*hj"mN%U[J)YH*1N"B5-rJARbHJ#0e3bUk6bhK*qr
Jq&1RhR((ilh-RArPRE4kdNp#,5YRQ0(MIbN3rm$ac`cmqb2'`rea8Jcq1%%1(mk
T&ElQUf$C4rB*E-ird)ml`NpJBqjZL&RdK"Kp0(MUTqK&aZI(mbXLX%Jq*`3)j4d
F*`30j4dd)&rr%c@#S+(MFei$1GM[4Zr$2@(,kNL+SGPrC,%JfH!0b'Z8Adr1Z*a
rTKkm"-2[hSSb'mR+@,lBqU6MP&bq$qD`[-(&!mmIi(r+iKjrCKf+jFmF6efBk,R
eaN42GG[ZXG6iMLPeAUV!fm*ejekU%V[Z81SCpk`qGkHUTAD2,C9P9eLh'MNV#+&
&QjPYH)&+&XY1DD!+KkCk45AcJf-0l3k0&1EFXNS@G%KKf4DlESF)S6TGR#i0kDV
YkNc6$caIGHFG,mb@24HqEB-lm0lLV&[eSYFcJHhfUD5[`kE[kNTaVU(9UQhprFG
cQYR@epZ$A&aIbPYqS!ImfJcIQY12flcqM5VTk[fMZKTQhBUHa6XTTj6(1XUGrSa
'AV+19jiZ9Ge!VDjEXcQ[BPGYl8rBPA!+H@Rbh+TGDrTkX"Q'b03-CV(*FQHXB-L
hpPZ6MXjiRPm*9$GHAcJABXhPE1"B-cSI)X00Z9%EpE*CG@Iaj-EaQU[@)J+4pTA
!EY4q@*`HRY&Z'1A@j'[1aELGeK[GjQh#E@j[,frcHU+FcSYb+Rl,lBT@DePrL`U
KElXeP%q,GQ[)QUR+CS6,GRCN@2EeDr+D8C4c,f%djr4IJM`X,rZHidaDrN!jY$d
hld2jN!!-R"9&26I+!lE6,Q%fj[9IV**$GY"`V,PK0r6R9*,aY9TKH@TlGN5Y,@6
(GZp"&VBhLRSfa%,2klcp+MQDfkj$4(STeRY1*FHaKqSL+p4&Zkj9XP5UkE!8SVD
l+N5)Db+%DFHe(58P+*0Y)SJPSDkVEK6m+P0R'e(+c4A)C8H)XM"k1G8p1HR04RQ
XCJe)-Q6rCJPmZa1UERSXpM9NYPH3!%P-V-cJ26e0)cQ!hcX,GVhKk1,TV90m*-F
IYl'FIkBAH369XU+219iraCE8NmI(aST,6KAEahG(k-)$Q3Nl)1r+M@4(Kl'JEPV
ZeA+[PhZ$h'Ib,RSZ*iRp@,R2NR[jBR$PCk'jXXN,2GK-A,)JEkfmReem*ddGK*F
@Tp'IZXDhI"XD$#Re&$iNq5ZAHi8mE1ab0hB*U%lZ,N&6j6k0Gi6Ip4l)252qdq8
qJhG4IDpG6%MCkX)F"$%fI5XK4dNL+ZAKV!4Z!K'rSq8q43*b&@%b,RH6+2%hP58
*0!Q5pdd#a$je-3%92cfK,GE$jU0&BC)TEjPB*DB6&YqX@JX0L5e0[kb$e2RS0eq
IbRK3h`K,qcKjh#4)lXjZ5PMZ,M'QmZ6H+1mH,`QYHd$GHHHG#rr+Dcjikj*pi*q
F)aq-D3N4mcZp,cAE[rN%Fkrq2S1632BJc"--EL+1!`aZ)Si$$'jI()mcZ2%iRQ"
H3h%mcEa'%R+)HBh(FB"j$BAa&21DL1-*jM8B5-Lm*R")!(C[4mE'B5B9KJp"b)5
#*3@MlhJ#jUH)Bk1p`P+LMYBSSNNF@bEhRSa$0$chaH%(R1I5ZkF22l`90HV(@N-
eUP9IcU*PIT40#Icp1(N%qk,Hl('EQ[k"5MAiS(HR*QfdPH9ZY*MPEX5JR8Ueh)d
@XpbGHRAQT%Ueq"Z0Ciq"5VAi1G&R)krY-9#TPJ"Ga96pVdUeh'[q@k9DlLI')+K
8brf%YNTeG#U[qI@&b(dkH1bc1fk6d,3kCr@T`362a&`#`jMqR,Q%Y8(3Sa*IZa+
,-+jV2C!!hI%UA[[R%S+[I$Qb"@mqI"h[(UDjK0&kT8(Y#VD[AZpVekXrD5l"*c"
2X1%N6ZXm`9$G4cMG8ii"i&EqVEN%CHiM-K%0m@mU%Ck&$S!I5#9LV!0J&,$m!4d
!rip+a&J(31+BD!,Ne4d1eld(40eK5#AY+A@(8E8e6`$M(Pp0)"GAXCQ!Gf+M!2q
%mViA3$(I))aA3U%qPhYBCm+HE#kAfI%ir!fIlb&HNkR%IA&XI*3V5KbSY-QXfDB
'eS%Z*MGIdH[d%aU(qA`FjJaj,Mh'b3r'-BkFBh@@ViqHdh+5%fI5+6R1b9(hmIh
RI`KXGB6GlM`aZmeh(ld!F4J965[c0ab(8qIEh@mhA8-[3$j-Ymm,%)IVpZf1if#
hckKIYPaYiVMpA[UPpm"HYkqRDmd,)rZ8pirHeC@kl`K--f$p$2`IlGT`TY1ejP"
2+`kMIMQ5MreeTPf@VXBMp8U,CD3lBZ-`kTI)-KkZHp0Pm3,8UqQbH!(Li+KUjE0
j0A&)HHcZ3Zf2idLS43RiL"KK-m(8+fk$'(#U(S6(f%N91S&((i4IEdI`C-5FSGr
QShj"(bi[K&rA8Er1@BJ6DhaPrpMfZjJLaIK*I,(I#cm(1hi5AqaAq8`QCDX2TBD
UbDF`B1ZAr6XQaITGX3Ff&3@[f0Tk,rG"ML#+#M-Reih,kmal,rj0f%3lf2MGak6
Bpclr@GK%NjL6Z3+AFicIBaXBQ29,hiV,dFE[SHFa3CS2DR+1LHm8Y[+*PfXBApA
B63cBqXek#f*8[j2IcTaTrC(,'K2I4qCKQb4aI`+A"[2HPHq#l5MMppY2K`EbSmC
[lMmc0pD[(R%(CjNi[T1&!l9$ASPeK[(laP0KQb,a-FZYGEEUpf"6[IA-2AcEqPh
f+l!GBra14Ed'CaUr$Y4kk[r*Her%j9`6hjHC[fR'VrbLGKaGh"5ka[Lpq%Z)ii[
'la@[KN1Y[!GXfMUSZScaeBPI90mIiXcjG12Am$ZiI-Vi28$X%Xd"JjDI4R`fheA
Mlf&K@,rTe)eqYr(lQ9pQ!"VIDrLSMH0Y(i9YT[%l'r@G6KUr6ckA"@cpIJ*eA'(
mUPlc46JFDrcqp'q8f[J+mpiRL*P5Tjc6'HXYp6"JML)PkKZrJ$Jq8JqM6RcN0rm
0T!DE3SGkjC&IqIYBSr)HZ"[l4AKjfc0J1ej`mGXY[-cp"A1Y8iTPIpYqlkA8EH"
0B)ek9EbmJI9+A2KpXSeRNi%"U@G*h0pUiq8(2m"Be3q1D['bURijE-q6I%4iqG,
IKZhjiKIKjGDEBAZ"m6Y[BaX[lfDrl)Ab(Ma!F@,'2m$f)SRlMpTiZI*ff%iaG'8
+mZ(`XZN&"$,lhNXreF,,UTmKpT!!Iq*MJN$aSilmpL85(cE&SDq3!$I-&V`(paA
RlL!q`4hNR)BkGRKjjXHBHhd2A,0i@C9p"4p5[fAY1(U)rI!X13YHdX,,h(9r4%"
4(K29`3hN''G)rSMIi3'Fi8cMe`MF9EbX'L&28UEB00('bpZ)2@FE[lP[EZ2PZDb
PFicIM$pYi@99N68rcrKGLYT5[+akqD8%-Z[h,["1KjH68A1TjjLk[1H9518IQVa
qJ$M+Qq39h'S8[!`A2`J'[`)X%K`eH"RkT@kr$jF0JTH4h`cQcq&Pj*F'IVXkrXb
I%fM8lr0YIVQ5lB'ALppMlIFHq`hBi)$J+,a4mA,ZPf'MT[$la6DHAIGE,'$PHH#
[iZ9[-PFk162MR@fmI2lV@C!!'SI`!iHA6Em)QdkfC-JV0,kEb$1DM9m(m%Ma-[F
ZmKlY)'H)aiS6,F5)#bAZEl6`-RFEmfT9Ri,cJE-1,qpQE("*`THF1EbF3Hbr@(J
RI&,jjCFr$C[1ce@3!2FS$Y94"d3RPfB3)aARANJ1efVm&J0((9jHH!dFAL(a86q
+PjXBfe,M0j1F@q1BmrZ`DGYP1@VGmFY*`-l8,mKlp)Dd$ZT[K!fm"AGT6'ZHDPL
lbihI'A0Y[0c-Q(9lKG@)@r%bpjF[KF0+ihFQX8ha-RJM!G(kRFJqJ[,,Mj0V#Yj
bEJ$(GALjk6!$Xhi2JQmj[&a$M)'c5-LrpD)fA[lCpI!!%mMV[e[%5qepm0lkAd-
F2bpi'IUPYM)I&`PH4RicPr!bmJ[)Zl3qYK1MVa!riPGqq6lL(2@1(cd$I@mZZH8
DmEZMMCFei!3Tj02J+pc8i4BFTGhic5+IYhKCYBdaU3c$62*4aFXjRb6`D4adDbe
HjYlc0YLdphEQY@fm2*CF3AYlY`-A(9lq$M&5Y@h1CYdU6Ya+EU"MQM0IhXE,,j!
!XeQ0P'!RZ%,0VHDp@ci-$jh%[Bbm6I(bGH`pDHpfjZIEr(,H2YLdMeC2hUYe-i[
BVcfr@Da&aENVb$Y9,qC+i,A$bjGp%!lD[cZ4'+rpQ-GBkcTV-S[iU(%X*aI4[Pl
hP@fmA(X((-!&hU-qY3jQ-rID$DmRTLSIqMLaP4a#%qJhD6rQXkaKl61fShrQq18
FiS6fD1HcjkGi@FYHQ,CN6b,I8(kjPR@J2HEA!$-FAYjl2aaZ0(iI3,p(m6,hlU[
KF*1"Jk2!jaeHIZXEm+#R4(cd#aaHDNq3!22Vk%8&#rfBb+qHY5kiD2!bmM[KrBY
i'IS&,[Mpj&[UBHeS[c1i&,Ed4I9'J2FL[r6(Q0GEmU0"U-lq!h*qH!GjqQYFY-m
D[CGk0hQ4a,H9G46eJ6j+[[USq%9mG`eamphL&q(k5F6)&iYIP0HCa'CE6e2[jRX
kpR3@H`1f,UHqP4K+EdG11IYLQFK[@S+B34m9+!DVVM&q"RI"$HU'IU6'Gbpl#@!
lH%0pDRbrcCc"VBJ2hQMMQlUIH@9X3-lTa(iEhp6DAE$G+[J(6YRiTPh-AX*25pa
ID-Ih&q3'F$(L)dl0hiRX4`SHQR`,VVMmc5*I[%hU"Rc4q$l$R!V2-M`$2QRMQhB
0qbjJ*['"UCUrVa&li%&bjK'r0,i9l+hF+INM[fqU"`rfq9Dbcr5)q%AeI4&aeVd
AeIHjj0aA#mjTMjZAbe((H9iBqJ9AXIITF#,d5chVVaGa,[*l'6RS"B+,NGpTj1L
@*ehb+@)-25k*qra[Y[S+,4[)!qifIJqMAK@r@qki'al5&b+60H!%LYmYIHa9r+b
*lf1IDI'UPRZ*PA"RmN3p@jjab6I)aHPT3&(TGeLqd[+l(i%0MS!Ih-AbSCER%#1
B%B"Z#)BTVfVCaIi([3Mb6Er0mUU@-mNrb#(j$[X3,D2XC9LGYZ"jk(FVVfUjR&b
"RLHi4Gp%mrflj-aJ$[b*AT6&MjE,f#ZN&b(em4$kT-T6@rDba`5ITH6S"9TFDAN
AmHqATHlKGKCA,[NRpUASVm)AkHpE2Yeb1hYDp*VNR%%FX(bkj8TL0cL2(hc#mVp
,(N$YTYM6`!qFdhTk!AZMEc(j[S"FcI+rPQIr#@a[0Ai,`#H8rl8-%#Y9@qj#mNA
,reVZr@2Bk!@"Lb&1Yjar!fcd*55%G[3DPIqeE'F[l1e5Ir!'fiGSZBGe$#lK%[C
e@RB5MiQ&&)%[YJr4dX2H!Ie!H#TmAZYX1V(ZIZ0h&A(Ai@Z%FrA%Y@V`-rK'a*p
@XRIVhJ[pdKTmU&`*lZTX#HG'pKhSDi+lNGrCl%FlRKVjR8Pqi2!imV0(m6Mb1jF
eBI'iGJpV'#iMpI6Upq+C#iaI$hZDlc&qh`6f+"lA[S3c!-b`52kZ3rlU2K2jeAb
G1D&A,qqY`fb+iR'YaCTmd-6G6(jMkllf0YE5H`8r`VjJlIAXUc&l3PlTY9JFVEf
Er@CkHK*D*cL"iR&YJl-(c1-3(lK[mEK@%qIJ'[!fkP,MZ)UF"MiV)EbQh4HXI6e
l+!qEpqD66fZq2dHFJjm5(h-Y&SGU[m!Hfb2'le(N*T-eITpLMr9$aUq#q'(aZ2C
#pX8r,2`-h,9iA*XRYM+E!2l4al*iA(ZBFaM`4$RRFDl'iR(Y*,NSr@(i"lc&iR&
Y(h2$M!Bi!6r@HJV)JCJ9NP5rP[cBiR(YQpLM!CI%lcEJVq*aEIU[i%%Hj&c1@#d
Helk'r4*kb(+Z)2r41VL(Xc&`$3RKGZ44mEMQAiP&m"(b$IC8#5j'1(39FGRKBZL
AIMALbq1LcPEKpdE'lA!ap%X9f@0fZ"MjQ6Dq`mA),m(&b1m+jY(LBR#B-aQ#Kq6
e1qKa+Li''pRRJ*0+2LjYpf8$Mle21)[iI3am3R%aZ*Jp1qCda#m0,U@i'&c"rKb
FL,M"G9Yr`@@XDASJi"!af6S1hNHq!QFNVmcc@$`,$[)pCQdN[M,8ZZ*LF#(R`1K
Ab,QDleTF6%IF"Z`#cr$A1#jNri-j,iRM5[JT,JEVLIAN#RckCJXA!ddHmr[#UjL
RXRJ3I*Jc223m*B5l-,HJZ"MF6Z`hQV"5FQ&r+0M#AM!FA-jYa"f,Lm(PV%Z`QMU
!$ePF$,l)@59QCq5Fa$JX,JBf-4Hq6$f"K4BAJmpbGSij)2cJSeT2(rikE25J*%p
hXTpPF6%B*YpPlN2U!(a5A!cHcGNBH+MiY402,5i'%B6qLBR[G[*XVB-r*TFJ$r,
HeFLIiQ,`,')k'%[qi0YeJSX4$[d'1IhR"4FMr,X'lk5lScK5ej*RJqFXK54j+HX
cIKpK6i(q$2Q'%eXm5lf)h&[QdBMM0H$k,SlAXQlSABM,lHJ9Z6JHCNm+h9lLS)H
RF@cKc!-e+1rG#GaaFAb"K8#249cZ4Mfl11lLHq!cFF$,0BjhN!#Ed6q4phi1m`m
ZMUm6NljLr1j&cpM&F42INck2iHA8KmEa"l3amb@PfJ'HkZ+Bc*NBfb00[`(mbF8
aMcehqT!!FMU)B4T('fF)Q@@6ppk+ZR&aG,%'kFq,bp[!Ue`FGa,,G1qNfmNA0Bj
beJ&p@RR[RH#a,SkPl(q$2q*b2fV1aG()@5aQRD"Tc,9S('pPIi[C"k$*c+PXJLT
-3Q$5&GE6Rp@YBmSpk9HKEa@BZBHbUrMfhaM(Mj,,VM"qpj+6`*'KNr4[IX(ih8@
mJ6Y)("Rd(i29aZmmeSE-@q(h!(L5Lkq(A)*FL9mRDph'PlkI2AVi!MK"MM@q@cJ
,`Db3!2Jpb,P2'epkR[b'hUciI49c8#kq9a06rdj`JPkQjZpfpM$!F2&l2AQQaVH
B-kAdXX6[DqL$Z[`eXkm$Ka@r[m6E,ViQjZE[MCpT1fKm(bI2Sel`)kmf[[5('"m
cVH,h9qaMDA`"HR2DQJh+k0fkq'i%rp!0LS)+X8IMqbAddJ,6XddI)Pr5q,k+rNG
JHVETPb%(VMkq$Q`)61mSI6hkibkq$(Z6fS2k1(&(ijZ2ANaJ1(93*6r8qMJ1[$B
`R#*p"rQSa[GTm2M!c#ZR2m+kXI'PrcrU1$$cbZPI*CCSIAmEXhb"Q9G1hd5FeIL
ZCrlX[(,kSqM6ZIJqKjR2)*TArRm!$3e8DdaTBR*KFQPPFbkjH%3(1q*#!*!)"c[
N4&Cp!*!3$4X!N!MrN!4069"b3eG*43%!Vm&$Y,*[ZfS!N!8#41m!N!Bj*3!!F)m
!N!BhP`EiMZhc,3NRh%f@Xb1,,ZHkkj4GR3[P$L+Fm-b&E1QQ@8GEU-`Mc'YK4hk
4m!92$FrTiCQqEAc5SY`ZX["E[*i[,eN)AhK(EY'ZJ8IiBYUj(1&(q(*kK#mH@FJ
Qbi$Xb2()E4H6m)8XI#%,i5k%4rC&&PjNmI)LQfbbm)8`V2#kfV&Lbj&EMPh,UGX
R`'3K#rQ&E,+3!1-,'5aNX*!!aA@h$[1BH3eXN!"jD5L`J8fLMIcXlHADq4N#l0+
YR6fY3AlR0FZ,jr*mmA*JXmj*6Z+AAAU,%bqcmc*lXhFKbjXCZF91XJH4K5c(&l+
mC!Z!"4"`UpH%H6E+1YVP`Yr&C#eq6jBMLr%,J"2mk55pdPD@YD-SfK4&Y@e4IFI
C8AhR*9(ddSm5mrPD[BETI*ACFR)`c[-dba[cHABiD499V#AP#`el`IFRR0q+STH
G%dAI'Ia(mLZflEaiail,,VViXNX[hVAcGDqMSCkX+PJQ#[eE[NHr!(dF(a0`fpb
&1X2a4,Eq6+-[$eIR'')he'kVEDlIq05p1"9K4fV4mH1$`%H1er6K1LHBI'qi)iT
HIebr#[&(QmpUCYfiP6ecAhR4YZMFfZr8EklXeJ[e4lI@ckppCG0N"-*&lSfL*rC
&jirZfhIZJIQCL9kHA*GZr'YAB2R,Qdam#Mbj-PrdSqA&HPD%5q9HjC,0+6(iSJ1
hMJb9LD3Mh#5kX8bT1Lae+fiLb`IQ'+6`[YfFHqaHRcIS#jX$JTa"#j2,3)!dk0C
kTrkU6AH13+J(2j`,GGYIAAd5L4+HD&QM`4Ml"`MB"SL(qpNcJ-1P'H'R@YhLmU9
SN@p6r35RNTCa%KMdF`MRTYV0p4BJjb*YXVpmdFY(#,&3KBP[i`"De(F"*eh)pc*
KL2KqPe0c0rAG8D+!mhfG-fDq[e'c5mR8dmpmBc$bcEF-SlrjYQ))8[MA-3V0paX
B!mch3Bb"j[XFaL$cr3A'B22p'+2)!*!!1ajL[PNB3mfh"Q1BqCSap"a$q9k-FCE
jASma`Rbh@,rJqb,'522p0FDSi!ZU0miaheL-dHCEJP&X2ZkBqmF([T-(hkXaaTR
[h4MMcIGaM!RQqa,'420p(f15S30p0GPma%maAbA'922Y`CKQ[QX`TT[[G4Jcc(F
c4SRj[SbKF%2lk'0k"bJ!)fDEMcZGBclZZ04mi-GFmc&FQfHqAmHBEllI`eKJ[YX
0Ir!pL('ZqAk)84Cm%H')QLPT(hHpf(`V-+JGh`k-THD$@S!Yq(i63r-PjD1hbXh
h+B`+mrd*"[f#lamaU!Z)SqiUmp(r+mh(rDibhhU-eHB$,k[0pe)-F!EIQc(@QZm
M'1[-p`"'MIRS-m(S2'%dGH%$DfV04mpX-"qed@[ipQ,8QHpDM(Vcr3j'JrPq(f1
6qHl%D$3IGlrCI(q2X5AiBX*Fm!SI1,,0I26HG[04!hf(la+-RHCl"FBZmp&c6$,
`86GBK1p2-EJhI(q(X5riiX,d*[1"@I[04hmH-"peRfmqZ-*"mld'!cc(TcL2QTS
i2V#6hX6h23a`#8S#ElR3I1$[4HDM9U'prA5r&jX2A1'HmG&EPjV[9S`@mpf,)Gb
phfF`Z"rejDZR,cFIR1%+mi%P3SAceD[20ameA'@qhmB3CTm[$J5'ilXIi`AQJiZ
md(c`I("!IIh&BB59paIq[XKmB!Gm"arhqa,cJG0J&ljhBX$lm$%8IlRj(X+Jar(
"4AiYq!V%&9pT2[$b9HD$2e!A2V$eH[24@h!II0c"$HDMIRJI[TX``("mm,$I-Kq
mmdEc`6[T%AcIa3!(m0%(V`fq3[&*HKBI(!RZJ`mq!0I$"rET@C6bJ3Y[0"rhcMh
J)rj0jRX["YL1la-BEc%IZ2j@mhd(ifhQJjZq2IJ'#1IHB6ii(T`D(r`(IS322+!
(mB&0lc)II3@ZiL2AHmc((A!Rq,k'!HEM!erI&h`$aFrIEckik!I-"kk$,IM!e`q
C$``&5r'"%I"%I23$rBJ2r2Z`q6k2J4mIq!II8GmJc4SqDMjimKqD$dckQ2RJ-,H
CMlVKK[M!Y6mb(cd-,mE((A(Rq+MlNqDME[JG2RS1l&,IB0dhZ)%2IJJI`FGpImC
mB1jGjU2@cjU2RVREI-`!Q$rJJlG41cl`jTlJ+a)rKJ[JJfGq`Aa`R[[-"kC6#ck
`!cc(ahh"@I#TTaBqmA&mri6aPH!E)Pi)cZ#MGlpU2MJE2"SIA!8F`!G@JT2ik0Y
[Q)rD`(0mB"A21q`&(le"6p!,p!$c(R!CVXPFKlN3mb#`NAN1FacQ'r3imbCi%jb
02SH2`N2"-hJ%h"2q`4b'Q3qc(QBmc(DBkF#$c*3@EN,rQ'NC@-&XJcN9r8+Id"r
d"GJ+TS+PB#Ki#rD#"f!RQ!PfJ`hJ-lJ!,S'CB#@p"MD#L@!K'!MfJAPJ(4J(YS&
TB$eB!Mq&Ii$jm&$i,I`9MN42`c[K[f!N["1Z#-q%Am)ViC2`5,!-M)%[`K2"8AJ
KI"#H$"H%!i,VF#k`#!`#Hm!&jN6-KjJ,-3pL$J!RKmma"f,q!jF#Vq$2c'LBAB'
am(pi2h-U1$qi"mpK4X@X#0l,E!MmCkl"$)MC$Y`!$X6XKaND1!T1Jph-bm!rF!q
m!qHBJc"EBDE#,)9C$$-BCLR-8*LG-+X"hq(eF$`i+"M2c)&C!c-HjJc-&q#$i$9
c&MJbR)4j#Pb-q3Nc)2!@cX$FK2N6FbGi!Tb#@4-B$%H$mm*eiEK`5,Ja("GZ#kH
&@m1GiE6J-a`@lJTRKA[!8H'QF%ki+*`,lJRRK#r!`H'Cm%YiTI$*cLm@E6ThFHh
l,l[m"bIDUBeHR[k@f@F2)!5T@PTI-0J*[RalL9,32(MYiYSe5EbFj,4%@kE@Y`H
lkk),kLf1pX*BCSJfU"18dSJ(RG!j(25q6T4#R5mF[@2T,Xr'mqfkYPr%qCL(ajM
1FcJ0$%rN5crF1"U[q'[Kh[K)20@1qrfN2h%dYHQMqffGQ@rXRI`K-C@Z0e'D,Zr
jTq5fQFqd%QGK-bRbl2SNAqXhe)(&#pql[h&4EIZpGp@fAhI9JER'rQY@SrrI@*!
!9E(e&9G'YAd3q$%I[q!9Hk19aS%`X*Fq[2Ei1)JrGkIr8B0[,-3pfQVqX@mVU8H
6"PaqKP'4#fX2AA0rlEf[$Bq(EP+F(KB%a6,qTdUI4TV*FBXC+c0fN!"aX4jc-D*
Ka-*BK9%)B`c'CBc1')8a%Q0FaLL+841M%8BDM#`BKc(LBh6&5)`4&5-P4QU-daL
0-"CM0-#BM2%5)c('GSa-'#Y#VaPr-9jNe-9SKE%+Sc5SQ4Qc-4TM[-,)K(%BiaM
','C-`pL&d3`M-M2fCdc'U)9a'L0'aQ@-GaJ0-JCNE-3iMT&QGS6'H)H4&5-EZ!(
M0XDIM0mBd6(+C*6$H)ma$f-m4Mk-%KNc-[jM,-JBND%#(3hITFXC1c+10'-e4Qf
-d"M*Q9&GGS5A(0eeMH(-q)ea(U-ZaPZ-Z4M"Q4'A'C-a8Q1FaJL0d4LM0XC[M1%
Bc6(UBVM#@"C1bJL@%5jM@lJTieh'[Sa$'IdQ4m+-14P[-QKKK*SF#bG([!aDc*L
A%5#MAXDNM(NC#c)+C!`)3qXDkjPa(Z0"4QQ-m-b)fBbAc8M6M$-C4c,f0'0%4SL
-GaRc-ZjPK-YmL,%IifE'ei`hc9McL5pD2C!!rpp2MdRX$V-5md$82[-T0Y(hf*X
4DIRm2$MQKj0`JVqEl8Q,eH$cMiDc!I"6[q@h`8`YLlC1cHfHhYVBZRYbF4+cGQC
UdGlLfP-qp36G2$PZri*NN!!RdZeIL!bpqF0Nk)R2$I"VjqhjEZTVaDScSpUqQck
fZX*GFC*C6T&B2H&Nm,8iQcMhFalJ2*rc)'Fcjr-if8*%2[+'14RiUTVd'q%BCjb
c(bI[5rYc&R!@FJlN(-3jQ,1)F`MR8-jKR+-iLcR(F)lP(-FjRR-#jd615Cb61DG
`6Z@FaMQGF`CR#HG-cPQFXcRRF*CbcZ1FclQ!Fb(RZCaPR)Xi&h-Zi9c+ZBac1@F
jC`9R*HF+cLV1PCbV1&Gc9R1Zi9c,ZBkcK[-mc[@FYC`E1$GbeR(@FcC`EZ*Xj0c
-ZB9c+qFfcZfF1cKhFZlLh-fjTm+4NepV$V163A#JBbH$3-$*#Qd#+cqX-5Xce($
T4%-ppL9TpqCrh'Vbhr8NR1d[R65eY`YmM0ZHA)M6p9NJ"NIKm'C0mE[Z0f[fJ6G
TTlrdJ13-X@aqPN*,58G,PU#I2K+DIrRDqaEACY1P2-j[L1EcT*9eHQNl6CBEJ6f
h4-fie9KFL`ieTV*1*qY'9bIG*%r,')pPPr4DUe'a4V++Y1M%[BQ@H5mVLU`lm&C
Ql5b[R*IPrC(h80TEbZ*mH4#`)ShEf8VP[65qIZ"EQA@,J@rel254T&[d"rlUEPV
&VNeZH+ULQU5lIX+hpkQl)5*4KYVNja@r-9P*KiRU@RPlUEUhZU4E&9Lh[R4pfPh
1VUrUD#cG05Y9ZXE1`,0jS9KI8U)V@qS+l@N+YhcP5NY@FbGH5H5iV%MECGV%c6G
ddieGS@jFGDfiV8a(eLbS2&mj%Ka(XP"a"6FKMN4rHXeC'AH261BUfr(Y#9H)Uf+
3!!jRG5Gd"EjeD6F8ME-fDpm`G,VCkj10F'8i'`BALC2HF*bTeUrX,&[f"&K8CYh
V8U[lF,HIf9el!&,9,I*3IP@H$f)!"QQEIGED+p0f`RN%`0,Z5q01U'A99$$hCae
H46QPV%T#qP9j['51jR"(eGDCH-k[qN2j9XhX'EKUjjZ9kf"@C!0RSJI@TIeL+GX
`2'LZm%AeKBY85BH,J4R`fYr[$qjMIDmB3&9Yh&S,MN0a+d6ACQPhF2FEf95jrNJ
FlX)&%)9ZKp[YT6JNU8[DT0'Z4#2MU&M-Nj!!$qq+Y"mk!+IE'pTldA)5VKK[6Cb
(+m&C(iH@aTI!J[VF'Mh4*T[5rVVGNS1QbR9aVc@L,BkhEK@rEhUMPq9&3lhP+b1
+@bcS,(j9)drkfAVH5[S4a+@qe@l!'FQZ3P[@HdVU#r8dNk)aLGHSi5)CHrX'lP4
6NQcdSU,9aLr9TpP-bd4Zk*laQfcLVYNp[3HI4er9P5bFf$l4Afd[460UdJ-d,6G
D[QpKTM%eS6biDq+L['Kp(4[AZd8+JZR!4[2Le0KCQlE@NPcZXY(EERULZP0fL3V
a0HF2RR"Aa1efPR9KIiGkP&3mGFR8Dei6%M8fjZ-q1+'p'j1MdIcdRK1T+G,FTPH
N#R%,%DF8JPHGjIe1G'KUENp9MBjcLm1YLNZd4mh#E-2ZQRTAc-k@)DdGSB,FaM&
iSIUlj-'bMhA5kVN$KkSFkZSZ"+Tp8hZDh'J#9&DQHEpS,#3V(4L&liS`2T*'G&)
9ElXd[IEbjBZUZT1AiD4)K#BEe3Q9jTFmqSj94++CR,Y24UX@FX'UIJeUhT3-fAZ
#['ZFFa0aT3Tl#&,hS%Y,Aq,+q-3eQYYhbZFbR*[*ANBk2!f1qJT5fIHe4ffSSG[
!H0Q*1fF`N3T8!6T3JrfqpZ"UdYATTXd%*kp+3VaNFXH*T1kJ!(6H&A#k*@p9cYX
'([V#LpH*UcT,LAK-HDqAa(RF$3LZ!YF[##)eT9"Yk35S@c-"PHYpH(Sa!iXVXRb
j(dff)#SY`1549ITl6lk5#(k1&'PhT3mD(8SDcEMA+ld9kfPlZ6'p8H4a2pUG,+f
[V#4j)q6NLM8fU*Q0pLQLaP$S`U8f4AXAJXXX,hD!@Jel3"*e0GUY0KaI9*BVJ,9
bFClEZ5KT4c2l'q+F&kC(5DCBJCZCqcA&idX9ledq,SAfMLfAi,!#+A&fBcEZVUa
$+pdQQ&1@9P`1SrD)m[Tf$5pTEQ0bH6P9P#)C$L1@&9a@QSq&0QU482`*flhS,!*
km-,hR2AC9pr-Qdce,N@pXXbY)cJcDMamq1!#41kR1DdfM`2pc,i69#Eh`E5kJqd
'RcIl"XjeeaF-ec[rG-qVmX5D#9bQH1krAf`NAQY3I'Mhl0@(@Q[TFR8chJTL08"
RL"lJ9-pfI#rL$(0'1+1FHCc0R$(11'FrcRc1rT`&R)@F!cPCCcDBXiKc#1G3cQ'
FScQ,1FG`MZ8FacQHF`,R4-j*R*-jTh"1jCc'1Cec"QF*jdc1@Cbc1HG`cZ@FacQ
IF`(R3Xjc1FXi&h%ZjPc#ZC4c'HGbcR,1#Xj+cK@F9C`V19GaVZDXjPc$ZCCc(@F
0jhQFkcPV16G`EZ5XikcRE1$Fa0R)ZCPc#qG@cQfFfcPhF1lNh-A*rTZpR2XiQcM
hFalJ2*rcS"l-(AdUjeLT6H#RhcZV(2&pFrXQQp-6diGX8@IfHq,KP0eX1ip&lZQ
bSKm"cL"RL*0eaP(1SCc$1IYaaMJ(F"Cb&R#1i"a9l[Gb(RM#&p[(**P20PEc(AX
8eP0(XNDEdbSRc@MKThS9MLc4F4LVYb,(Lm[qfGKXlUjFfITbGpTe"mQcVllFhIA
HEHrpjAUJp`kkiVYbG0hI8leikSjkqU'eSYjqXJYJ`+RlIU*h-kb$96Z'R,$'aLJ
!B(@3!*Q(X#,)+!"J$C!!83$!5KfM!)!91@D'biSLS`#!G8jQibVVQ%3"J&ka*!S
!p2SL83#Jed3CV3LXH4)&!(UYNZ&6E'39"3!qEE`@"3!qE5ih#J#i)e%!i&H-+!$
3bJ0%!B"IUj!!4!'!AkZ04!'!AkZ,4!'!AqYr4!'!AfZN4!'!AfZQC,f&AkZX4!'
!AkZN4!'!AhFX#J$m@YNNkhlm@Z8N#J$m@SFP#J$m@KXN#J$m@QmP#J$m@L-P#J$
m'YU,!J$rBaK#hIhU!hP,l2m#KLJ!m$pT[8bEdkZL!##JRK!&!!(GPbJ!##KH&!!
%Y!T+&!!%Y0j*&!!%Y$j*&!!%e2HL!%#V+"!&!!(eKbJ!#'K9PLJ!#'JGPbJ!#'M
ePbJ!#!J$4!&!3'[#4!&!31Zk4!&!3+[!4!&!3'Ze4!&!i&%-83!3q,4K&,iIB-K
m1[$h'+)!)+Jq%!8!3@'0+!!)UVGPK8K3I5J+!),U%aNX"R@2SJ!JU0T%!8"3kke
%!8"3Uk4%!8"3Dk*%!8"3+kTNafK3Dm4%!8"3+mC%!8"3Ul*%!8"3+m&%!B"@K#!
+!)*D+b8+!)*DYbB+!,3k"&%!%&42L!+!i1-BSJ"!UdB3"3""EC)@"3!KiD8S!!J
*Cd8"3%MB)!S!3X)883!38Xq,!S#3!2T+&!#%G)qL!##NA+)!)#4X%!8!)@'$+!!
)D4@D[&`)kHj&!8")kmp%!8")UlK%!8"SX'S0(b[M4!&!51[Q4!&!5+[@4!&!k-q
-Mq#$(iJ#J*!!&"k)!S#`Z)FS!!J29SRK!fG&!8"BI5qcPl#`3"3!K09MSJ!JV2Z
5jdIK`8CQI+bb%`8!BDf-%`8!BI%$83!3eKShH534eTSh83#JP6')!S#`9XE*[$S
X$L3+!-,Df#d+!-*Ia"!&!$aR-!S!)Z*,XPXLSTi@"3!4iEdS!)J)Fd8"3%4i+JS
!)X)T83!3%8D)!S#)HNm8!%4dek)!)+*k4!&!4,BS!)J)ld8"3%3V!88"3%5VdN3
"3%3VrN3"3%5p+`S!)MaD-JS!)X*b83!3&6m8"3"4pDiS!)LUGd8"J&EU)!S!SZ)
2SJ!J+N`8"3"4pEBS!)MU6N8"3(5`G4NI[%d8!%5&2D)!)+TeKk)!)#UH+JS!SZ*
RSJ!J+Y`9"3#D*SX#!+hX36Bfj`h@qH'$4iN#J$ca%&%!N!!RV"F&!&VaJbJ!b"-
HL3+!22@j+!$)8iq*!S!mhD8S!-K62D)!)%pi)`S!mV4189BkjSP2L!+!2#Pe%!8
!H9*P)3S!mX3[43&!6"FV#J"L`KY4!"!60aB&!&T&K#J!L+N[43'!9K3K#J"LiNZ
L!%#VLa!&!$&a!&%!%"1'LJ)!V64#&!$%e-qL!##QrK%&!$(GKDa,d`SN4!&!6(F
X#J"LkPG4!"!6hSJ#J*MZ@"3!a-8G43&!A"aD&!$%aH&&!8"Fh&J8!-6&D88"3(b
N!#!ZALF+!1,L8D)!)#i1)`S!iZ)!SJ!J,L`@"3"apE3S!)J,Xd3"3&`p,3S!iZS
I83!39mfL!##ZqB%S!,!fI+U$MVk6YDjqk@8m9TC2[F15SClYlE2-VDUcQ6fr08X
)eDB#fGbQ9VkT25*U+jHcDHI84DTl0"2eAhbkG+IqqL6[T0fiq%EjDQTVRNCjAlM
3DJDl#lki!Ym5qfdGh%iVeNTm[,hPEC8'Hb1T*I'kM1QdRNUE!-E50j0bq)ZY%+1
U4@G3JEaPd*&D6SX+'&9QXN)TRqKiSQJUlhP5DA+i6aelFTKi0iIVkhNZQk`[H42
T4jEk1hS(b@V6PCpkJTQlTkjllFPKCrK9DlrY,4qT[IG'2I*aGbEVTjFa2AcE$2E
UKi12m0N3EL0RTar'RRTHfrFm@5QIX-eY[@F'`(0Ql,clXJrcY,$"RKblRb'[PVI
2E*BI10UG,$[e-PmVVqM61+Q0!#-8AUIqqb3P'D!R+5Tj5!-6C62HG5FT+Z!U"GS
4&R2C%#TXAGCLSa!EbKY5raR*$'qLiYjpi@pj9P,$@mp)DV!N02Vaqqrk8R)CP"N
a9DkZq!*6KVcF9P'mIBj@H6`CVjNmQXJpRJH8MANHd$AZHAK[hmrc--M-pcbm[Hh
[HGM,8H"j`,9#cm-qM`'HKedI!cf29RlfH"lf0Jcf2,`2,r)m[&FHkRNBH!hc2!`
&KRXHGT5FjARBAc,#ml$Ej'c2`e[jNCk(YpYMUcb1AY*F(RDE6+Mb*+ALT[1`pf5
Ljq%pp562`jk1bCk(Yr962!pl9UCk([B,62-mc-HQHajif3c2``k1%Xr$1rZCRNF
VHAXm$cY3CRXHpXM-m6b-LNXp$rYRjRSH(Z(-mcbmcCr[HGK[XX$cX+GKSHGKIdL
Cjf%hcL,2`pkFaCk(r30,2!ql2jCk(TlY,[-ml0PBlRRBqe$ZHGK(8Z&jf2e6kAP
ih,M#ml$ETXVcX%pSTHGK"m3Ucm-HSY@HKpdJeCk(R69V2!qlMGCk([BHVI-m2!f
Tm6aDVGrMHGJ0XYlc-'@Yp6cXYYRJHGKVY0(cX,ZTc[2`A+VHml$cUF(cX!pUNqG
KIdbMjf'2e'E2`rkM,Ck(A6YE23qlUECj([E#E2Fml#[DiARBGlA6ml!,DjIRBII
9EXr$lTFpRSIp@RXp$lZhpRNHpR)eH4jfGZhh21cc1Z"jf1melZRjE5+IXrYV[1G
K*p!Scm21X(-m$cZY4RXHp[38HalfN!#0m6cX+,YYI%!HLiDNV-5ekRQp8Gr*60Q
Sq'6qED5L-C-fkN#6%Y(X$&rfcVVZbdKEbpiCmqDXP,@Fh$6QZ8D5@PE*U&%`QT@
8CP4b-KYPlQNrN!!'Cp4[RT)&Cj4jCK9l*T9kpXTc-r,EXMe)rp'([qT"qLcEKr5
&N3DA8j4U&qK$HSpHT!rr8jkGrD!(`D5Ghe58C#p!C!["EZicLSi+rM0IlbhC&T3
2*(DbH@SpV+YI@QQ3!*APXmIYC)0ja[I2cGRfD1H,AEhrJ+fIpY@qlCrPJkR!P61
cdh$-jP'b`&NQ+db06L5mcZakXa[0EM"lNpQEcGjLpM9QEc9lQpREcGjKpNkcGjQ
pfqbpCZmcZmRXr@BI-2YmX`q1VM&i6L@,6-f@*-(&CPpLpU9QYjKpa1c,c,lFl0T
4BD&c4c,,e0K'8X60lQGf[YRpc5i`Zp$X!@B20(Z3!0Q$c5ibHiMCTKH(Q6hFl,2
-(Q(ff@D20(Z8fHHB2GVXBV2(Q$h@l(&QMcGlJYN6cCjNpQ5cTjJpeHaTCNmhHiE
C*@E20(Z@fE20RQ0fUGPccCjRpRbc&jLpd1acc5icHj(CLmeHB[C5XjHC[GaXdlm
9CPHD[F,X+V0AQVh+l09Q9jZpCJ34NCHGeVHPjMD5,Qafa'`6GjAC9jYYN!$VLP&
jdAU*2"Um%F2KKHCpqbRpA!S2TC!!N!$CKbhlm&(ff1DK)LQhp%1@5513!,)eJLR
E)*LTl!+c,l,iIU2+iZHIe1fPH)DN-F$)$[6PClrMX*6HUdh,pae(TH-MCprq8%r
fmG-1)V98Z*FkYDT`1"Np!IQ#H%'f)&U3!#q)&L3,BJ@TJP""TL"5N!!S#"6N#H)
%DB)`3CBJ5T!!*2J-K!@b!P'"T%"3)#F3%dJ*K!3b!K'"K%"!)"m3$dJ(K!1b!G'
!C%!`)"F3#dJ&K!)b!C'!4%!J)!m3"dJ$K!'b!&'!*%!3)!F3!dJ"K!!b!"'!"%!
!!(q!(p!(m!&lJ"k3!!IJ!AH!(9!(d!&cJ"`3"m!"Ei!Ed!D`3@%3'23&D5'XF%6
i)G`3AJJRK!r#"3&2%"Sd"[D!21!4b%[Y"bicU96&cE6IqZVUi$*dXQf8pLS4BT8
1[[,bbdDDX,+4#8&Bf8!T0a-T3Xik5jASK#kVG(39%Ud1rd0+&1jP3[6@ZFlbT3G
%rPBk1#ZU+afGNYL9$Ne*kNU(TJ9eC5-cmVUbiHfpPC6HPEQrY"#[A("RCmP#S8b
[H(+m@L12ACdhr'm04,KA@e4(YbC&ID9$8m,"dU&Cq@-C[%L*)8Y0Dp-)Q3l0)'3
k1)Q3!+f4dJUYJHE5dj'#FZNJMA+CbmSJDAYdSYr6d5Q%l1J"3E0dF"BKdp%TK%b
(TK!b(CT%b0E)&-bdKVIh9K)K-rHA4XKFF'I(#%*QHX9$b0E)BeIR)@4V)!MC&YA
4V8Q%6)HQ%$)GQNA)$0Dd)D5H(1A`d3PX4dFRY"8EhEK8#lKKkDZ@dY[4,K@Ek9`
R0S@Q6SL(T8j!'aUQlcZ&@djS"a)kX@dik!5fSD!6f)U"EP`EM,M"E4h8LRjbBcR
X5iDfpdm+pk3VMU+H'pGp@8F4c`ecmFk,bA9M+pBjJ@e)j`4fi*bJ3!VP6+IV++d
&-XdD8k,efUB0DYACaEb5ES[Fe$`Cj6b3!(-fT19`1e9U'ff68YXL9DRTU+j5R3j
S+p6$`e5CAPbL5#HQYF5d&-DM3*N*6f&P*MEE[TR`G!GRJP03QiP0SQeED!V$fZ)
&aYSL$@TP@b!MN!!`&jh45jM&hda8UR8cXFRZcB9fAT*TlNcBLIl1%V11m+lV6A+
*YY$H9NbUB@b0K&6N`MSZ2d8Y-V%TGT'*cI$H6(55qVD&GPaHNJ"hB@JlH(DKCJG
FYZ0N$L#lNE%0%R0Bf!Q#RHLAJEef[-X"A6[#CD'Y"p1k`+`,aA,`eBeEEB#94DS
F4,9M8cXSGD*4$SEDm#F(2,d%VTZpp9+h(Yl@6GUk'0YaZYE*eEU)fM'@GSbLYI'
cER,@aFbkD9Q1Nce+b(VC@#m9kq*KadPB*`2,dDmZlY90[,TC9hU!dUTC0"RY#Je
YIC*5YG&+JVM2pXP,YV"dY&YBkb5rXc$R+M[+%Lc-&19#mG'5NYh4fJ)H[(S0N!#
QP@dP*6XNTjSdRD&93fNkhP08QJjXeeHDEU0FpHN-VG@RilhUdi((URHDSkGf*lk
VFLIkD0e1@([9bCEXk$Fh2YGYER5Uep``bik593[+Kl$lF,R$L(H%3m[G$'8ViD'
iY@e*!qq4N9DKc1"iZ&dG(KkJC8$aJlfPh[1@FA$m3'N'"JmZ3bqmcBdPH(J3#AK
`*BXm,(&i%!ei8)D#Fk9HbGSf9c*i`&k@0"jF')pRQc&kH&$%jL#r29LU#bZIbQc
,Qdd0'!`HU!@bSB!(VT5UZL,Z,XIjXTC[13r@kfBE8eHm)Hf1-m-(Mar%rKd2Y+@
A*TE0VbqefA&Bh@feejH6m@!d`X1$k(rJJ@+99M)`510"hPIR5Db+h91-AaXTHAJ
`a2#J*XX6,4&SDHbBZ(4LelJe42$`S(#FV0i!rIMIeY)!9MQp!4B#h4jm4TQqeHf
V@CLChM,6,C+mbe+VUSeHQ`R8dj1'kL5N,8Nf6)1mIHd,4#qji,PTeBJJTHLC$ed
ljEfHbG*rTSkDjUcNhacr%*93hG(c2Qkf)dI0r+aNipJ!kQLFNJ`G#m#pEPcBIlV
#-hA86apDR&KDM9VprZHMfPIH'TfhGbM9)1q$TDmLEVHcV)[#M819MPcrXAH9HRr
p[rL)bR$U3068XDrQB#0XSZ[Z$P2(0%N"XJ,8mHL&r&XGMmVRr8NGa`XjABHLBVj
,MPi9q[9$aeD2IrQUZ[a&Mb)miIQr&V&mc[Fp$"(bVTCm,"qaAqDmZ(l*6BhDjai
TeHrS1K"[pArh`3a#er&SHe#(l1lVZ9LR$V8fd4*3alic0pYhVfM!-RAd)Y(T1Kk
MfUS11[EiTqYSL9DI`@PR'D'["'S6QXATc90ccr-BFUamPXNdCDhejqVSqlL3!%[
lqE1XiBNk@PEEcmq2e9,(%rbXT9JI%e!(A`P0mXYl4HD(-'j[&fMQXhm`lMBKX-l
h012ZUF-D`,MA[f'[a'`GrfVQ$cjr(jB2jYjpUdmcpa0e2-RF6p6a*(-r@FF6c,f
[MMlQcLI-hIri(fmI!m$F1qrMjmbpjf,2-2Hq1TjNlTePr)bjpp9K%@$ZqeHqfII
@$mDY&ZTfj(LDFAIA`@F*B0aU$ARTcXCS`hMQLhf$-DNkML2$8icT4"e2-Tf6G6c
"G2VUH!V*1q[i'C,heI%Bk+Nkp2Vj2S3SBAPFEl`hN6M@)DU1`dZ5X0MpV9mkr(`
GXHDcMiEcQXdTLGbc!(crLRKU!cZGH,+13erRLUU13baXGpHRGhCd8b)aNcD!Hhf
@-b5ip'1Fr(3GIFMj@*mPqZ2)1)$&fIh+$Il(-+DJR$kqVrZcY@0hr-X8+[Hj8kK
[rdJeIE3#e&(Cl[FM)%B"5(FG#ZZj9pmcFh)p0E3#h)HHpPN"kM$6[Yik6Nrl$KD
GGR3,HZkTiq82%he$l6(m3pqd[IE1fh[4GpAZ[QRE,6IAlRU*`%4*I#cX%RpGlHl
m0f[[r"$jT)lRUBYklZ08RmQ8TERhYAjPa++"k&JG@fIQ'p(%d60eR,S22@@a![5
VRV*B!HVJFq$-pcrhUZY3lH(lhrii,qYqrIQR[pQF(`1`a!+eMRh8`lGPr-6,KmU
jYheY0Z9mTXGk2meKV!"eV$QFAcI"qFYlKCAD+piXpRij,T6pA#ld6(qiA1LCIMd
eF6iaEPDIjN,2iJF)[$AY2Im#jp5pfLFQehc#UIlrAR8GF+TRqk2[LCI[jH2IhRM
eIUHCMPhTMGHcRfATMGI&[62XY1pHRhSVGSUj*pk+2IYC30k+G3,)cpk+G51e,H#
YQ#GQU#0*G2`%FlG8-&-V!(,D&C!!kY4hBUfMr@1QBh(CP02l@3KQ-ADJ66R2ITD
P66QRCc%GKGJ)CM'2jT!!M6[(2r[@aTfqjrqq#mC9[2prNX(C0rB)2-@m1Z[i1I2
UZC!!-mbVV`lVa(k%dmbVSa#l`*i&T`kYPVRlS`Le30mK"FIbf!%BJDl$+V(hJ4A
"bSc8`jTJY8!k[5rB,h(H6Kje+'(6*r-SaG#qFc`2QfKLRLH-fFrc4$$MRSFPa[Q
H"kPSr6e2$,2!mm3a#ce22m`"RLFIFk$RkBmjb2-8B!lf2)@B4CjR)1C3cc-)FjM
R'B`jh2-8BClPHBCJM[!m3c(2pMc$-%GkRY'B%c`2V`FRHTiaQ*-mceM-bCjR(1B
8cc-HFkVRQB!jcI0-a*cZH5CKc[!mNc&,2-m8c*QHCbVQ,-m$JjlYHDCMc[%m-c"
,28m*jPc2-a0cRZGK9m0mcc-EFi(RQB1jd22-a5cc22-`&hNHQ1pLcl-!FiRR@BL
jc21FLcR@mk$BB,RR@B5je2-XaLch2%X`+cc28Xa+cl--FiARB4e!PHFTaecTHAK
TY-Vc-#GDlAPi+96YHDS`ehJH*[EV2-mUc2-m$eZiDMa20HCkcl-'XpEcm2jaJqI
K*GT'ce1$@HGjcX1XpccV-4Xm$f1i6CjR!fDMjpQ)ZGRce'&Zm6ceQ&Xp6`2Q0Xq
c#A1ljfR%h1&j0Q2Zp$aE-(GjRUfBZch20X`pRQFljPl2X`0cRqICLGRNHACKl[F
m2(Jji(QB%Bpl1Srj9"jQdZ-p$r[E4hNHRKqIihRB"66Dmr!#[GMcm)CKM1GTaVc
0mc!E(r*F(MeG2LQ4`i,bf3S8JrKIcbHqKYTYYFhe'dI4D+cme4IJZ3'$G8Y!"hJ
D8@0Ml$5LfZ3d2cUD3#eZ5(!8$d3cV(e1)kT&6N2ZFrm(MDMrVJR8MUB40@rXR%E
8f"KmMDM2T9CNppe5ZrXYKdl)lKY`Dj!!hAIPYiJkX[ZddTa!U63R20c8DTe6QQ0
VJi%F(SLb')ZFFT!!3@2RP)--(RZ[(#6fJR)3baNHf1H8JiLbQ06m`%'#j[&KhIj
[H+$Q"ikb1CZFNK585Ce8$Q,afSGJi9)1FUaIH4K['VDeAlmpfL$l6,rDJj5$r'5
2J39!1BLZ3h(k%`8rpMdR9&!JmYJ%S'IAqLmQ!(BT"5,2p[ec$`J&)ZYZ'bS3#Ca
G2i4I+4!*E(RM`p&ppBNh(TVpD,hab$&5+J8LK4mRrY2eLIe2eVIF8YEch%j(J8K
3qN0m8DqZ0CmXqe65GC1I[e[P8BI[6DIcq%Gjd,KlUHF*BlCiRLMQCF-mA%0lRKM
Q&DIc*1qa(qEc[Ci#c'Y1j`Q2mK4L[[VTHV`qJclFi(Q'BYlSHG4EHYq4dhPH0-T
c&ZClKRPSphBF')&jkp2pk18CKIQ4B4lD[EhZFc!rkRAc5ZlfdrHB+XjTd)3DMZ1
IP6m2A)-d,ZG!EiX[H[0pfB2SZKjjjA-e@Xfqmf'[@9ai'EM`%#1#IaRVKJX(Q9C
%6Z,#pH$#Mk)S'`2`8XcUpGd#@FMbKC[ZbhlVP9&dc6hMfd""!3,$cGGAXml!UGQ
ZB-FEUMbK8l0GPB3CH[IXhXX$4r&QpkR`C0h-fVhCIAFH&)YjXr[Z2((-#Ck(QIa
%cj121FRcp-HFl(QBm8ra2-ciThSHC[c62-p!c1QHCa$Q$-mc',2%ma4Kc[3m3c"
RH4lH+Xcf2--`jhJHhM58HKlH0-ce2,aTQ1GjcXDFlhP'BLl`2,b4@1KjH#04jRP
'Bblb2,bP@1aj&!rerB$R'BZje21-`ecQHFCM,[Fm%c$,2Fp%c!V2-`Qcd[0-aPc
KHDCJ9RQHUCJV23q[lPCjRZQBUch2$-aUce1#ZFEcc-4FkhRBllM1mmc'V2%mFc$
2mcbPQ1Xpcec-@Xmc$h1$jq&9h8E2X`#cc[-Xa+ch21GL0RJHa0TXmMb,-"Xp$fm
J0RZH*CKE2-p5c+fHCaRQ0Xr$UX(YRUFFFiIRBB[*6Xr$V(HAjf%,b@l28i@jar1
`$@#[jeQ&ZFrcX1'lbI08Bqlh2'X`$hJHRXD1p6aeQ&(28iqCjhND-'1HCa0Qh2-
dB[Ec2*Xamch2&XcqRQFVCS(RfBCCk(QfB`l`2$X`"hUHRCL$2-mZc-'HKk844Ck
(GpC$23r[ZSGjRLE-iCk(&9jRH4lfkBl`2'aa1p[cX!GJT1GTaSa8H6*2TEdml#"
qRFqVf4VP[VhZbF1VkEGlRX1BlT[Pi+Qh`bS2QaM'qIcl%XcaRSF0(D-m$rX%c[%
mV"-BlARBPe$XH5l((10jVX"dhh+(6VhP9RPBAH1qj3kGHXZYSUl'G0pbpr6M0CL
hqIfm%00pmadmpHElU6b*Ll9I[M&'l@Zih&14ak$+QUrfpE*ZZM(1$48m2)J%2,L
5l9'@1$`3GBCldk)6pmDU#AcY`S2SH$Peb'UqD*P6Kkc`)+F1fHkQlV4Jl*aDk2"
i1EA3#JmL,kL&YT%*42E`303Kfq,83LXmb"X[T`jCi8'4i8&0PLGl%0[AdYJaFHR
%VR&VL1$K39cE"%rSdE+HIJVjhVQiYV$+L-6@dJ"@Z$IYqJY%CheVD+2h8'fI$ef
`Z-E#PXSp6@EF*ImeY+a[Y@I("m`kqCEa*C`0YGYUQq[5Qh$dke#6m&pIk+6Q#99
EFI6L3ReK%bM5[['T[PDMjqTZ@U4a1cfDl-RMP8l5I3BLdpqZIK'I3G46pGFRH5I
YaX8,jHXf4TQ8RHB,3%G3"**9"@*PqBUf6XhYRYlDf,TlFR%5XhCQDP%#N5`URa8
'!b`aRbd1"H`iha#6-[2Ffi-jf5P!mdZPbPTIp,#p9Ia+UH,@&hfb9',[D#T%Kb-
D'p(2b"iUY[h8F*l(ZCk6Tm8E1$GbSSN4[BYS@85R)KS8dCH)GN4d)D,j%$f(D"G
Ne43lAGN5aKYbG%(bMTGhcQM%j@Di&65USGd@AECSVN92,9TTd8(,XhMdbk*0&Yf
aD)T&,baDB0(jLSCAp,QL[49GV@KQ43mV@PI4XFU@425RSLd9hDKS3NA[+9T1HBD
("P2dPD+GP0ITD"j&cbKD4G%KbJYGp)1L$46GRfMk4+mR,jl4fBQ'6[4aXRBDACY
SeN52*PScH@I-HP,dAl+aL,INE!T#Eb@E0ZK!AJDM,BqZ4)mLfK8&6I6b#KCbSTq
3!,IBl1aPJa*l2%34[JAJSfmqBHq62fNBm5R$M%mE4YaKQ('R!GaR6)AdAHErV1@
lZqaNAr5aXSYpd4qBDVjlc,lAmRh"l2ZX[UqDrd'c[fEfemhqSYh2rHCr&0--#$Y
iR&)&U*`f'PjVlqNAqd`r@(A``d,4&(Ce6,2)I$HmAH2$#r[&bFeTHAr&12)kiM,
E5JFcG`XU,M0lmfXf1*NijR6H9r)CM61GqS*r-BaErGI$qT*aSjP0Q[U5FH%l-H+
p2,NZ1[H((aafF[L2--D(Z%fDN!#*80E`PkYmXBmpJ8qf$d@8pmD3!'q5jT5LD69
#(rMfKR`2[%-&1(&4c@mAKVKrH&5**0qIBI32FHrp5b@51'UG&HUES,QYE-H*DLl
Ve"II@fSJGZ*'8&2)iNCVpXN-Q,4rM&%8k[[`"r%a&qBDQCq1#2ND090fTSbqAqA
q4K`,F60q5AFMGEqC9SQ'1Klq%J(-P+Q$QII`%2I$hmI(R*NipST*Rfh82*Xl*1j
DjAELkM8VCKkY[U(JK2mXkdYQbmbSe6IXLaL,3hhIe2daYkD19`rVD0*FR&Nf9k(
QZ[j(3ebeCXA-YmRh`DS2iRY8(c0[iZiFp[I0QM%c"eIIf&r"Z#[%[@X`'eII1'E
[rR$ImDEQb-c,J3j@SEdRa,eB2F`X'*2jG%QSide[aNIrUQm#Xr,!H5(ZBm)RCZh
UUd-rEb6%a@pr&`(-hp9h(l2hdTqfI06-6&jpNc4$[kj6p)@[(LZji'jDFA+R+,F
%Hh'6dARV*pmKkNc'KGkY(PAj`&d[,UJqN!!q[[B4!D[%h9rKCH`6Rm!R#JU#Ic2
-0rA(mI&HJ,JI$I&5EmRP$B(kT[l%%-pL[k`'NrZiTF+rf$h5NXYE!q+q2Fah81m
*H(m!c2,@`-(Aq+[epS)h#H5lSF,Aq*VH!-LkS"A['q,Pbh8A[&fJ$[T#F',`,q!
$SiKlb4![Dr9QJ$F1UP-'2$$%bkA#40R+0rAK#LrM,a8(i(kSi`-9AXDhU!EH4a$
('`r"S@m*GhNc34bB+MMh%VdVi4d&CAjML*HcEP@[#"lF@Z&PI,I`M2F@m!$k@1S
i,)i'ce,IF[L$i'AXhG)Sc,X-mY&rdJFAr$BqF)DiZdGiF!FqhQp`[I!B"brM9rd
Y2YPLY`J--(KjRGkpm-k$Dhrl%#rR2kEHPI[lf`S[ir[%AAJ2SVlbabZmM0rb"3*
%QXb,i'-',f-rVi+G[Tb'cq$P"h6hF$6D(0`X0Vcda"!r!VFSM!`[[EJPm!rr6BD
AAYa`[HdaH1R&qB8MKLqq5J9)(1pjK&r@UZpjdd)Ff#Ej(KCAN!"pHRleY1$PM,[
8U%jF3,a#F'Zrm!#13pb2Krcbim*%fHSG9"m+rSe4rmN1aS!`@2MP8R%cfESGH-q
`[NZ&ZGb*qRCpUX,,f!2LGV,G0L$1DRJ92YiPd@IFVi1AX9pA$Eb,8YHk#cj3G'r
)pl+r)i)l90m@pJBD["`XM!6$+3'-%Aljc6[`b@lrbASR*6Jd8'qRC+[kC,f*%T`
ETrG8[,e5hpBI'q*PKHk#peM!1la%m2+JH!p[Y-"[m%MUQ#EZ,LXKYp'AKPp'K*A
d&2RS"qQ$)VdliRdAFI5ph&1KlS)hAqVESAX5['`@2q!GQ2Tf`PX%,f1I%VE#mEN
LaEm&,f02UJEZ(+LNIi4IIP4BbCfVV`QF-hKj8,e0[kM[$[CV'VaXr,!DcqR,PMm
%,am)GAa$GmC*DHL40RMTEPld[jmj5[3F`dXhcMI&2-ChTH'P&cGFZ'c`dU[MJr$
8[191XA*bIR-!M!aFh1RebCH-H`AcKA!d2pX[i$(-5(JM"ae3mb%c0dVQZ`Dqj(m
VGDYl6r,D&ra'i-%kcX2[Ul@rmPD,mqj[K2c50lYealc,Scmq0Z3VpiJV-Jq"*kP
qmVdSa0dN6L"[dCD)%qme['51`Ub'qTL,5(hhDcBKNP9'D*iNp9dLMLLL8X,#!kR
[AZ'pl24X&Vq4qZl@E%hfS#i50jAkVPIGe%)FH#(eADjF)QNKS$H'8Yr$QPQ)RTa
Qc6QN[Rr@A6UU*I`2d*G&!rlNkVX1I"mB'9!FrH2'q3lr*)DC@hKa`pA2"LHmZ1[
KIrjl$9HmZ'@D@cLm+[qe`M+&mjS(`(%Gh-erTIJPr*hlJjXk[#Vr,[(XPeSGRkT
i6hjM!aphba@pYUT[ED'C%ra)I4H)[cVeVAe!m`$mc!2S4DHqY6Yd0qq`1TJe1[@
YrB$Q3-`KDArH)6ChqLGadEIkS9'FGpmPQQ2&`6RiQjG[QIV#i9ZP9iV$`(R9IAb
"[Kcjq4$hA@'*QRX3paedT`S2+,eImiphKEJI-"mmqpB3peIh%r(Z%&F!2aCq9[T
l2b-Z)[F(ch2i5ZQGQMfmeh$Z1e9rP2k8CRBU[lkR9eDmU[4DF5D&rq"%M,X4IME
h1m6[hfpp!-paq&RTPck*$fj)hF4*(H@I`dGIU$VLF%6KCh-[e"cZ3b(I#R&(ZHp
DpIBI'2iaEh,`Vl5[hVdja(f1q8TS*X5ppHF)B"l#961rF("al[r6I%Ma#)d(e1V
JBZPac6$S"IS!cZI`mVN0B3Pp6FRNGRKjk@FefkAAZ1mE+ajCqJ(0`p4m5FI4Rp*
2$kZ2i4hJ)[0@KdI1r@l0GX%CU*r#@q'4T@rr#"'hKhaADFlYm-M5ijS[`J("*c"
HqZ!1cB,*UHVS6km,MbcpFh'i6i5i3ZBVJA2+10mHh3%c)K8bN!!l#qi-F@r66"0
FK3I$0aammYhcZrJq(I)9`C0-(GmA&iI[Uj!!SFaq6"hIqe-LQ025ar!NUH-"p3#
eU(`MZ(Y6aa$GkedKEL6BBqTi5,M)2)eqGHGj[[GVeX*F5q8EcDc#e('(jTUI#h&
Mk'06alhUqFpE(H#ce((e3rMZXEj8q1%lVi-b#"HMU@15CJB2)[Xh%cFCr2#(H8c
`0['9HqfqQ5I@KlLjiL[8U,jV9FGV3Ya9ZVrl3KfcQFrk,`KaefUfq-830`AF-[@
p8Ah'r*BkZ&qTlhE0Q,KcP@qmqNcUZeJm8XdcLCX+hc2eqF8*iENUEKTc!P0IXrJ
Z@+e##S@R8YpIUQE`"fS2Vj!!q[,%fG4mLEJCB)bTllALdPm,F5A-I8ap9H+Sc+*
T6qj*k[[c6q1Mle5qQH,a8YqG`Z#(3Y`XX-V80dlc+QD-[[m$!*!$@`d!!!%!N!0
AHJ!!9RS!!!*kEf`l$3N*CR-ZF'&b583J25!UC'Pb1`d*#8jKE@9$Eh!50#i`)&0
PE'BY4AKdFQ&MG'pbFJ)!N!0"8&"-2j!%!!""8&"-2j!%)!$rN!3!N"+Xp[d9!*!
'@I3*#3d*#5TfEf`J25"QFbjf8Q9Q6R9Y1`d*#5TNDA)J25"QFbj`BA**4$X0#3P
1B@eP3fp`H5KQFbjZB@eP,'jKE@8T1`d*#3d*#5ThBA0'EfaNCA*"E'PKFb!p)'P
c4QpXC'9b1`d*#3d*#A*PG(9bEL"bCA0eE(3l$3Pp$3N0#5Th!!!#L%&%3e)$!!-
S$9d,iCE!0Qd2b6Z[IH9Ehp5Ue9CEkEAkC*9FPqJ9+UeD(CpNDpA*@5)i3-Q)R'5
k55HY1-"hcYF,r!1f#E,M5[UMC@C+a!jlH+aC@B3V[%icXLX@fR,DNr0`SMITBMN
C8cDC6Z*'D,'pk"KZJpfp@@YN0fce%Me#6X-#1je1j30JAcZ3!!lQ+MM%ppFL13@
,l3`kNiq#Xra)29V1aZ2p8$e-6X$$l9JkMKI#GRp!ljGYH)IYT+em*paYXfN1h`A
crADp66EM8cD0CR)dR2%&qSc-`1RqK$iT8r%HQd[cZ"kHY4l823UZ0RLjRL2VFBI
Rp%(CJ[IC4YV%pd*IreFIPcliY(@PE[`Sl'hl8'rq(IEcAE4D$X)KIUZ@bRMmhLE
5"2iFIVC40*TrJM&HU6r)*&aMlDNGr`LGr#[p@MVJ5&qYUk3cVV@a0)lA34GE5X[
i1hM(rpDrj$emhrr6A[)FrQmId,[m$hcUYIUPI),If"+DaGp#2rZB2Z-'k1NVp3[
TL1IC#r3+A`5[qX9kSEb-Jra'[88'i`hf%Ah)em-)[dU[PQ&iV8fKSA`Gh'3$D6K
I!rhpCLf6!ILDAk+AbZYiZEe*Er%9F,kp5-rcZI#5Ak#Ab4Y4q[3RrF'2`GYqT6i
N[q#[rV!q)VmK'T-`3"4Cj"V@eLC8PNBMkcLAbb96p2B`aCDaP&9&U@-[5hXk6QI
5UA49HN(DD[*0fCDk4QmZA"bhC9*QKDeY8Bq9e54!3"2#XdXQSE`ZSEJ`S5P3&#J
)Y)Ab`R#S$SIkd&B5D'e1lV3f*HZ5PSJk56D-!bP*#TP!2[bb3,EL8QK,"6+"jSS
2"5`IY[4X3MD3!)N6iRa#69)'!*!$,d&%3e)$!!"@$8X$RHJ'ApX&YA!,!-!YrkS
A!!$3@iYDH!'Kj[m$@)8HabqAC[SF!*!'*lp"4%05!`!rmJp9$AC'!4!aiqGMIjY
cMV()-TE9'U0IM"@MlZFhK%X0M$Q(cV&kM"'6f&`D[K#b%A#b!`R2br85Na)aK#$
0iD9FNLE'pSA*#4a,Z66Aaq24A%Sje-FeP%XTKkD%BiLe3#RJ!((Ipr[[lr[QCJk
plE[hrI`('k5R+%%3*%%52*%"I!+Dpk1@k$81XCK2KMmBkh)ImdEZFT0$AjL%ESQ
#Q[A"f+5lUd1X8%03`%TJXZ0G8#P3K%U%iPa9heDKjeeZFCT8f%RNL[a%6Xl(Kq@
H#NEkblD+H`kJd#!9&R6m19E#N!"@#`8L1LLBQkT*bA,EbTI8INfUkU#1afYrX(Z
[U%d8m(MZKZ%5'MEBDhm3C0iJK)p5BU8akQ"S@![63Pml6kiTHVpAihr2j32Lf+f
kG@ZlZ2qbbrfRcfYiFSC,bG5Y8d[GbakZ`C*!PqQbISC,9cUh[kq,Qp3XJ@&0&dq
qhqhq(hIamEjq6RGIeV6GIBqpj1,qPhCcdd[G20RajrS$`9R3X$UYkqliY"IALYE
Q6KjA1h*[iHHed5N0*R[[V!iNhcQ&U81EjPqfE9TdZ9HB2YR2ihfK63fRECZq21e
b,hd!JqT8iV&%8@1[1[8Q"(UmB&C#-Z4L!dNfeDUT$R9UF**EDh0$am8D%VjcI3B
l(HC)AEh(&bT[R-U`MaT@JphSYKeETNk06r)iPN6GqD*Sf))1(1bLli`H9iDUf$l
E2P[YrafP#h@UQh(Y)eAQU!L"dYE4-rA'5f-6,@jF-Qe%FM+L3VJ20NjCD2[LY!M
#e4HMHX0pp*'1e"CVaQ'`l%aNBCU5(l-J1fM"hCpL`8$3JXIql3+aM&$4Hci))Bm
bK)3b8IXe[G)kX8DXmGE#9&M+5leI#B-maQ2H"K3Xh1,p5L*fe2eSD8VFMHJJ,'U
-N9kHY$IM&A@14GXKc1b`Hlka#dE#'"h5B*,%,2(+4)Bb"DC5Ha+[)UFl$+3fh58
MPq2TKVX`,*Ffh(9Z5fmH6'*kV36NJGU[XHe(eBR)*"IjkhBV*CH*BS&Sc6Z#@4$
*j$*aR`5JE-J6C6Ipj21m0$XJhJ(&3pi1JdT0KrXQ%UFk2KPJ`VB,"cZ,'"TZmZ(
lPR9cGr$a4m0KCXk*TNYKFSpYHhhhRQ0,4l28MU&5Yd'*'I5aqTrc4RhL6FjhV[T
CfdHr%IGq0&dXBm`2Mikc4%,+@0*N,QQb[)%-qeJ+-%*D`qVDc`fVFC523&LG+9b
j#Y#X0$9Ui43UG*CT1*UeZ$-F$A'rYYPZ6BHdUY$*Y4Tq)8-aGJ&aY'VER[)M13E
ffUT"Na`H$cDX3T@*GS,X08Z"CB0,'qRUekSEZVA*YMhDbLkheN3,(9Yc&$4Q-14
,NpdlLXR5TB0q3RQIrN+'IDR`b5[G0QfPm0'CPb*#")P`%e"+4ZV'kRakDTVYa6d
Z0+%Prkm&#-&!I"N-DG'NMcebMIHiTM)8,Si3q[-$J5YPmE@i8MYGLDH6Jc$mLKi
'SNEij!B')[YiVD9UbRj-DG01[I'i'*K'!T*0Y$1`(BE&`Z(N'&8F"N6`Z(-S%G,
''V#KcX`0"D*)KeKq*2GM*E+K9rK`Q(+8`"Df2d,Ej0`Af*!!0%-d""9Lh'Vi%L%
'#LqX9cXFhmY4*SpAS4&M)`E+)JL)i2AD"&H4I)(XkdYI1mk(IPL!6"35#,a@i(M
Ze8,H"d,$!8*94Z-S*BVF#+$U[H0)p#,f2X1rJ$J5[Le6M#a%jGIcYS$XYr,iXcb
dKC(G3Q$fUGmKST5B)N(k2K)L(V39,*!!!15+8"J+5V)4'G%bL'$'UYdM6b%m8d5
NaGX18lL%KTpj[R"peE$L++dDlUXDpMRmUH(c!4,V(899``%5BijNeA#!4"5Ek8#
QP,C5hSp-d"F@e2PQ3jiX'qD,qILjGK$!Liqdl4Ah)l"e`f'%dRF5Ri@14)kbKYZ
6L9))T%24-2H,C441`DF(`TLd-03V[S2N*jXYf4TBBMN+BHf'I'!b,*l%0$(mH0L
56,$k(DU3!0%X,G3*FKi3'3YeLhfXH`X4!ZReSrjd*&f+T!hCc,b%e"8,AcdFFXZ
($0qUr8TU),,5NA%NbL0eeYPpif-VZ+Af+erhKBa,h(,6B%rV$#2G(GkR$akADkj
4Q'm00Aid1*MPE@CS`#dU)B%MfRKL9"rjGpSdTkGcXpSrh,rlMcbZ3rM#[Icq1h-
I8)cYQeAAX)Z'ep,`RqlrHXB$1-bMIrd04*+P40V9dqmDI19Qe$XqG&b0fa&98hY
#%r*H3eMH!pBbA*JI[-RpFS8b1T3Rm[kM!mQ%Y5&2VR!f2iY`XlcRi"PZN[FVaKk
`$i"Gl8q%j6)NSrj,XhdJBqqNL3M-`E#mAjV)3arTX,bhkVLF3)"Q&8-0mq8$GM@
5ar@bA&L[jXQ(3&"f,lXrZr(NX(ji[V`A8mRi16V`ZHT#je%f'4HhTG#pThGPRPa
cLF[,-F@Ke"3e6fSZePkQT*Q)jMk&N!#XP$c*9`MCd*!!NY(FBc"5`c`)0GZbPa)
STi*0K@%EQaHR`18J"F$U,1qYj3MD%YV'R(d4&`*2fha'CjJYeSN)I&NDf2,@l5j
AeR+@H"9KLbGad1mj6#'p21qJ5clY"[$8i&X!3R0,fekj"JKd!S9(@(+I*hpLKb#
T0"ZfJ$8A@EI)qi2-FF0mq33Y*mEFMk('RY#0'lB!kHb'e835a#CUrkSC*p5Vr@S
`UrBd8kSQ*MV!R-X#[jbIa-Frq)kM35QQJ1l3fGXFE'MQRilk2V6I&$iL03Xrc,Z
J@LN`j25icj!!bJ0NAS6NcUSZiRiS'4Ui"85MIXkG-2A'r(-JVXF`e(Kp50pIaZ1
1q*`5CGjfZVBkYU,V0#P2&!lf&6Rp!2AbB,,f0!AS@`m%+3FHk9KM`V(bq$K,[19
Y8R*mQTRf&l&-h)"AXcJ23h%44bUHTLc,$!N3mk"dH+9&FD"l+eZLJZdL%TK1PX#
%m4QR")BP+pP1[d08aX!XN!#IcdLUM'3m-9pX##,C(#VijlEGCm@5N!"02#V'S#l
24!EH54Rpr$2f2+",#EE3Md)P3UlImhS-pb&6MR6hT(@f5lHIS!j#*pT%m9"#YpR
Sp@#k'`"YP%hHb5l9I4$0QTK!Pj'3!)4e&50"baHc$IHaaF@%Q!k6pbNb,80KjjC
ZTXUr4U!m9rM-HIU%`m8%a')N&46J&&Y5)!QUD!Kr`R!bj[@`j8m4HI`$&F@j#9e
@dZY*63k`XL&FhA#3!),AR"2qFB$`q6m4N!#C3B$-C@3`P0`D!%)!d(RqL8)"%!+
`DYKfr[QdV["5(SNX-6VXK#kq)m8!FQMk)-lNPeE394+kTlmPG@)5NcmeVI!aPF%
%RjBQRj9"M)H%$fRc#p0C%)$c,BQfLL-m0j6l[0Y@2HE0mmVN$##+kRMZYPTVED+
f"HVPIr&1j+l*A@1`-j%'dir8*9YIc"0r8Gj)+1%mVkSBVKLTbh)JJdD"L"EaGdi
@,RGBAY5A[dX(k-blG8jLmffAEGC)AH[bK'iVhk![hi@I-P+(b[FDE18l0a6`52Q
qNESM2Q6hJS!5YF'QM4fZJ!UQ(LkMB6M$',[e'r6DT-'QM6#Q,'a@5$X'pBf!G!c
U*TYVIiGX3pY4+!hjDhm(YjeEdQHdpRFrq&Yh&TCj62U5%V[TQL9!''Lm#kTIc'(
XdQZ0KXAP0EiXTj@TD3R@$&Z"2&Tlj-dDEM%C(5Di5m#4JlF,kKUIj*b5#--@8ZS
TF8MVB&Q!FKTe)V'49$Va"T*mZ&)B`Z,AKY$KbLk%BEE'S'lD$PH3!-*jZ%bViVU
4&p(%D6I$D(!%kZBK8MVAjIVd!aP1AUT9EFHmEpUd8AkGLQd9@jB3f$L@9SH(3'G
+TQN38kmVp1QRD0%l)h9KE'fXPCC%ER,,PKCR+j3i*hjZN[VVYXN3K*i+Al-J'B9
"q4TR`rPEBaLZMj!!NPmjNI'm!9F*D5ZK*$r8Z!cCl,F1IfiBcE%IcN@f6@iFma`
NKG8qr85'diUK%@QSJSEXrQpL-5ArCkGke%'Gb8)L0E'3!"Jp2%mJ$M-E('YH(Mr
4YJ#,#Z11F4L9jlbS"cKj0)ff%Nh"`SQ-)%+F#1hHFeJ@&"pe+LHFJ-&"-(3Np@)
2`NF($KE`E@5@`Bq4b#!,fJl)K2DeCEl3!GNCTd-rA!Qe,FpY1h`%2hX(3j[3J+[
c-29#A!I*r(!%Qh6N-,Nq[8r$)h8[9!0ajM#4!8Z#d60L-h4V%fKZ-qdH*X4K'hq
p8jJ'`KJNi0Ym68JElS5iN!$2frhNR)1IDA$QmU@,e*!!20#i@*jUI1`X'8`AFpq
d%J`U',``Y`4ESXS@Cc-fe8"Eh6`'iHFc#'0*fHHX'f4UAR-FJr0pa8Kd6bqmH'Z
YkMrj"`5YLN$-N!$Q`P%QFe,('K!fr9Mmkli!S*DhI,h1YqLkkG$K)i1K`h$kDVh
'",@i8fhDmFZEK+ba3e)hYic4J3P#P#1CSa#`X6N#@PT-,(X$aCXI6d2TH0S4AVc
aHZh`50hQkHN3LNqKDcU&BA!NR$IkN!"KS#)XmIADNiD3!&P@M-,'%1UU,a2!CRN
L!iX+KR&3Xh"3XdT#EH)RdQ&jQS*U,#-3P625SH(i)f90@9km,&eMY'R(NB[XNM'
Kfak9%'HE`p')F!pY%'XqJTE%YT'5#H6l"0HX(#!aG46Al-6R!XU5'flbkpSSblJ
ir+j1GY8)3jUl)h9l)aFb)+!%LE5P6*!!JQ1$XG8BcB)"*KTTKhKAk&cMbcUe$80
qChXNbE2XSc$**,P&BMMMp2MDZH98$-0qER(5F"B+ULpNVT%QK!PhMqj#"LAEKbY
Ie*YV*$2,Rf2,#!"I[ZR1UH'%MTrm[Q[BMF+(UedrAf+2NBNk-ClHQRYb%!DpN9I
95p6JFFZ`@dQ@VYX-MdKma[ETcqS0!amY%@ZfVB!4-0mdrj8#8BBE&4PiYYS02TM
PmP3-LYc%TNUm3SkPq0JmI'B)(bCZ8PS0cl!P*M$(l&%-qc'F4+%84T0RZ$r5adf
@G&imeQG*pqMAkAN@)pBFlH2qcF2fj$SL'ShN$iUQ1eH&ckfa2Y-Bh%6rfcBGpcH
Sprd($2&YVl6aZ+r2p2Y6pGBqbdEFB8F%aM"R()$2AAF64rId+rQQ''rfjCGUEGf
BZKR,G3El4eLZI[TQIRb!ecZL1BTck-fEI$hhj'3j-eqibGrLL4F+qRY@IBHh1Lc
S6VjbNhYB+15+ZQViq)9205[+,Skm5eZY-QI$eDid1ARah-AIGrhXchB)+ccb`@*
bpKc19NCKBPq6d*9p0)cKHDIY5GpTZeA4lUlQkUmDBI`RYK)$JZNm0[+NHK`CT"(
X2FVHfdqF1irf5E%ppra0&'kGrkrREk13!1diG`N44Ik*dr'ULX*lrh4,T8,&UDZ
h8,"N2[Gbi5N8$$BE-9KZRA[14SAX3T5S`+8r)-iM`pKLKcrb$(m9,X$@b$0)mD*
1IipH5FEk)Mqr8)+-S+!4Ka-LL[HL!@"EKJmI0Y&[5G[lT%eEVhjk&1EjBeX5h`U
l)rVaHVXRSKqXYmI`kS2j86rH"mGD##HB0Zi!1MK+#@e"LJXERGHDd0&4$V'Mr*I
5e5kKX9L3!1e-BJPANM3!Gd3ZcaD3!)&lKYh@HMZACmhM6Zh[rd10SR-H3qCNPVm
SZK@K))BHRLES%5AdL%hb,,"I&&$4jU'V4Ai@`Bcf#&kP0[pC[3#JV!3$jXd!B(f
@k)*XHjbF&VR(Qk'1JfhY6`i")FY&KLq43h'XhUf2rG#(%)bp'DqNhImMR4,,e5N
4iI0Y(3*%ZMM!'3GDU-I*r@@N%FV*E+!Y%!D1SA!YiR&#Q+N-eV9-rI3&U0EFbKJ
mZ4q$SARN5D"V"S%63qM*kFrj@$'pr6%5am#3!"&$aU#KT#-V4e(mMUbhP5D-F6$
'Q`a&-"5K)8T++*3%%A%[%2M6N8BFaMJ3)fQkidcQ2KJ'%cPjKe2-%l82i5$m`pP
)LU,K$b9Re%qCZ[!8#@beZFJ@%F2VkVKp''lT%iPk"$5MGXmmr98%CFqffC1aqRH
A+GTBV%HI'djP'aa$5cS,!NC-I2c"$&,((C`F5N8MM1iJ#!&X(h2(K)#"d+BaM2!
j,4D1pkklYhrUhNml5%N8@d)N&MjqN!$F4ID&5(#T#5BT0a`mcUh5iMJY2KYBA*c
1`N+2q!i@@X@&M04TU*1jca+j$eMJ-SH4+jE)[F-!M!,!p`"B23"l4#)H)q+I6[5
2p,L#L"XCm4JM(K')`qM8P1KE!P'SJ'qVIa(q3G`64,ajT2%"ZV4VeBMV8q(D%[P
p),HI!GVN)-f2-k)a!,U,$T318MV3#SRiNL$LS(eIGaAa#R)#V!qc`%3F"XCQ'&@
XNAbdI@rCeP-@qm!&dE@#13*R#Sl!05X3EUeSq0"ZI$"MN!!C!mIphN`F[4%+F#-
6E(F&ZJ4AGlP%-qk-B$K-Rc@c0H034U*`r[eI8%`qH6#$`XYJ28)"$&`*$-iVM2f
)&0Bi))5[j+2S8S3&0!@Bbc#8q@#''XPpN!$#e)0mh&qlp1"a!U,f(c6M$K-F%Ji
i2G)LFQB2XdRQpBdVXF!``1VT!eK1NmErjYrL%-R&AGc)A"CR"Y$aT,$Yr@GGUcV
kHcXHl1I-p0qRdd9QU%Rh-JTZ9Jp2ZNR*RMMra-ZN[0EQKXG(1kj`YAGS)YqL&2V
mpQM-kLkTd#[q@+Dlj2D1jGcR[fpTYppA#TAL$GfS#V(M-[Im5@"4`T&5[Q2lE$-
#E&((TXC5'S!,RU[`6PG(GGqUACBf&(453EpU&ip"K0aFh8fL9+PBlF+`6qSHN3S
p%Y[6eIF5ffDaHJ$$&k4Z45VFNYLDUfm5fcUaqJb'mk6ZFe,KGY@89k3T#c"F)R9
IP!VCM1@'a(+(QC!!"&0p&SbVj1`GSDDjjh8Nekr$058kV,I#FELRPlS`''[S,Cb
"KMiD&*UaEE`MK)XqcJi%(5L,D')8K(0DQG)-pCRI%04RT4iG1j`80SY')Clb)JT
P34aI,T!!K8%BM0lcETYjP[IlJb%%Q'SDEHBjU*!!mHqDN!"jfRXfmdbB'M#apmE
+ii@Gp'(Hllhah['JiH6Cd-BlbPjdPG%J%X6-L3c@I4(6`-(!dS2"p`'@MKe"039
Zl5`X[ZL(%($,&N%FUdjk[mh#P$RiD2CqQc%P'C-a&EUV!RBk!lD&!6ZEJ2ACc!X
Z654XjRRTU#$@E'UKJ[FL#qa3#"-+qkCUB4#-#kSBIp5%dF3BC`Q$!$P*Nd2GjX,
N[XAQKCF+ZQcQcmUAi,@m[!A(Y!6(Y$5b'+%2MZj%SKI%mbeBBUk$S28@%pd-l9`
DA#J-3Ya"SCdVQE4!BJBEXD3k%k(bkBdZ'%YQNqX!1F`-3!cJbl"a$"bfb4r$K,)
%2p-hf-b9j5eil4-@H,m2BLYC85XJ#aaJSZrLmR5T(Kb@-)b!B"4J93@5Q""`6qf
+VZ2QP8$L([0RH'de,m9,-5rI8'!aQCIJ)f5HMYHRjKDm$TTRSi1E'r'K0mpL(62
a'M(2B4h69*YjTF28H(*5MbS6bC1&h,4"Epkh$8,)*e-EfXb9kb'XRi"c`!Qpql2
(),*[-*42aq"m$#ikdFB'NdN$0k*M550G&SFb#eIEd&EH`P"PQ)4AZLc3BbrE5*i
+lLrUlcUqmEUL"V%FDFT5ZijBK%-e!*N01"cm,$!X0YIKCq&JU(bRpbjHqlcAT9"
ChE2Cl2L0`L&54RdAl05TdQB'MTB0JXa4bQiNk[PZ`[4#KM'$3fa!"rYBik0LR"L
kEQkCCMk+c6Y+VM4NmV'6dGFBaP#A69i$aU4$l0+EMkTC,)-4!&8Lj1ip-ZpDTD8
%bJ*cN!#$c%%%L(BXB"5b$*!!q-h)5X&N3[&V[$dNDdJ-&qF,dbDbP'faN!"X1G8
+HrS,GZXCB`mr&32E'M$0IPb[c!*,6"+I66fpe+@X&&#8"&K5b'-S+#UZS[Uih3U
6Cj5-Mb4FQV8NB!SX")+P[Ur!iKX&FLJDZ*-NJj`&KU0G5,b-U#,6aD1Q%R)D1"G
'&B%i-piXJFT[TF9`1NMDNk0ReFh1P55`eJZ11%H`aDqLZY&Lmi&E-F1@3Gh$6e)
6AIY2[R&lM$SGHBdIiN!2T$)m,F)90F5m854Q)0Pb(0JB(9K#RdCie+YJHC`kiIU
E2j!!N8UNf-ATD(8q#[V5jQk$)H'Y"$N,5)P1H5*PEUN+lMmf8[H,*B)CJE+T41i
,#TKUT0!e"50(kM)253I13KqEbJD3!06+f04IPl&0XkB-416NCRE#%4JQKZT-r#c
VkS#"#N(R,TF8d)i5-SJG$"QD,Jc$0(88`D2N)+T@aGr[+TKilYc,fPKA`GP98bm
!S9)NR[E"2%8U+Z6&*C,4dU6Gr'qQLY08mVke)5e$#CQ-`$1!c"GN"ej6mXZ'qk`
KqDEli8'Ul"#5E9)K,48+T3)IY+6!-Ph!346*&-Vbf'%fP8IPPjR4**k18"JrqID
&$!6`*C-+NY*T$6EjPPeP6*Q8c$9eVCKl"FGj,i5CZQSVVM@!+af5c%flYRme`65
lp5db"FP*ZP`J'`VC$aR2+Q@mERCaLh4aK9em3(jCJa!X,[C-eG925B@`9$JM&5b
"UeZZXUYEF29kG[91q@8!Ib(iqNAHl9cIqH1[rim&)h8("ZMkQi`-KHY6drhL-Ph
32-T-CCc2&G"YlYbe2(a$B)RH0YP%@IE"K'4QaV*Y+-VfGPqrIC+51&PM9`'Q4TZ
*E$6,RQQbbFJR5G[2GQTEf5Y653U$'fbb6eX2CJ13!-dQZi"U0VP$fiIAK&BA3$Y
f!$kl"J6Rf$YTBZI3`9j82(#*+j!!*CG4eSJi`iZC`Pf(Mp1Np#V0U8[Y(#0!!@$
%&j+(cM!hM*`fU-JlUi*R-J)B5El1(Yd!JD@m8['MLC@U1U(D+"b!+$YHXd5-I2a
jIrd+2SkTGY,%QrI#I(kekR0R*-aI&(I#F*k%N4a&9VeKjl-VH*Jre)-LUf##*!9
,CX"i5L'fIa5BGQ[j3k`i)bFFk5epp"*9JQbRJAHT+J008H8fNM`UQ5+,dk4BlF6
86R+-LT8%9dBCTdT59BN*a,Sl!SUEMK#`jHrKjdJ)4bkHa'Y#2#&Xl%&XLhJDVfl
a-MTFiN*m1-9jH0d5&`J)-D2&`hfP-2"(fCDl8S'ICr9LKUr8RSNX0HT-iY9TE`D
486LN!h(&q3VX3B3Z6Mr!b@!Ej#H"9ET1`#!r`V*HGb"4)9-bQFd&jjrUBX'JE"V
&G*e-Q5XL8NNZ12"dSH+*YYZ(+c-8C4R$%Fp4N!#m1H(ZU6@%4&N6NK-!5b0H&`c
*-(XhrVL'&35[DmH%jMA3X&CcbDbG#d*Va1[5iD!CKQQLl[!dAbr#0dQ3!(p"YV#
'&Dl-V'P9cm#XKXD9@iaRHmQF,B![qi4XCh%(VP38EJpTTqJB!-4*C)immB4@Y`&
1qpSa[%jVkhfi$$Zq*,Ij13C+l4'`,8+Q3M8FV4((N!!")b%GHj38#FU!k&U)$)S
$#Kb1$aR)ILXG%V9)jPBLJ*)0XEhi2lI!H,e0YBRDiBjI03*Gka`ap5pNd%hmK@@
qX,J#BLLbh82A#)`H,),!"'F*XEJ"cLqfT3,*U0D`@$MiJ3a-9@drFl"Eb-*JU"B
bEK3C4qNjfrX'!hNpMQ!XB,3[KcTbE&rJf'UH9*28P)9,!S-(&J!B)@RMFR[!P#i
H*4@L+Pb(N!$q50e[@aRk0GZMj'3#B`#3!*-E!k)c*3qNVUcD`kpSG+89bM"6*&G
6dM*cfUJqr,RhI2J'Z4M@rKkZ"(rSkCh+U(+FcI+1qcjdcJjbcMa%$RF`9V$Q3c2
*Vb1TQ8Z"369dl-XZrE%[m,0LJfYMYX'fXG9JUmj"H1N+IMLDT8r`8lmY9$l$e#E
ZX-GJPDhfYr'R%GVHMm4kEfG)GU#`-[)BjrFFX%8RG9436*0&%,)3L$!0851@KU0
$1R5X!8h,LXXA"@CFe@U,MNS,4V&J)j))bb%JiKNimY'#"4LiFIN2)hADph`ADF'
P#ck!P9FYC%RY)CBCh$39$"aqDBT'harSF#mP`(b&-D2Ke5jKc+dd$CK,*I)r)PC
Kdd50!$)H2##!FJDSdCN18G-A[3+8(+2%X%Qc9ScYZ*d+B@h!SCC2DqS8@-U4)$R
bS%cMN!"+)-$KXV+M-+R5X6&Mm$d(`P``3%&B*b4mKT!!N!$#V&fpD*`QY$%KmiG
$f[VfV'q$(&#[UTV)50fK'YrG2%r%*[j&LbUC`X'8cjh+`*60T'JI@iiNrdF$'D5
XmQ@TTJFErdA$iQ-Vk%#1)6XFqa+&,mM4M5&QK+QA%D$,&cf,Mhe"TS)Q6S"@##2
0$A5e1"9rMb*3'+qAb%@[(Lk#%8-KEiFEB$-pm!$'A,Kdr3J"Y%-MkABq",!5!![
9D!29q1N3I$Gj,%p,46K1)jZ8'`11iD`jY$*MBBf[%)c9QRBHSkQ%#GK$&)CH+N#
9arDAb%@`(P1@![RQ5YN16GK-V`D"VN-V@D0998NH6IblpMK0kmL%fCK9pFLTFLH
%JY@-CS(%Qk6JeTS+[C)VbSpRBikBriD4A#E`F)US[CiF'[*H,5aN,Z-!6h!#dB`
(h'5C'8GJ(`-lBb,h#c)(1U8VL9pUq%"'X'XY1mL66PBC(qBm90Hh5`fP4(Bq((Z
dq+Pfk+K#*BS,m92'R$fd31SqE`DF+`U%!DT-LF'eE("ZC$kjlSLI1@G&jM1hRqA
1*A!5LpKeM(d[@,r,@0Z&!BQ%L)k$V)-D"Y(1(R4J1!RA"J6aP'E*r+Tp!BBBlKF
H+'*1+8NcbE(f'JH)j%Uq#`e@(6QPS%$KFP59P"F*lL4b$VNDNT-+'BFB'K[46)i
+3r,q9Zj,3RL*UNphjQreGh,D!-Ij2*8pB!3L)j&2EB,6PA)h`HY9"lPel+Tb8jS
VZ#Q"6C9!ZTFf`@NP9c6DPT3,%0XScYmK9b!NPbHfj`L8qceQbUfXQYV*MQjZP6Y
5TH$ZJki1iH,Q#MDG4Q#Nbc-(-B3pK5BLjH4$KPlKD-`,fC+)F'"Q,hdbB$Tp#01
S4ArrQS'B&0b0T%@251aAT'R2#CFeRi%lmPkqNicNJXU(V6R0R+,)l63ARcNS[)e
'ZjL#-*,,f0X`3cB2!pA34,mIP"NX%(6L3VBK!5MPPN0,i3J6F("1`T8QU54lHTA
C$Tj#GMP1e345&9LZm3)%!aZq4*8!M`HSm0dTMXI)E0%M@0[&a)S'Z!R'hB@FUKG
4*LL%+f%Fj[Tc)CJ$a*-(Tm6E!,d!S#Z8C6AFe`[hNRcQ%RI0EN`4h3+95#*k!@5
QiHGa,0iABX&@XB+4U`'C&JUl%KRRHVJp'C(`Q@Kk(16%50hqDXdiN33j9#Ak,Ki
9Jkj62!9Jmd3'Ueba,0KP1RA9dEP0rNqNR*mGr)0K04T)"R+IHS0,0!i*lV9*5P+
J20p4ZJ8AkmT)H"aC`)9(R-$pSjeIFFfiUaE"fA4)J`F$)I4!4TTkaN*'3d2ML@'
pJe8PJ!0-9X#P'C@,9J[*dVr@898DYS6F38'f+RN#XX,4&5#NT3S3+A-)!l12h-+
TfJ-fl*h*l`ceYUjc&b[eQ8EhBjGG[[km0EjqCj`HL0+!#N#h*JGZV,aaGCqLCPS
&"PXV'+b*6S(K,+Y3iG2R*Epjr4[6RjMa[eZHMlBE*cmC+PDmhjMZp!pmVUaTAcH
+!69qm[0+226KQ`prFVd5MmHi&%[(@B@5-lePc1'c1Cd&4e#UG$!3MNpNU&NR2rp
Qb98Z2JQ6qmlYEC*UR2c9k,+Uelq2PJ5lU,0!'Djj9Rq1UhpAr`l9YTSk"r&3'UL
Qb(JNU%A[3&L@QVmX5Zch96AE3*)$DjXfd%!e`C5`6jG9iA)QVd5RSi,H&@lUj9R
*AJ6ik[b'39f-*TK*9@8d+pKNU&3ZjKPX)J`3BUA2aC4kPm2kpq@VpP520YkBe+H
0JcT,Ql!-XYfAh%m$8-jRZQrUbHeX#!ea""e48YQ)B04+"K0P#X,[8'"a8I8`&Zh
qSjkj'q#&cj``((r8)+BjQKA"a)Z@%d!T`N9IN!$aJ-H$8Bl#5E5!+Y$4Bk"'m3%
EFL,iU!l(QKk9HjNe*1lj9fm*VJc"V()#eirBH,fiblCNE8MFEqVI)G+M&S#SR`r
T8D89#"ATjj%mDap-@'*P@5iYq`V,P!%D1"ICaiEm0LJRZpCDKi[FIhrdJ9Q,aCf
ME3T9NZ(LSh$#4q8e0'fS'VH@UdAZCBpQ0a+,RNMX+b%#C`Q3!,0S)&[keN@k88P
q9%hf&)1Y!T@8,dD+bDR5&LHP,RQS!)NiA4DZ"bj*`(i,9CjVX&"c5j2``af0hkY
I3iqb@"&m'&Vr6hmB4-cCZSD1C(HTb+iDVlTU(0I[")[H+B"d&5,NY$@kHm6P0R%
rBpj4aEa$h*AFcGZDEN[jPIr[E9NX6[XrfjLKi)hTC"[6fA4MKYki-6eXBkaA1#T
kAh@)MGdDIXAbDe[65aekqkHrP2V2MApVr&YL8Vkf$%GfR8fiP`(m)GKkqK2p+l)
,Qbql%[f6c*hfG,D5a%IbG(CLGbFEZTaGGr'5[kii$bjh24F&4%QK$!*p*i04a[m
CS8cN)KXbjI1cZjh6&@k1NaJV9Z#kILSJG,*lEVCa,VUV&9kcLbh&idCD$b"4HP)
`S*0a3Lk!)D1!URJqQMfT9cbM(ErG)qidR-*MTC!!m+jC)BSp[4-h)VeCIPYPbN3
ZK(l*+-3U58H%"f&XfN80pa@Hcrrk'b5dlXH,eBjhIq1*ZIm`p*hre&+hffjF@aV
T&d@R(pPk&"ArL`SX$mhhp9r+(-5@$4E4BlRiF,K%DNa1N!$`dY-pm2NA5)5IQ"I
X8ZrJ3f"Ufb1rBc992'*UicXD%kMY*(hm8Ip6I"VBCmP2qM3CK+)D9#9T"f[D*R&
aQ0STN!!DbCXXX2`k$a8G2)Pq((mf*6H6qVljh2V$AQkDiBVdalJ0CLPHTr1EA$[
%6VmMXR0arU&Tl+%DpfH[1KBe#89+TXK)D)q4NC!!YUE(*KHX[kXi09EPDV5)FhY
Bf#`NP6[a'!Lrm,RU506[Fk&jKfY53PV@9k,K5RX6GP-9ZfPll&89cYmA'#RlU2S
%,S,M2a*Fe4M9ijLD0QQ6me(T$Jri#mim[cbcrFccm1+UM"0$aQQKM%,KQ4dL5`V
QMZVleYhQ(UTbM+lp,![p&3Zfq@'Q')qdmD+VR"rGA@eC2kYYeLpMI14GHMJ!&Ym
BeIHi2(Mi#+m-$*d9KQB&KU#QNI#q6%S`QP-2#VVrJ4m@#`mZN!!BLjXQ'9Kd)cp
V#6,h9$F$MAAG4ee[)"*8BEq+Q$+52dL,NpfScS2PZpMb(rbdbf1"6iHPdHmT)8@
UTlHZpbUA[lJQ2AVXrZbAlNC0E2J)QI5&6&4c,kUk(K!H##"Abh2N#M%LkX8#SEU
l`Klq"A6B)hp*kX&J9J`"9RI*)%mE"GA&('1CX"G)rVdRCU8UUV-+VAh#eU0bPT'
bprm%SP2P#50c54MiI#9Pf[eTUZ`LLEFETb2a+4%$&D@4h5Y23%'-GYR%LZTjAEh
9#j%JUG8V0pJfCPF[-LbZIUpY6r8R9B)rJYj8A@"T!`(PJf',c%(915"6*i3RBI$
+&J3+CY$aerlhVZ0i"*!!6Gb,kSeiT@2HMdCHp8k-[!S!!!*#!*!$#J#3!h)!N!4
#H!T+RFj1ZJ!d6VS!*%*R5(N!!2rr5'm!"%KA5(J!!5)krpC1Y4!!)'d!E%k3!+R
d)MVrbQF%6V83!%je@Bm[2&T&8Np#CkQJ*&GCMbmm4%&838*RUD!J9b"3)RJ*##4
5B!ibf'B+-KTJ!N)C8FRrr,[*CZkTSkQM@Bm[2%4548a#CkQJ)&HJ*5"3iN!N$@!
'-KM9Y4!!8FMrq+QM6R8JAc)B0"L`@&I*rrT+3QIq6[!Jr#"I-KJd',#B9mRrqNT
#Crj1m#$k)&mb'$3BX%*Z#T!!3@d'd%""m!!#-""RrNl`!!!J,`!%,d%!"#)[!!J
[A`!%51Fm!#3!*J&)3X6$+!!U!8K&b-A84%K#N!2!`G##60m!2#)I6R8J,`!%,d%
!"#)[!!J[A`!%51Fa!%kk!*a-h`#-)Kp1G5![!!3[33!%)Lm!##pI!!4)jc%!6VS
!I#!"60m!M#)I6R8J,`!%,d%!"#)[!!J[A`!%51Fa!%kk!#a-h`#-)Kp1G5![!!3
[33!%)Lm!##pI!!4)jc%!6VS!$#!"60m!M#)I6R9+J'SF5S&U$%5!4)&1ZJ!J4)&
1G85!6VS!&N5!4)&1G8U"DJT%J8kk!!C%J%je,M`!!2rrXS"M"L)!F!"1GE#(BJb
!`8K!-J"#3%K!6R@bKf)D,J"#3%K!J-&)3%K(2J")4il"-!G)4c)(6R8N!#B"iSM
LLE+(B[L!`F#(-J2#`#i$5%I1`%K(dSGP#*+#BJ4%J8je8d"Jj%je!*!$A!#3!i!
!!!aB!*!$B!#3!b!!!$mm!!1Tm%&%3e)$!!"B$9-$R1S'YiZ&ElRP&ZjU#kJ&,-#
Y&VE`,r!YGe&Vp9i!!4lq2r+65hNQLaM%"%SP-R')#kJ$EAISXa!"!*!$#PM!!!`
!N!--!*!&I!!"!*!&D3"M!(d!R`3#6dX!N!Fp!'!!miKF9'KPFQ8JDA-JEQpd)'9
ZEh9RD#"bEfpY)'pZ)0*H-0-JG'mJBfpZG'PZG@8J9@j6G(9QCQPZCbiJ)%&Z)'&
NC'PdD@pZB@`JAM%JBRPdCA-JBA*P)'jPC@4PC#i!N!05!!%!N!9Y!'B!J3#L"!*
25`#3"33!5!"R!31)-P0[FR*j,#"LGA3JB5"NDA0V)(*PE'&dC@3JCA*bEh)J+&i
`+5"SBA-JEf0MGA*bC@3Z!*!$6!!#!*!&-3"R!%8!V33%8A9TG!#3"3S!8!!F!4#
)'P9Z8h4eCQCTEQFJGf&c)(0eBf0PFh0QG@`K!*!&#!!1!#J!,U!#!!%!N!0q!!%
!N!96!(-!C`#["!*25`#3"33!53"&!5k)A8&Z)'PdC@dJGf&c)'0[EA"bCA0cC@3
JGfPdD#"K)'ePG'K[C#"dD'&d)(4SDA-JGQ9bFfP[EL"[CL"dD'8JFf9XCLePH(4
bB@0dEh)JC'pPFb"ZEh3JD'&ZC'aP,J#3"&S!!3#3"9d!F!"a!+`%!Np,!*!(5J"
9!41)1P0[FR*j,L!J5@jcG'&XE'&dD@pZ)'0KEL"[EQaj)'*P)("PFQC[FQePC#"
[EL")4P-JGQpXG@ePFbi!N!0Z!!%!N!9S!(S!I!#f"!*25`#3"dJ!AJ%PL%j6Efe
P)'PdC@ec)(GPFQ8JFfYTF("PC#"LC@0KGA0P)(4SCANJBA*P)'j[G#"cGA"`Eh*
dC@3JBRNJG'KTFb"cC@aQ,@9iG(*KBh4[FLi!N!0D!!%!N!9G!(!!F3#X"!*25`#
3"dS!93%6L$T8D'8JCQPXC5$5AM$6)'eKH5"LC5"NB@eKCf9N,L!J8'aPBA0P)(9
cC5"TG#"hDA4S)'0KGA4TEfiZ!*!$+!!"!*!&c!#1!1!!dJ3)3fpZG'PZG@8!N!8
%!!3!``&L`!)$k!#3!``!+!!S!,B"(!3"998!N!--!#!!#!#L!4`!JP99!*!$$!"
L!*)!m!'B!)9993#3!``!+!!S!(8"2!#(998!N!--!%B!TJ#k!GB!KP99!*!$$!!
J!!J!SJ%F!)"993#3!``!+!!S!+i"6J#e998!N!-2!!)%)'pQ)!FJDA4PEA-Z!*!
$-33!J!#3!`-d,M!Q0#i`,#!!U5!a16N`,6Nf,#""E'&NC'PZ)&0jFh4PEA-X)%P
ZBbi!N!-D"!#!!*!$!c3Z-!p6G(9QCNPd)&0&35!d,M!!N!--#e9Z8h4eCQBJBA-
k!*!$#!FJCQpXC'9b!!!%-d&%3e)$!!Ch$9803b)5%HCHEK"N,4P%D[*%*!X3@DZ
Q*LHh2BZ-i(ERb%Qh-e2bQAph[qrELM`EhmbhY8#5eFlXbH4*f,ilNa'5j9ENLDc
)laq42j1IbEcCeRB454B6XMFYb5)S31)(rdjCKT&84$LS#cYiiLGf)5c5J1e3aD%
@GK*H(mq1D3bR6lpC+R)6)mRY[@4[%r6@hmf'R%[)+8FIZEr5&V,ejRAjaL3*5bP
Tf0kN&a@6NPGC,a$mi-RK`KFHI%V$*QM4BN6+hFfqTX2b,*5j55k)jb(*(2h&i)X
DJqim&Fee*9$cG*JIMZ6*i#SGjViNe#Xq)@+3!*h[`af,NK")heX@$ED[(5XhPA-
`LA1fRcbNbSE0RBqrZ,m'l)YVm[NQUD!A@)"Ck2@aqNDT+'b%UlJKdF4%D4j'8D8
QKLJRXm5(8JQR40@4X8N6+L,JmB-'82KL!,85ECR3J#8d%@TbLdfC`eLTT"qR$+a
eU)[Di0J#T6DMFe4B`aLflrdNJ-)Z!m3jBTLiESAmcl%RFHbLl9fAJNh,JDRU`pD
$+ZFdM(GdeX@!G"Z$#pDfYBXaSNc2)HBbh"2bA1lEQ20L2d(0f,[Q&#I)A'ZQ2(K
Bb@@qIDUNT-rSkShVZbh3b(2j4EE#Hi"%aD`5%YXK48JPi!JpjfESS#*')G-lpU&
Zma9#N6ZP%AF+hP-PhjBJ16hDlDNc*qDmR%1jlK@TB-cEfPh+FK[jplG1#3aZ,Gr
mP`rLNbG@J3Mpl)N"@`NmD#E1Ye,'NV,SJ&0-'N"4lGDH(L15jV)kGQArf*KLjXE
BBNT+ilSFVqIQ2L6S6,2!-qdr5A,SM5rZ8%e+qrrFIEa)TAK+(ePf3"KU9mH96Ke
iJM&J8-CCH2(UplHlTpQ8&pIV!mfS&!eYS22Y"H59K,,GX(5'$iDUN!!D1!1%4[D
m+R'd+EK+q$Ll6eBP[SHY1Jm&+*f0f9@c1LPl$U`!LB0EA#,N"l-#h9`&eEjM4Rf
XIVf`GZf$Y!rlJeGII3NEUUX[JA!5-Xp,Z*!!K9k#PFalib#6LH[)jR!53fYB8Y@
+#cA4e!fZkRA5eL(bC5reTB0Nq+`1N!#ULm1*SfpKL@KA(V8&MK(J'6fDpK)ZJ-$
X$'lTUd'pQXb1L-Hl60lqhlJ2YkIbbBfVNkBAI5lbXT26-1CCQI@i%dADZX@J'V(
"P$45$f-VG@mlh@!+D@pipZKGMr,CUC9ZcXXMqF'dI'XXGU%XA8IkajQ+#fPh$2A
j@FVRjqVrINKT#[0r9hl1a'Bar[EhjGLF9@FZ6fPZ&[UQ90aX9RVbi))fT0[hNY6
0m9Pip++5qIc2PqqBK`c8pE9GaLXRlhFHm(""&mY9YB2CTqfiUkZ$G385RX(1bd[
ERX3qk'4JZaVPpDGj!R%'T["3[!PH+Gc$PhJ`"hHqIVA3@F0Eeq31!!!",d&%3e)
$!!&Z$98,Sa,3(`,[MX0G"i1VS')4Q(4+"CeP@S'Clmb(SM82Ip(I(*K(D4A2I'$
q&[0K9K8c&"2&r$@V5EkTU*K9439&phSP6c(*!"1aC5A+J0LHE33'eM"R5Q-Af($
455FbMP!J*%5L5"VfFJe#ABTbVcRA4B@a96dp+RHhD`rFF&F@))QYk$RCaCMM3iY
@r'%I9"NNRi3H&+6Nb+Ekq,R[CKIQhmVFF$J`VdQ5m'YemhE`p&D5E6j5(VmrPl$
l$k3rXTPHl)!0@&jc$0ZABIP&mp&"JI!#DaENdTMml81I`#icTcGeq@6Upd1K&[m
+1ImYiqD1UMI2ikh!"rA+h@GFD3IbmLC@e9$jp9!k6JUl9a2!KP1+'B$U)Bc230$
[U!%J"*%91SCK"!!!#4G"4%05!`!1K3jG#k55),ibhjhrq-jHjTcIRm3X@FlH1F3
CSh%X80,b[R0QLXqEJ*aX40@UcFUD#%5Rl(e8JllrGqBa*dc)b``NKG+`*T5N3Y"
1UPMIThV[djD9N!!b0-6@8G9SS`-*3XV@EJZ,ppfG(@H&VG9l$HjZ05)#-d3M(d0
&9JkT3rK[IJhrMG+c8Cl(B+4U`aFMihF0N!#jkkJ(bAf)aK,IG)P[ca,IG-NC,*)
9Q2S@4ApLIjK&+S'Id[Z4`Ve!C&F!hk33*VJjb0NB50)-%!X)p`RCp6"I8pTh4UI
[+E8`dFID4ZkGr@lA$AQDlbldTY[ZH@,hr!+XiD9#H+cpQa8c%jVX(JTT(9@GRD&
+8bJflXSeSl4`5cY$Y5BUZhI&Y(p9rDdY9MhmA'a'S26RfD0D,'"MJPS)PR+'Y$*
IGS48-42MQe(`[2"&@fPYS(Z$2,ZVS#hMPle6m-bhq8GG`NZPN!#-)R+V%99PNPl
h36fhm*9bM*6G5(DLl6*[`RRN%1kYe0apJX"08h9pBpI"UeK@ZP%fDY[@f0f"j$F
B'16,"hmb'lqqr(ZIF,[qqr(8P4F2LPmU8Y6lJ@,C*HD'0C[m5%SlDaYhr0f9c5@
RlpTrl%Ba0h%pIrF&([T)hhCPQkhZV!V"p*ICGPYr00)ATYFTIIZZ+Zh!F'lqJ+R
pekRmf5JSrZ#`Jfc9YhilkVTHh9L([6AGJPqp[j5#5'i#SGl@1!l!f0$([Z4B9)J
pbTMr8K%pV8&b'lM9+a*8%hV&U'bb498Z@DQS*MRZ&3U9S9IX$jNN*bhPP@UI8TA
)Arc+eR608jlGh#RG(Y%mCIVZHjY0eR5&1qC1dXc90emD5,Ej@(eFD1XV&rqi5CR
VdF[i&43@eN[fU#"2lpYa(VlC*ZUUNZp0XGNQB,2*LUI#aR9CrBK0&Sp+b8*6C1J
9E63Tqf"5i25flDL4ELQ!0#R1JdB29[1P&-F&`EQV34i-5ZXME9iP2CJ#Sq!JM5U
KU,HpAUd@9Ujj,Ce3erhrA2Y0)fVEk2m'%q('2UUC%2HLD&+GqD$mXUXk4$HdCk9
'VaEk0mH(e6-fT4pmjRa9e3I09fm)JH',*UjGkCYBVDUp[eRI+)5dJF4`UL@ija2
YP0UeSHUUm2!Y1A!N#i,p%r+mraE)KC!!h)mYI"M-*-j`h-92m%VhR)6A)GbRK)!
S@)q!m3bE39ZF$L3#NlajP54K$2XaQX4Q&+bEm4`j1AMiN!!D$8bLH48j)NdQ4Zl
PFU1$$j(RK3$Nj8cC#bja3Z9@VceajE1aV$3CP1@85*e1e)0Q)jGcLA5!ibD49*Q
cdSUIb6+I1lrc$,UNCTa,i@!(l&NX8Z!UXl)Fc@N10p%$TmlaarF12*%VqVQP+Ib
mGAC[Z(*i4%i0ElMdXHT++-Ze+['9N53H0#4Y9,3%Ib#8d),3L422HK!GJGBFY,L
Yf`X9ljIeI"9HZ54kVCUF308$Ta+%AGi0FXiSpX5"dhYD$!,RQ3U0(P3fjfdBeq`
NrZ'e,erl6RVGI#'mVR"`phbT-2,3[')Sd$cb3&!%V`adK&KR!aa2Y%%,Z,h0rNH
#iVJi,$5IJe1*KV4GN8AeTLJdhii*%jh+4+0lL-6G`Gb!1(p'+l"R#Xqlj[FAI)G
0QQ+9i'Uh+QCdXfkhYb)Q$Qa("&X5L'&#mPXXm@0)Ucd%5eJUcINKX48pJ6d%PbS
*K&[ci9Z%V*(I3hJPL`MrdJSI3`D53``T(FqmS[EkqkCA(rKLZIm!-KZ&[1GiTPF
Gl*ZpSH[blmr0kANl3fU1pr3DII1R0R@Yr)*!qJH3!1C*GFpaYEH[Hmh&ZN*A@%M
6!%pD0diEiCSl$VHQjr`k#`[26@IZ9DI$daI6KAA2pN(q9D3Y+FMIp2MMdq%6Qbl
q,Td1hibPQPH&k,ZJH0C&,1fSJfdU0CD1i33[B404!YdjT'r8eK+UMqe@Db3GV(d
cl%e2@"m1dpJq%Rh(6&#9H,q%2[!CM`9RLm[r%li9iPZYi6IUKXJLDiC`*LQ1j@0
C1-R3A,AUd"L@,!$X'#)f9Q`GU4qjDTIlE$mqA(M5%LlfVkUm(4R$6f-Y*2qH0D6
p36il*,[YSYC3Ef@,rIqX9*l!Ebf0'B$Bc0CR("AbR`1@-IY,[Y#8e9pF9R&@mL*
83(aXZ8)Z"La%VB`"J[[p584Bj!eI5+Z3!-m'FQle8ke"Xl)9E+f!P-EiV3U5Rr1
e(UmFZASXGdNpP#jSPS%Mep04%N&XLQ8J!kB+PhfShJLZT1Hk&EZ'!AIMZcc23,,
Q+,p414k9S,B6,'a82bfhAaYETNrA%56ja02ZG*T5j4lME!"-qUA2Y$MMJiY4T!6
X@Z)k)D`B8d'!AjJ-cVeXTE3(16-(E(Pb4Q#Tj'@9#%5hl5$Glld`DH2L9KVmeH*
EFa9hpIDl1`$QYF(BlY&bTX2dqBA$reLmd2TDRl(Y0,(GBIAPhAX"rrC*9qj6Dcd
$H#M1@jc&$Y'NGA48bXlAXh*S@kH!Zkfbli`-Z2M"q(b&pHX4I'G4%de6YE9A(RA
@qh)a&f[!UpMFMmNq0q"eB[piVX)kEUcG1DPY3V0$`62A6#EC@@pc!%i&h!kia8U
MBYEe3)A945F$!Zi8m+KTci21HV%pT#rHl4bkG*dEl!9mF@EmL(@Qr)X@N!!HQJG
M-lYP`%2C`r@*QVC6V('0%["TN!#F,[k0%(eX#hU3!0aHNqRj@JSe6JF*I04KqTH
ADUE2Tc,B-J[*j9f1hMkq&-B!U*!!KfX`AB-8B"Ah@IS[4f&li'IQ$1CAe9if%ai
qGN!&Q%S4&CiQhDIf@FS1cNUjaA2YaBpQiQbY3i'CP4mCLmX+L8rILUK3`8dZHmj
aV0YkRM[jP2ccRlVip*4Me-qAPMjP-@A,$9P,I85&#Ulqe@iaGfcqU-aPXh*qlF1
-@ZZSlH5C1mA0TJqUQTkf2j&8)5`qd`4i3-FVSVN)cQ3YT[jL52V`9&+&J$mj!EM
GASjQX`p@2&,*6%A`c5D4[Tl00DT3H*AkL5leI''P)l9im[YlhCrhTp2DG*J[E4#
Y4L*[6e`je+K#q,'4%64@!PYK&Z!k%mV9AKd1kGd&SBA5Q+kqLIFl@5H@2&IJeq4
4!*!$'!!d!!!"(!&S!!%"!!%!N!8$k!#3!j3!N!-)!#!J!3!#!*!&('&eFh3!N!-
"4P*&4J#3"B"*3diM!*!&J!#3!`G"8&"-!*!&!3!!!3#3!`+!!!!%3!!!#5!!!"1
3!!!!*mJ!!%%%!!#"!J!"!!%!!JI!J!32i%!)''!J%"[m%#3DP!K-'[3NRc)%-N`
ek2NN05Jb%$Ii*!J`i!J%(q!3!J$!)!%$m%!!J!#!!%#"!!!JJJ!!%q3!!!R)!!!
%N!!!!!)J!!!"3!#3!i!!!!%!N!-$J!!!"m!!!!rJ!!!Im!!!2rJ!!(rm!!$rrJ!
"rrm!!rrrJ!Irrm!2rrrJ(rrrm$rrrrKrrrrmrj!$rRrrN!-rrrrq(rrrr!rrrrJ
(rrr`!rrri!(rrm!!rrq!!(rr!!!rrJ!!(r`!!!ri!!!(m!!!!q!!!!(!!*!$J!#
3"#!IU5!a16N`,6Nf)%&XB@4ND@iJ8hPcG'9YFb`J5@jM,J!!&8J!N!-"GJ"1F8U
$CKT"l3!J-,`!#$&m2c`!!M&m!!%!"$&mUI!!"Lm$,c`!!"5Q3IVrd0$m!+)[#%+
RB3!#*Ylm!""R%NU$C`4`!8je6Ud!)Q%!!pDTp%ja5S0Q!URdF!"1G@"b38a"4%4
$69!!!`#30&"b3@e)jf$`G$+I`Lp)!#!J6b*8-@N!&!!B)8!!*$&m!!%!,0+4)8%
!,U!#hm*-h`m'6R9+1!THC``J+J!)C``J3#!3C`B[1[q%6R9)jam'3IVrRR!-)LS
!"-+i!aTKT'B!!4*)H[q16VS%i&K2X(Vr@QB!!1bK'Li)##S!"J!%C`BJH!+QS"X
X+J!%+LS!#"JU!!5Ae*A8)$Vr9U%HCJ!!c#a))$Vr5L)'`VJ$'PK"B3$r8L!krd,
!Z!-D3IVr2L#!5S9Q"+%LB!3J4D!RCJ!!Q#T),cVr!Lmkr[S[1[lb,cVr!Lmkr[T
)H[m5,a!J1[m!8B""q[lf))!J$P#!3IVqk##!5(S!HQ%!#L6Hr!!J5N"R!URr)%k
J(b"(S"Yb!")%j`RM'H34!!%!)!)"!1!J6D"T!J!!(i!")%fJDYA8ep4"q[kB5T!
!C`K`!D'BF!1KQ#"0*8J!#(!!60pJq%je60pJq'!!rZ!J6U!IeG6Ae#"(S"X`1!)
J-F!+B*()B1"19J!!51F!1#KZ!!a(q[jD4IVq@L!8X**Y"#!5+)"+J'm5)&-LEJ!
)SLiJ&0'6NC*`!'!%-$crf8cI(!"1ANje6PEreNMR%aJX,J!35IVpmN)(S4SY52r
Q5Li!#fF')(J#TU!E,c`!!+$m6VS#RLe!rqTB6fF!!Ai[,[rU6VS"q%S!@%pR"R!
"B!!"FNKZrrK)E[rd5'lrlNkk!j)J,[rdS4iY52r`6qm!$'F!!8JJ,[riS4iY52r
mC`!"1LmZrrJ[#%kk!qC+VJ!88%pQ!!#8@Bm[2%024%9`!$m!U"mQAb!,ChiJ%h)
Bd)%[!%kk!Y`-3!!$@%pQDL!0FLM3J5e!rpSJ%h3Bd))Y32rH,`"1ZJ,`5-!Y32r
L)%ZJ+5!Zrpj3J#P!!#KCMbm,6VS3d#!IFL#3!)%T3!!X,blrr#mZrr3[,[r`,`B
[,J!-5'lriLmZrpT)H[kX6VS)9Lm,UD02l`!N+@lrkJ!-+@lrm!!3+@lrp!!8+@l
rr!!B,c`!!+'B6VS"L#e!rpB[2!!!U*p1ZJ&k)LlreV#"9X0%!dL$5--T3`!F+8B
!)#PZ!!`!*%Kkr*!!2cbJr#mm!!#Jr%kk!54BMam!6VS3@#mm!!#KQ%kk!6T+J%r
[!!aR"%kk%&B`1!&Di%!-3!!'CJK"qJ!D)FJ$2(i")'lrjU!E%!G-lKM)rm*1ANj
e6PB!!%MR!4K#"bmm!!#Jr%kk!2)S3#!-@%pR5#m-6VS!8%S!@%pR2#C-,bX!$$m
mS2`[2!!!S2a1ZJ#L@)mI!%kk$pBJD`!3S"mJD`!BS"m`1!&Di%!-3!!'CJC`!#(
!!caq!4!(61iBJ2rd6Pj1G8j@!!")ja!)+'i!#(B!$+a"6%&%!!*Q&!bX4%008!!
'CJT`!l"X!!TQ!RB"%!0-lK!)rrK1ANje6PB!!&Q22cbSER!"(`"1ZJp-@Bmr2+T
ZF!%I!%kk$ciJ(l#ICJB`2!)!B!3`2!3!6Pj1G8j@!!![!c!m#!$!EJ!+FJ!b!%U
"8X0%!fF%F!&J!R!!*Llrr%jH6R919J!!51FI!$iZ!!T)abm(6VVraKS!F!!3"3a
!!!&B6fB3!NF(rdkkrhb`4fi%F!"J+PQ22cbSRh!"(`"1ZJl#+"pCMcm((`91ZJk
f,"qiKPI$4!0R"(!!B!)J"NcZ!2Mrl%jH6R919J!!51F4#$iZ!!iJEJ!)+&"f!(!
!-"3-J!!!384Q,R!!-#`!!Jb!!!"$8QBJ$%IrrfFB)#`!"%*!5%$J5#)m!*!$rm+
!5-HqJ@B#GJ%3!dcZ%)Mrp%jH6R919J!!F2m[!%KZ!!K1Z[qB5J"36fFD)'i!##!
S!!4#3%K!i%JL2!#3!rr#J$!"B!*`rdjH6R919J!!F2m[!%KZ!!K1Z[pL5J"36fF
3)'i!##!m!2q3!m#S!!4J!R$r6Pj1G8j@!!")j`!B*Qi!%#KZ!!`JEJ!)-,`$!A!
!+)!'P!!!!53'P!!!!NJ'P!#3!b!'P!#3!i!'P!#3!i!'P!!!"*!!"T3!!!%N"T3
!!!53!!D8!*!$I!D8!!#!!#D!"T-!N!-N"T-!N!-J"T-!N!0)"T-!N!-qF!"-lKJ
!rrK1ANje6PErp%MR%aJQEJ!),8[rp!DZ!*!$*2rd+'lrp!DZ!*!$)2rd,@lrp2r
i"Ui!N!0)rr3YE[rdrr`'VJ#3!clrp#!Zrr53!+i!#,#Z!!aM"R"PB!!!X%*(3NC
J4R!!-!F-3!!%9F0%!fF%F!"J$(!!-!GCJ()%6VS0)R)!-JFAJ"J!F!!`"b"ZrrM
3J$''#!"`!$!(%$-)!()"iDRF36!(8NG`!$!($%!!*'@`3NGm!@"'F!!`"`a!!!&
9`d3$C`4`!'!-F!!`"e1!FJ*1ZJc-FJ!b"aQ!'!"`!$!()'lrr0#!-BB)!(!!-!F
30!J!FJ(KUGa"-!G54h!!-!F-3!!ICE"`!%cZ'-Mri%jH6R919[rm51F2'#CZ!!`
SEJ!83NCJ$R!!-!E3J%*d#!!`"P*'F!!`"R)!-Li!%Y+"XS"ZiN*'H!*J!!#D3N9
#4h!!-!BJEJ!)jB!YF!J!rraJE(!"`+lrr0j!F!!`"A)!-JCd!"3c'!"63NM#Y)"
[+(!!-!I3J()!-M3)!%U"CJa`!$!(d)!jK!J!9%4`!$!(d)!q0!J!B"K`!$!'FJ!
b,J!5dS(5J(!!-!I3J$Q"#!!`"9*&)#lrr1+),8$rr(!!-!9b!$)'G!!8-aJ!Y%"
LJM!'8NDmEJ!5C3$rBNcZ'2$rj%jH6R919J!!51F2'$iZ!!iQEJ!3+'i!#$JZ!"B
k"qC0F!!`"h`(c%"q!(!!-!830!J!l#Kb!")!F!(!!A)!%J$HJ5!(d)"b!$)c#!!
Z!9*'F!!`"R))XS"Q"N*'-!954A!!-!63J,#(BX"`!$!%d)!L"j+!%!&-lKM`rqK
1ANje6PB!!%MR$`Ji,J!52Li!$LKZ!!Jm"qC1F!!`"hS(bN"`!$!'IJ!H0!J!F!!
`"A)!-J65J1D*CbT6J@F@8i&Q)R!!-!C8J()!%M3)!%K"3N'1JA!!-!C5J()!%M3
)!1'*MS&`!$!&i+p`)*!!"(,ri+R#Kc!"61i3m2rX6Pj1G8j@rqT)j`mB*Qi!##K
Z!"!'VJ!!!53!&!DZ!!!#5!!8,@i!&2rd"Ui!N!-J!"3YEJ!8rrJ'VJ#3!i!!&#e
Z!"6rr"!6jJKb!")!F!I!!A)!%J"536e"rqS3%q))FJ!5!(!$`!&b!")!1!&84(!
"kDJp32rbF!!3%h*!`J"`!"!"28$rm(!"kDK6J$e!rqj`!"!6FJ(#!'F+F!!`,[r
Z8i"J!R$r28$rl(S)5Qlrm'G@,bi!&#mZrr4`!$!Zrr)[!#!,8S![!%kkrcKb!$)
!ji(D35mZ!"3[,[riF!!`,[rb,`![,[rd6VS)I#mZrra`!$!Zrr)[!#mZrr3[,[r
i6VVp)Nr[!$"#4f!!!2C+E[r`Cc*`!$!Zrr)[!#mZrra`!$!&,`![#dkkrGjm!"`
!F!!`"L"Zrr4b!")`#!$D38r[!""J'R!!-!3[!(!!-!8[!#m,6VVq,M`!fN42l`!
-['lrl'B3-!G54h)!-J"#0"J!B!!!MVaZrqjQG%TZrr"R-R!!-#lrmLm!,blrr(!
!-!8[!#m,6VVpF(`!(!"`!$!')'lrp()!%M!)!0T"6qm!%'!DF!!`"#m!F!!`"5m
!,`Y1Z[h!2!$D4%r[!!a@4Q!8F!!`"e1!FJ!b"aQd#!!B!$!(8NF`"P0'5N"Qj'!
5%!E3,[rV-JG54h3!0!%CJ#J![Qi!$Q8!r`C`!$!&AS$QL%cZ'2$rdNjH6R919[q
'51F2'#eZ!#6rj!DZ!*!$*!!N,@i!*2rd"Ui!N!-J!#3YEJ!NrqJ'VJ#3!dJ!*#e
Z!#6rq#CZ!"c@r!%Ne[`#50Em!#$@r!#!e[`!J#e,rpM@r!53!#e,rpc@r!%N,8[
ri0Em"*!!,8[rm0Em!(`Y5rr)er`!!)!!)!Z3!+i!(,#Z!#"M"R"PB!!&8RS!3NF
J,[r)d,`!!)!!,8$rc#KZrmJYI!!!J!$rr%KZrr`[,[r))'i!#%k3!%UZrra36fB
'F'GJ!!8B)!a5J,#ZrmaMC#e-rlSYE[r-rliJ$&+!N!#ZrliY32qf)#lrZT!!V[r
),8$rXL!Zrlk3!+lrZLe!rkjR$#"-)Qlrb#!ZrkkL,LKZrklCl[r)5'lrXLmZrmJ
JEJ!)6T!!)#lrXV#ZrlC36f3'F'GJ!!5U(9crah!!%#lradM!d)"63$e!rqa`!$!
Zrqc3J$e!rqiJEJ!3)"$3VJ!-,8$re#mZ!"`[,[rF5(J"*#m-6VVmG()!-J"+JGR
",bi!(#mZrpK)H!%N,blrh%kk"E`[,[rJ5(J"*#mZrp`[,[rB6VVkCLmZ!"`[,[r
FF!!`,[rX,`![$%kkr#jb!$)!5S(C`5mZ!"`[,[rBF!!`,[rX,`![,[rF6VS&FLm
Zrr"`!$!Zrq`[!#mZrp`[,[rB6VVk'(S!3NFYEJ!-rp"2l`"JB!!$X%*'B!!!Q(!
!-!G+J'Cd)!a5J,#ZrmaMC#e-rkBYE[r-rkSJ$&+!N!#ZrkSY32qL)#lrTT!!V[r
),8$rRL!ZrkU3!+lrTLe!rjTR$#"-)Qlrb#!ZrjUL,LKZrjVCl[r)5'lrRLmZrmJ
JEJ!)6T!!)#lrRV#Zrk*36f3'F'GJ!!0HHJ!D((i)F!(!KGa!F!!`"L"Zrq$3J$`
`#!$LM6!(8dG`!$!'$%!#5'8!rf!%4J*)F!!`"Ja!!3"N%#!Zrp"5V[r3)%!3KQ!
!!ZS%4J%!F!!`"L"ZrqM3J$J`#!"`!$!')'lrj()!%M!)!$e"rm*`!$!Zrm*+J'-
!!+*JH#!-8S#`V[r-Bf3Y62qQ,@lrc2qU)!a5J*!!V[qU,8$rSL!ZrkD3!+lrb#e
!rjiJ,[qUN!#ZrkBY32qDC``J6#*ZrmJJ,[qDSLiSE[qDfHlrb%KZrji[,[r))'i
!#%k3!#!Zrjk`V[qL8%pN"R"RB!!#G(!!%"c[U)U!8%G`!$!($%!!''-!rhj`)*!
!,[r$F[rJUF+&f%&`!$!Zrm,JVCjZrm*#4Q!!!*K`!$!(5S"QG#!-8S#`V[r-Bf3
Y62q5,@lrc2q@)!a5J*!!V[q@,8$rML!Zrj+3!+lrb#e!riSJ,[q@N!#Zrj)Y32q
'C``J6#*ZrmJJ,[q'SLiSE[q'fHlrb%KZriS[,[r))'i!#%k3!#!ZriU`V[q18%p
N"R"RB!!"b(S!'Kaq#(!"`)AF3(!!-!BJE[r`d)!m-!J!iSd`"e0(['lrlQ8!rf5
FE[rZF!!`"L"ZrrM3J$e`#!$ra(!!-!BJE[rdFJ!5-!J!28(r`R!!-#lr`NU!B`!
!T'"i)!a5J,#ZrmaMC#e-rkBYE[r-rkSJ$&+!N!#ZrkSY32qL)#lrTT!!V[r),8$
rRL!ZrkU3!+lrTLe!rjTR$#"-)Qlrb#!ZrjUL,LKZrjVCl[r)5'lrRLmZrmJJEJ!
)6T!!)#lrRV#Zrk*36f3'F'GJ!!$qF!!3(1qSLS"34h!!-!F-3!!BB`$rIR!JN!!
Zrm0brq#T`SA6E[r%F!!`,[r#i+fHE[r#F!!`,[r%5S!QE[r3Pm#hlJ!-C6BJE[r
38Ulrd"#E)'lrd&+Zrp!3Qb!Zrp"5V[r3)%!3Qf!+)'lrd&+Zrp!3Qc!%8d4+3'E
ZB&C@4#!Z!"M3VJ!8FJ!b,[r%*#lrd*5Z!!b5JLC!Pm&J$L"Zrp"5V[r3%*X`"&0
%5N4R$#!Z!"M3VJ!8X)YLiLCZ!!aJ#L"Zrp"5V[r3%*X`"&0%5N"QlL!Zrp#`V[r
8C3$m5#!Zrp#`V[r8C`4`Cf!3)#lrd*!!VJ!-)'i!%##!F!"-lKM`rfj1ANje6PB
!!%MR$aJQEJ!81#i!#LKZ!""J!!%`2!3q,J!18NDmEJ!1C"*`!$!'FJ!b""!d#!#
`0"J!CHC64lK(C"*`!$!(FJ!b""!d#!#`0"J!BZLq4Q0)F!!`"RS!'M3)!(!!-!G
b!$)''E3)!"J!F!!`"aQ&#!"`!$!'d)!k-`J!F!!`"p#!FJ!b"Y+"0l-)!"J!F!!
`"p#!0i8)!'##Z%GQ"P*%B!!!SR!!-!4k!"Sd#!"`!$!(FJ!b""Qd#!!B!(!!-!F
CK3J!F!!`"0#!1M-)!(!!-!I3J()!-J65J6Hc#!!B!(!!-!I3J$H&#!"`!$!(FJ!
b"*!!JA)!-Li!$R3!0!G5JT+#XS"M(Lm,,`a`!$!(,`"`!$!%,`"1Z[lQ1!G54%r
[!""J)#m,,`a`!$!Z!!i[!(!!-!G5J#m!6VVqa$e(!!j2l`!3F!!`,J!1FJ!b"*!
!JA)"XS"Y!2l!61iBm2rS6Pj1G8j@rra)j`mB+'i!&!DZ!!!"*!!8*Qi!&%*'B#"
`!$!')'i!#()!-JBCX!J!'!"`!$!'d)!hKJJ!-!C54VaZ!!jPfLm,,`a`!$!Z!!i
[!(!!,`"1Z[j)3NC2l`!3B!3`"P*'['i!$Q31F!!`"R)!%M3)!%U"CqK`!#e!rra
JGR!!-!C+J'-NF!!`"R)!%M3)!(!!-!C6J(3!&$3)!**#5-%J,[rmikJY32rmF!!
`"RJ!'$3)!#SZrraq!'!1)!IML()"`S@#J#i"iSd`"&0%5N"QkR!!-!E3J()!-M-
)!#"Z!"$PJ5'('!!`"P*')#lrr&+ZrrbmEJ!1CB4-lKM`rq41ANje)PmJAk!P,S"
U!N+A6Y%LAa)I-"p+!@F%TdCJ!U0',SK1d5*I%Km`(b"I5J&R"+C(B!+L4dl4)Pp
`!D'B6Y%L,`!%)#m!#%(k!!SbI!!#6[#5rQ!'6%%)!8je6VS!*#!"6R8L,`!%)#m
!#%(k!!SbI!!#6[#5rQ!)6%%)!F0!6R9+J'X85S&V"Nkk!%C1G85"6VS!2N5"6R9
%J%U"D`T1ZJ!`4)"%J8je4)&1ZJ!N4)"1G5)[!!3J,`!)3IS!#M*m!!*1m*,qB!K
-33!"`d"1G6m"5%&+3@BF)J"#38K"C`U#edK"5%!`!8K!J0mb!%*!5%"1G8K"2S)
[!c3!*J&b!8*!5%"Q$%K!-!*b!'!@dN&P%Y4#dB#`JfAdN!#$dN%)`3!!C1iQ(c3
I6R8!!!%!N!0AHJ!!9RS!!!*k!3,f[$J`!*!$(!*U!"&%394"!*!$NPT&8Nm!N!1
H4&*&6!#3!kT$6d4&!!-!YP0*@N8!N!2Q4%P86!!(!2*"6&*8!!B"8P088L-!!!'
QGQ9bF`!"!E*69&)J!!%"bP"cCA3!!!(L8%P$9!!"!Hj%6%p(!!!#"NCPBA3!!!)
53Nj%6!!!!Kj'8N9'!!!#+NP$6L-!!!)fBA9cG!!!!N)!!2rr+!#3#Irr#!!#M!#
3"[rr+!!#[`#3"3,rrcJ!!X-"![DF!!(rra`!+SB"![D!!!$rrbJ!,-`"![A-!!2
rr`!!35i"![A3rj!%!!!Y,!#3"!3"rrmJ!#dk!*!&KIrr*!!YZJ%#pR3!Krrr!!!
Z%!#3"BErrb3!,Q!"![C-!)$rr`!!,Z)!N!@errmJ!#p!!*!&J[rr!!![XJ#3"!2
SrrmJ!$!3!*!%"!(rrb!!-$`!N!@#rrmJ!$"-!*!&KIrr*!!`A!%#pP`!Krrr)!!
`E!#3"BErrb3!-(`"![CB!)$rrb!!-)`!N!@"rrmJ!$#F!*!&J2rr!!!`V!#3"3(
rrb!!-,m!N!8#rrmJ!$$d!*!%!J#3!b!!-4)!N!3#!3!()!!a)J#3"B$rr`!!-5i
!N!9rrrm!!$9P!*!%!qMrr`!!0TJ!N!3$k2rr)!!rX`#3"[rr)!!rc`#3"B$rr`!
!2pX!N!@!rrm!!$rl!*!&J2rr)!"!"J#3"[rr!!""#J#3"!C`FQpYF(3)a#"cG@C
QDAM(93:

Deleted mac/tkMacProlog.c.

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
/* 
 * tkMacProlog.c --
 *
 *	Implements a method on the Macintosh to get the prolog
 *	from the resource fork of our application (or the shared
 *	library).
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacProlog.c 1.6 97/05/21 10:01:07
 */

#include "tkInt.h"
#include "tclMacInt.h"
#include <Resources.h>

/*
 *--------------------------------------------------------------
 *
 * TkGetNativeProlog --
 *
 *	Locate and load the postscript prolog from the resource
 *	fork of the application.  If it can't be found then we
 *	will try looking for the file in the system folder.
 *
 * Results:
 *	A standard Tcl Result.  If everything is OK the prolog
 *	will be located in the result string of the interpreter.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

int
TkGetNativeProlog(
    Tcl_Interp *interp)		/* Places the prolog in the result. */
{
    Handle resource;
    char *stringPtr;
    int releaseIt;
    

    resource = Tcl_MacFindResource(interp, 'TEXT', "prolog", -1,
        NULL, &releaseIt);
			    
    if (resource != NULL) {
	stringPtr = Tcl_MacConvertTextResource(resource);
	Tcl_SetResult(interp, stringPtr, TCL_DYNAMIC);
        if (releaseIt) {            
            ReleaseResource(resource);
        }
        return TCL_OK;
    } else {
	return TkGetProlog(interp);
    }
}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


























































































































Changes to mac/tkMacRegion.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkMacRegion.c --
 *
 *	Implements X window calls for manipulating regions
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacRegion.c 1.9 96/12/03 11:46:50
 */

#include "tkInt.h"
#include "X.h"
#include "Xlib.h"

#include <Windows.h>










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkMacRegion.c --
 *
 *	Implements X window calls for manipulating regions
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacRegion.c,v 1.1.4.1 1998/09/30 02:18:14 stanton Exp $
 */

#include "tkInt.h"
#include "X.h"
#include "Xlib.h"

#include <Windows.h>

Changes to mac/tkMacResource.r.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tkMacResources.r --
 *
 *	This file creates resources for use in a simple shell.
 *	This is designed to be an example of using the Tcl/Tk 
 *	libraries in a Macintosh Application.
 *
 * Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacResource.r 1.35 97/11/03 17:16:34
 */

/*
 * We define SystemSevenOrLater so that our dialogs may use the 
 * auto center feature.
 */
#define SystemSevenOrLater 1













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tkMacResources.r --
 *
 *	This file creates resources for use in a simple shell.
 *	This is designed to be an example of using the Tcl/Tk 
 *	libraries in a Macintosh Application.
 *
 * Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacResource.r,v 1.1.4.2 1998/09/30 02:18:14 stanton Exp $
 */

/*
 * We define SystemSevenOrLater so that our dialogs may use the 
 * auto center feature.
 */
#define SystemSevenOrLater 1
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
 * require some predetermined file structure - all needed Tcl "files"
 * are located within the application.  To source a file for the
 * resource fork the source command has been modified to support
 * sourcing from resources.  In the below case "source -rsrc {Init}"
 * will load the TEXT resource named "Init".
 */

read 'TEXT' (0, "Init", purgeable, preload) 
	":::tcl" TCL_VERSION ":library:init.tcl";
read 'TEXT' (1, "History", purgeable, preload) 
	":::tcl" TCL_VERSION ":library:history.tcl";
read 'TEXT' (2, "Word", purgeable,preload) 
	":::tcl" TCL_VERSION ":library:word.tcl";

read 'TEXT' (10, "tk", purgeable, preload) "::library:tk.tcl";
read 'TEXT' (11, "button", purgeable, preload) "::library:button.tcl";
read 'TEXT' (12, "dialog", purgeable, preload) "::library:dialog.tcl";
read 'TEXT' (13, "entry", purgeable, preload) "::library:entry.tcl";
read 'TEXT' (14, "focus", purgeable, preload) "::library:focus.tcl";
read 'TEXT' (15, "listbox", purgeable, preload) "::library:listbox.tcl";
read 'TEXT' (16, "menu", purgeable, preload) "::library:menu.tcl";
read 'TEXT' (17, "optionMenu", purgeable, preload) "::library:optMenu.tcl";
read 'TEXT' (18, "palette", purgeable, preload) "::library:palette.tcl";
read 'TEXT' (19, "scale", purgeable, preload) "::library:scale.tcl";
read 'TEXT' (20, "scrollbar", purgeable, preload) "::library:scrlbar.tcl";
read 'TEXT' (21, "tearoff", purgeable, preload) "::library:tearoff.tcl";
read 'TEXT' (22, "text", purgeable, preload) "::library:text.tcl";
read 'TEXT' (23, "tkerror", purgeable, preload) "::library:bgerror.tcl";
read 'TEXT' (24, "Console", purgeable, preload) "::library:console.tcl";
read 'TEXT' (25, "msgbox", purgeable, preload) "::library:msgbox.tcl";
read 'TEXT' (26, "comdlg", purgeable, preload) "::library:comdlg.tcl";
read 'TEXT' (27, "prolog", purgeable, preload) "::library:prolog.ps";


/*
 * The following resource is used when creating the 'env' variable in
 * the Macintosh environment.  The creation mechanisim looks for the
 * 'STR#' resource named "Tcl Environment Variables" rather than a
 * specific resource number.  (In other words, feel free to change the
 * resource id if it conflicts with your application.)  Each string in







|
<
<
<
<
<


















<
<







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
 * require some predetermined file structure - all needed Tcl "files"
 * are located within the application.  To source a file for the
 * resource fork the source command has been modified to support
 * sourcing from resources.  In the below case "source -rsrc {Init}"
 * will load the TEXT resource named "Init".
 */

#include "tclMacTclCode.r"






read 'TEXT' (10, "tk", purgeable, preload) "::library:tk.tcl";
read 'TEXT' (11, "button", purgeable, preload) "::library:button.tcl";
read 'TEXT' (12, "dialog", purgeable, preload) "::library:dialog.tcl";
read 'TEXT' (13, "entry", purgeable, preload) "::library:entry.tcl";
read 'TEXT' (14, "focus", purgeable, preload) "::library:focus.tcl";
read 'TEXT' (15, "listbox", purgeable, preload) "::library:listbox.tcl";
read 'TEXT' (16, "menu", purgeable, preload) "::library:menu.tcl";
read 'TEXT' (17, "optionMenu", purgeable, preload) "::library:optMenu.tcl";
read 'TEXT' (18, "palette", purgeable, preload) "::library:palette.tcl";
read 'TEXT' (19, "scale", purgeable, preload) "::library:scale.tcl";
read 'TEXT' (20, "scrollbar", purgeable, preload) "::library:scrlbar.tcl";
read 'TEXT' (21, "tearoff", purgeable, preload) "::library:tearoff.tcl";
read 'TEXT' (22, "text", purgeable, preload) "::library:text.tcl";
read 'TEXT' (23, "tkerror", purgeable, preload) "::library:bgerror.tcl";
read 'TEXT' (24, "Console", purgeable, preload) "::library:console.tcl";
read 'TEXT' (25, "msgbox", purgeable, preload) "::library:msgbox.tcl";
read 'TEXT' (26, "comdlg", purgeable, preload) "::library:comdlg.tcl";



/*
 * The following resource is used when creating the 'env' variable in
 * the Macintosh environment.  The creation mechanisim looks for the
 * 'STR#' resource named "Tcl Environment Variables" rather than a
 * specific resource number.  (In other words, feel free to change the
 * resource id if it conflicts with your application.)  Each string in
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
 * the Apple menu.  This dialog may be overridden by defining a Tcl procedure
 * with the name of "tkAboutDialog".  If this procedure is defined the
 * default dialog will not be shown and the Tcl procedure is expected to
 * create and manage an About Dialog box.
 */
 
resource 'DLOG' (128, "Default About Box", purgeable) {
    {85, 107, 243, 406}, dBoxProc, visible, goAway, 0,
     128, "", centerMainScreen
};

resource 'DITL' (128, "About Box", purgeable) {
    {
	{128, 128, 148, 186}, Button	    {enabled, "Ok"},
	{ 14, 108, 117, 310}, StaticText    {disabled, 
	    "Wish - Windowing Shell" "\n" "based on Tcl " 
	    TCL_PATCH_LEVEL " & Tk " TK_PATCH_LEVEL "\n\n" "Ray Johnson" "\n"

	    "Sun Microsystems Labs" "\n" "[email protected]"},	    

        { 11,  24, 111,  92}, Picture  {enabled, 128}
    }
};

data 'PICT' (128) {
	$"13A4 0000 0000 0064 0044 0011 02FF 0C00"
	$"FFFE 0000 0048 0000 0048 0000 0000 0000"
	$"0064 0044 0000 0000 0001 000A 0000 0000"







|





|
|

|
>
|
>
|







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
 * the Apple menu.  This dialog may be overridden by defining a Tcl procedure
 * with the name of "tkAboutDialog".  If this procedure is defined the
 * default dialog will not be shown and the Tcl procedure is expected to
 * create and manage an About Dialog box.
 */
 
resource 'DLOG' (128, "Default About Box", purgeable) {
    {85, 107, 260, 412}, dBoxProc, visible, goAway, 0,
     128, "", centerMainScreen
};

resource 'DITL' (128, "About Box", purgeable) {
    {
	{143, 147, 167, 201}, Button	    {enabled, "Ok"},
	{ 14, 108, 137, 314}, StaticText    {disabled, 
	    "Wish - Windowing Shell" "\n" "based on Tcl " 
	    TCL_PATCH_LEVEL " & Tk " TK_PATCH_LEVEL "\n\n" 
            "Ray Johnson & Jim Ingham" "\n"
	    "Sun Microsystems Labs" "\n" "[email protected]"
            "\n" "[email protected]"},	    
        { 19,  24, 119,  92}, Picture  {enabled, 128}
    }
};

data 'PICT' (128) {
	$"13A4 0000 0000 0064 0044 0011 02FF 0C00"
	$"FFFE 0000 0048 0000 0048 0000 0000 0000"
	$"0064 0044 0000 0000 0001 000A 0000 0000"

Changes to mac/tkMacScale.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkMacScale.c --
 *
 *	This file implements the Macintosh specific portion of the 
 *	scale widget.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacScale.c 1.3 96/10/17 13:16:18
 */

#include "tkScale.h"
#include "tkInt.h"
#include <Controls.h>
#include "tkMacInt.h"












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkMacScale.c --
 *
 *	This file implements the Macintosh specific portion of the 
 *	scale widget.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacScale.c,v 1.1.4.1 1998/09/30 02:18:15 stanton Exp $
 */

#include "tkScale.h"
#include "tkInt.h"
#include <Controls.h>
#include "tkMacInt.h"

Changes to mac/tkMacScrlbr.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkMacScrollbar.c --
 *
 *	This file implements the Macintosh specific portion of the scrollbar
 *	widget.  The Macintosh scrollbar may also draw a windows grow
 *	region under certain cases.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacScrlbr.c 1.9 96/12/10 20:04:39
 */

#include "tkScrollbar.h"
#include "tkMacInt.h"
#include <Controls.h>

/*












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkMacScrollbar.c --
 *
 *	This file implements the Macintosh specific portion of the scrollbar
 *	widget.  The Macintosh scrollbar may also draw a windows grow
 *	region under certain cases.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacScrlbr.c,v 1.1.4.1 1998/09/30 02:18:15 stanton Exp $
 */

#include "tkScrollbar.h"
#include "tkMacInt.h"
#include <Controls.h>

/*

Changes to mac/tkMacSend.c.

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
/* 
 * tkMacSend.c --
 *
 *	This file provides procedures that implement the "send"
 *	command, allowing commands to be passed from interpreter
 *	to interpreter.  This current implementation for the Mac
 *	has most functionality stubed out.
 *



















 * Copyright (c) 1989-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacSend.c 1.7 96/12/03 11:48:27
 */


#include "tkPort.h"
#include "tkInt.h"




     /* 
      * The following structure is used to keep track of the
      * interpreters registered by this process.
      */

typedef struct RegisteredInterp {
    char *name;			/* Interpreter's name (malloc-ed). */
    Tcl_Interp *interp;		/* Interpreter associated with
				 * name. */
    TkWindow *winPtr;		/* Main window for the application. */
    struct RegisteredInterp *nextPtr;
    /* Next in list of names associated
     * with interps in this process.
     * NULL means end of list. */
} RegisteredInterp;

static RegisteredInterp *registry = NULL;
/* List of all interpreters
 * registered by this process. */

/*
 * A registry of all interpreters for a display is kept in a
 * property "InterpRegistry" on the root window of the display.
 * It is organized as a series of zero or more concatenated strings
 * (in no particular order), each of the form
 * 	window space name '\0'
 * where "window" is the hex id of the comm. window to use to talk








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

|




|


>


>
>
>










<






<
<
<
<







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
/* 
 * tkMacSend.c --
 *
 *	This file provides procedures that implement the "send"
 *	command, allowing commands to be passed from interpreter
 *	to interpreter.  This current implementation for the Mac
 *	has most functionality stubed out.
 *
 *	The current plan, which we have not had time to implement, is
 *	for the first Wish app to create a gestalt of type 'WIsH'.
 *	This gestalt will point to a table, in system memory, of
 *	Tk apps.  Each Tk app, when it starts up, will register their
 *	name, and process ID, in this table.  This will allow us to 
 *	implement "tk appname".
 *
 *	Then the send command will look up the process id of the target
 *	app in this table, and send an AppleEvent to that process.  The
 *	AppleEvent handler is much like the do script handler, except that
 *      you have to specify the name of the tk app as well, since there may
 *	be many interps in one wish app, and you need to send it to the
 *	right one.
 *
 *	Implementing this has been on our list of things to do, but what
 *	with the demise of Tcl at Sun, and the lack of resources at 
 *	Scriptics it may not get done for awhile.  So this sketch is
 *	offered for the brave to attempt if they need the functionality...
 *
 * Copyright (c) 1989-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacSend.c,v 1.1.4.2 1998/09/30 02:18:16 stanton Exp $
 */

#include <Gestalt.h>
#include "tkPort.h"
#include "tkInt.h"

EXTERN int		Tk_SendObjCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));

     /* 
      * The following structure is used to keep track of the
      * interpreters registered by this process.
      */

typedef struct RegisteredInterp {
    char *name;			/* Interpreter's name (malloc-ed). */
    Tcl_Interp *interp;		/* Interpreter associated with
				 * name. */

    struct RegisteredInterp *nextPtr;
    /* Next in list of names associated
     * with interps in this process.
     * NULL means end of list. */
} RegisteredInterp;





/*
 * A registry of all interpreters for a display is kept in a
 * property "InterpRegistry" on the root window of the display.
 * It is organized as a series of zero or more concatenated strings
 * (in no particular order), each of the form
 * 	window space name '\0'
 * where "window" is the hex id of the comm. window to use to talk
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
				 * read. */
    int locked;			/* Non-zero means that the display was
				 * locked when the property was read in. */
    int modified;		/* Non-zero means that the property has
				 * been modified, so it needs to be written
				 * out when the NameRegistry is closed. */
    unsigned long propLength;	/* Length of the property, in bytes. */
    char *property;		/* The contents of the property.  See format

				 * above;  this is *not* terminated by the
				 * first null character.  Dynamically
				 * allocated. */
    int allocedByX;		/* Non-zero means must free property with
				 * XFree;  zero means use ckfree. */
} NameRegistry;

     /*
      * When a result is being awaited from a sent command, one of
      * the following structures is present on a list of all outstanding
      * sent commands.  The information in the structure is used to
      * process the result when it arrives.  You're probably wondering
      * how there could ever be multiple outstanding sent commands.
      * This could happen if interpreters invoke each other recursively.
      * It's unlikely, but possible.
      */

typedef struct PendingCommand {
    int serial;			/* Serial number expected in
				 * result. */
    TkDisplay *dispPtr;		/* Display being used for communication. */
    char *target;		/* Name of interpreter command is
				 * being sent to. */
    Window commWindow;		/* Target's communication window. */
    Tk_TimerToken timeout;	/* Token for timer handler used to check
				 * up on target during long sends. */
    Tcl_Interp *interp;		/* Interpreter from which the send
				 * was invoked. */
    int code;			/* Tcl return code for command
				 * will be stored here. */
    char *result;		/* String result for command (malloc'ed),
				 * or NULL. */
    char *errorInfo;		/* Information for "errorInfo" variable,
				 * or NULL (malloc'ed). */
    char *errorCode;		/* Information for "errorCode" variable,
				 * or NULL (malloc'ed). */
    int gotResponse;		/* 1 means a response has been received,
				 * 0 means the command is still outstanding. */
    struct PendingCommand *nextPtr;
       /* Next in list of all outstanding
	* commands.  NULL means end of
	* list. */
} PendingCommand;

static PendingCommand *pendingCommands = NULL;
/* List of all commands currently
 * being waited for. */

     /*
      * The information below is used for communication between processes
      * during "send" commands.  Each process keeps a private window, never
      * even mapped, with one property, "Comm".  When a command is sent to
      * an interpreter, the command is appended to the comm property of the
      * communication window associated with the interp's process.  Similarly,







|
>
|
|
<




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

|
|
|







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
				 * read. */
    int locked;			/* Non-zero means that the display was
				 * locked when the property was read in. */
    int modified;		/* Non-zero means that the property has
				 * been modified, so it needs to be written
				 * out when the NameRegistry is closed. */
    unsigned long propLength;	/* Length of the property, in bytes. */
    char *property;		/* The contents of the property, or NULL
				 * if none.  See format description above;
				 * this is *not* terminated by the first
				 * null character.  Dynamically allocated. */

    int allocedByX;		/* Non-zero means must free property with
				 * XFree;  zero means use ckfree. */
} NameRegistry;










static initialized = false;	/* A flag to denote if we have initialized yet. */



























static RegisteredInterp *interpListPtr = NULL;
/* List of all interpreters
 * registered by this process. */

     /*
      * The information below is used for communication between processes
      * during "send" commands.  Each process keeps a private window, never
      * even mapped, with one property, "Comm".  When a command is sent to
      * an interpreter, the command is appended to the comm property of the
      * communication window associated with the interp's process.  Similarly,
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232

/*
 * Forward declarations for procedures defined later in this file:
 */

static int		AppendErrorProc _ANSI_ARGS_((ClientData clientData,
				XErrorEvent *errorPtr));
static void		AppendPropCarefully _ANSI_ARGS_((Display *display,
				 Window window, Atom property, char *value,
				 int length, PendingCommand *pendingPtr));
static void		DeleteProc _ANSI_ARGS_((ClientData clientData));
static void		RegAddName _ANSI_ARGS_((NameRegistry *regPtr,
				char *name, Window commWindow));
static void		RegClose _ANSI_ARGS_((NameRegistry *regPtr));
static void		RegDeleteName _ANSI_ARGS_((NameRegistry *regPtr,
	      		        char *name));
static Window		RegFindName _ANSI_ARGS_((NameRegistry *regPtr,
				char *name));
static NameRegistry *	RegOpen _ANSI_ARGS_((Tcl_Interp *interp,
			     TkWindow *winPtr, int lock));
static void		SendEventProc _ANSI_ARGS_((ClientData clientData,
							   XEvent *eventPtr));
static int		SendInit _ANSI_ARGS_((Tcl_Interp *interp,
			      TkWindow *winPtr));
static Bool		SendRestrictProc _ANSI_ARGS_((Display *display,
			      XEvent *eventPtr, char *arg));
static int		ServerSecure _ANSI_ARGS_((TkDisplay *dispPtr));
static void		TimeoutProc _ANSI_ARGS_((ClientData clientData));
static int		ValidateName _ANSI_ARGS_((TkDisplay *dispPtr,
			     char *name, Window commWindow, int oldOK));








<
<
<












|
<







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

/*
 * Forward declarations for procedures defined later in this file:
 */

static int		AppendErrorProc _ANSI_ARGS_((ClientData clientData,
				XErrorEvent *errorPtr));



static void		DeleteProc _ANSI_ARGS_((ClientData clientData));
static void		RegAddName _ANSI_ARGS_((NameRegistry *regPtr,
				char *name, Window commWindow));
static void		RegClose _ANSI_ARGS_((NameRegistry *regPtr));
static void		RegDeleteName _ANSI_ARGS_((NameRegistry *regPtr,
	      		        char *name));
static Window		RegFindName _ANSI_ARGS_((NameRegistry *regPtr,
				char *name));
static NameRegistry *	RegOpen _ANSI_ARGS_((Tcl_Interp *interp,
			     TkWindow *winPtr, int lock));
static void		SendEventProc _ANSI_ARGS_((ClientData clientData,
							   XEvent *eventPtr));
static int		SendInit _ANSI_ARGS_((Tcl_Interp *interp));

static Bool		SendRestrictProc _ANSI_ARGS_((Display *display,
			      XEvent *eventPtr, char *arg));
static int		ServerSecure _ANSI_ARGS_((TkDisplay *dispPtr));
static void		TimeoutProc _ANSI_ARGS_((ClientData clientData));
static int		ValidateName _ANSI_ARGS_((TkDisplay *dispPtr,
			     char *name, Window commWindow, int oldOK));

261
262
263
264
265
266
267


























































































268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293









294



















295

296

297



















































































298
299
300
301
302
303
304
				 * to be named:  it is just used to identify
				 * the application and the display.  */
    char *name)			/* The name that will be used to
				 * refer to the interpreter in later
				 * "send" commands.  Must be globally
				 * unique. */
{


























































































    return name;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_SendCmd --
 *
 *	This procedure is invoked to process the "send" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_SendCmd(
    ClientData clientData,		/* Information about sender (only
					 * dispPtr field is used). */
    Tcl_Interp *interp,			/* Current interpreter. */
    int argc,				/* Number of arguments. */









    char **argv)			/* Argument strings. */



















{

    Tcl_SetResult(interp, "Send not yet implemented", TCL_STATIC);

    return TCL_ERROR;



















































































}

/*
 *----------------------------------------------------------------------
 *
 * TkGetInterpNames --
 *







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





|














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







240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359

360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
				 * to be named:  it is just used to identify
				 * the application and the display.  */
    char *name)			/* The name that will be used to
				 * refer to the interpreter in later
				 * "send" commands.  Must be globally
				 * unique. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    Tcl_Interp *interp = winPtr->mainPtr->interp;
    int i, suffix, offset, result;
    int createCommand = 0;
    RegisteredInterp *riPtr, *prevPtr;
    char *actualName;
    Tcl_DString dString;
    Tcl_Obj *resultObjPtr, *interpNamePtr;
    char *interpName;

    if (!initialized) {
	SendInit(interp);
    }

    /*
     * See if the application is already registered; if so, remove its
     * current name from the registry. The deletion of the command
     * will take care of disposing of this entry.
     */

    for (riPtr = interpListPtr, prevPtr = NULL; riPtr != NULL; 
	    prevPtr = riPtr, riPtr = riPtr->nextPtr) {
	if (riPtr->interp == interp) {
	    if (prevPtr == NULL) {
		interpListPtr = interpListPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = riPtr->nextPtr;
	    }
	    break;
	}
    }

    /*
     * Pick a name to use for the application.  Use "name" if it's not
     * already in use.  Otherwise add a suffix such as " #2", trying
     * larger and larger numbers until we eventually find one that is
     * unique.
     */

    actualName = name;
    suffix = 1;
    offset = 0;
    Tcl_DStringInit(&dString);

    TkGetInterpNames(interp, tkwin);
    resultObjPtr = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(resultObjPtr);
    for (i = 0; ; ) {
	result = Tcl_ListObjIndex(NULL, resultObjPtr, i, &interpNamePtr);
	if (interpNamePtr == NULL) {
	    break;
	}
	interpName = Tcl_GetStringFromObj(interpNamePtr, NULL);
	if (strcmp(actualName, interpName) == 0) {
	    if (suffix == 1) {
		Tcl_DStringAppend(&dString, name, -1);
		Tcl_DStringAppend(&dString, " #", 2);
		offset = Tcl_DStringLength(&dString);
		Tcl_DStringSetLength(&dString, offset + 10);
		actualName = Tcl_DStringValue(&dString);
	    }
	    suffix++;
	    sprintf(actualName + offset, "%d", suffix);
	    i = 0;
	} else {
	    i++;
	}
    }

    Tcl_DecrRefCount(resultObjPtr);
    Tcl_ResetResult(interp);

    /*
     * We have found a unique name. Now add it to the registry.
     */

    riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
    riPtr->interp = interp;
    riPtr->name = ckalloc(strlen(actualName) + 1);
    riPtr->nextPtr = interpListPtr;
    interpListPtr = riPtr;
    strcpy(riPtr->name, actualName);

    Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd, 
	    (ClientData) riPtr, NULL /* TODO: DeleteProc */);
    if (Tcl_IsSafe(interp)) {
	Tcl_HideCommand(interp, "send", "send");
    }
    Tcl_DStringFree(&dString);

    return riPtr->name;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_SendObjCmd --
 *
 *	This procedure is invoked to process the "send" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_SendObjCmd(
    ClientData clientData,	/* Used only for deletion */

    Tcl_Interp *interp,		/* The interp we are sending from */
    int objc,			/* Number of arguments */
    Tcl_Obj *CONST objv[])	/* The arguments */
{
    static char *sendOptions[] = {"-async", "-displayof", "-", (char *) NULL};
    char *stringRep, *destName;
    int async = 0;
    int i, index, firstArg;
    RegisteredInterp *riPtr;
    Tcl_Obj *resultPtr, *listObjPtr;
    int result;

    for (i = 1; i < (objc - 1); ) {
	stringRep = Tcl_GetStringFromObj(objv[i], NULL);
	if (stringRep[0] == '-') {
	    if (Tcl_GetIndexFromObj(interp, objv[i], sendOptions, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (index == 0) {
		async = 1;
		i++;
	    } else if (index == 1) {
		i += 2;
	    } else {
		i++;
	    }
	} else {
	    break;
	}
    }
	
    if (objc < (i + 2)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?options? interpName arg ?arg ...?");
	return TCL_ERROR;
    }

    destName = Tcl_GetStringFromObj(objv[i], NULL);
    firstArg = i + 1;

    resultPtr = Tcl_GetObjResult(interp);

    /*
     * See if the target interpreter is local.  If so, execute
     * the command directly without going through the DDE server.
     * The only tricky thing is passing the result from the target
     * interpreter to the invoking interpreter.  Watch out:  they
     * could be the same!
     */

    for (riPtr = interpListPtr; (riPtr != NULL) 
	    && (strcmp(destName, riPtr->name)); riPtr = riPtr->nextPtr) {
	/*
	 * Empty loop body.
	 */
    
    }

    if (riPtr != NULL) {
	/*
	 * This command is to a local interp. No need to go through
	 * the server.
	 */

	Tcl_Interp *localInterp;

	Tcl_Preserve((ClientData) riPtr);
	localInterp = riPtr->interp;
	Tcl_Preserve((ClientData) localInterp);
	if (firstArg == (objc - 1)) {
	    /*
	     * This might be one of those cases where the new
	     * parser is faster.
	     */

	    result = Tcl_EvalObj(localInterp, objv[firstArg], TCL_EVAL_DIRECT);
	} else {
	    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
	    for (i = firstArg; i < objc; i++) {
		Tcl_ListObjAppendList(interp, listObjPtr, objv[i]);
	    }
	    Tcl_IncrRefCount(listObjPtr);
	    result = Tcl_EvalObj(localInterp, listObjPtr, TCL_EVAL_DIRECT);
	    Tcl_DecrRefCount(listObjPtr);
	}
	if (interp != localInterp) {
	    if (result == TCL_ERROR) {
		/* Tcl_Obj *errorObjPtr; */

		/*
		 * An error occurred, so transfer error information from the
		 * destination interpreter back to our interpreter.  Must clear
		 * interp's result before calling Tcl_AddErrorInfo, since
		 * Tcl_AddErrorInfo will store the interp's result in errorInfo
		 * before appending riPtr's $errorInfo;  we've already got
		 * everything we need in riPtr's $errorInfo.
		 */

		Tcl_ResetResult(interp);
		Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp,
			"errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
		/* errorObjPtr = Tcl_GetObjVar2(localInterp, "errorCode", NULL,
			TCL_GLOBAL_ONLY);
		Tcl_SetObjErrorCode(interp, errorObjPtr); */
	    }
	    Tcl_SetObjResult(interp, Tcl_GetObjResult(localInterp));
	}
	Tcl_Release((ClientData) riPtr);
	Tcl_Release((ClientData) localInterp);
    } else {
	/*
	 * This is a non-local request. Send the script to the server and poll
	 * it for a result. TODO!!!
	 */
    }

done:
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TkGetInterpNames --
 *
320
321
322
323
324
325
326


327









328
329
330
331
332
333
334
335

int
TkGetInterpNames(
    Tcl_Interp *interp,		/* Interpreter for returning a result. */
    Tk_Window tkwin)		/* Window whose display is to be used
				 * for the lookup. */
{


    Tcl_SetResult(interp, "Send not yet implemented", TCL_STATIC);









    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * SendInit --
 *







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







501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527

int
TkGetInterpNames(
    Tcl_Interp *interp,		/* Interpreter for returning a result. */
    Tk_Window tkwin)		/* Window whose display is to be used
				 * for the lookup. */
{
    Tcl_Obj *listObjPtr;
    RegisteredInterp *riPtr;

    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
    riPtr = interpListPtr;
    while (riPtr != NULL) {
	Tcl_ListObjAppendElement(interp, listObjPtr, 
		Tcl_NewStringObj(riPtr->name, -1));
	riPtr = riPtr->nextPtr;
    }
    
    Tcl_SetObjResult(interp, listObjPtr);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * SendInit --
 *
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
 *	Sets up various data structures and windows.
 *
 *--------------------------------------------------------------
 */

static int
SendInit(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting
				 * (no errors are ever returned, but the
				 * interpreter is needed anyway). */
    TkWindow *winPtr)		/* Window that identifies the display to
				 * initialize. */
{
    return TCL_OK;
}







|


<
<



536
537
538
539
540
541
542
543
544
545


546
547
548
 *	Sets up various data structures and windows.
 *
 *--------------------------------------------------------------
 */

static int
SendInit(
    Tcl_Interp *interp)		/* Interpreter to use for error reporting
				 * (no errors are ever returned, but the
				 * interpreter is needed anyway). */


{
    return TCL_OK;
}

Changes to mac/tkMacShLib.exp.

79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
TkGetDisplay
TkGetDisplayOf
TkGetFileFilters
TkGetInterpNames
TkGetMenuHashTable
TkGetMenuIndex
TkGetMiterPoints
TkGetNativeProlog
TkGetPointerCoords
TkGetProlog
TkGetServerInfo
TkGetTransientMaster
TkGrabDeadWindow
TkGrabState
TkInOutEvents
TkIncludePoint
TkInitFileFilters







<

<







79
80
81
82
83
84
85

86

87
88
89
90
91
92
93
TkGetDisplay
TkGetDisplayOf
TkGetFileFilters
TkGetInterpNames
TkGetMenuHashTable
TkGetMenuIndex
TkGetMiterPoints

TkGetPointerCoords

TkGetServerInfo
TkGetTransientMaster
TkGrabDeadWindow
TkGrabState
TkInOutEvents
TkIncludePoint
TkInitFileFilters
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
XBell
XChangeGC
XChangeProperty
XChangeWindowAttributes
XConfigureWindow
XCopyArea
XCopyPlane
XCreateBitmapFromData
XCreateColormap
XCreateGC
XCreateImage
XDefineCursor
XDestroyWindow
XDrawArc
XDrawLine







|







540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
XBell
XChangeGC
XChangeProperty
XChangeWindowAttributes
XConfigureWindow
XCopyArea
XCopyPlane
TkCreateBitmapFromData
XCreateColormap
XCreateGC
XCreateImage
XDefineCursor
XDestroyWindow
XDrawArc
XDrawLine
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
XLookupString
XMapWindow
XMoveResizeWindow
XMoveWindow
XParseColor
XQueryPointer
XRaiseWindow
XReadBitmapFile
XRefreshKeyboardMapping
XResizeWindow
XRootWindow
XSelectInput
XSendEvent
XSetArcMode
XSetBackground







|







579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
XLookupString
XMapWindow
XMoveResizeWindow
XMoveWindow
XParseColor
XQueryPointer
XRaiseWindow
TkReadBitmapFile
XRefreshKeyboardMapping
XResizeWindow
XRootWindow
XSelectInput
XSendEvent
XSetArcMode
XSetBackground

Changes to mac/tkMacSubwindows.c.

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
/* 
 * tkMacSubwindows.c --
 *
 *	Implements subwindows for the macintosh version of Tk.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacSubwindows.c 1.81 97/10/29 11:46:54
 */

#include "tkInt.h"
#include "X.h"
#include "Xlib.h"
#include <stdio.h>

#include <Windows.h>
#include <QDOffscreen.h>
#include "tkMacInt.h"

/*
 * Temporary region that can be reused.
 */
static RgnHandle tmpRgn = NULL;

static void UpdateOffsets _ANSI_ARGS_((TkWindow *winPtr, int deltaX, int deltaY));

void MacMoveWindow _ANSI_ARGS_((WindowRef window, int x, int y));

/*
 *----------------------------------------------------------------------
 *
 * XDestroyWindow --
 *
 *	Dealocates the given X Window.










|


















|







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
/* 
 * tkMacSubwindows.c --
 *
 *	Implements subwindows for the macintosh version of Tk.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacSubwindows.c,v 1.1.4.2 1998/09/30 02:18:17 stanton Exp $
 */

#include "tkInt.h"
#include "X.h"
#include "Xlib.h"
#include <stdio.h>

#include <Windows.h>
#include <QDOffscreen.h>
#include "tkMacInt.h"

/*
 * Temporary region that can be reused.
 */
static RgnHandle tmpRgn = NULL;

static void UpdateOffsets _ANSI_ARGS_((TkWindow *winPtr, int deltaX, int deltaY));

void tkMacMoveWindow _ANSI_ARGS_((WindowRef window, int x, int y));

/*
 *----------------------------------------------------------------------
 *
 * XDestroyWindow --
 *
 *	Dealocates the given X Window.
284
285
286
287
288
289
290
291

292
293
294
295
296
297
298
299
300





































301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
    destPort = TkMacGetDrawablePort(window);
    if (destPort == NULL) {
	return;
    }

    display->request++;
    SetPort((GrafPtr) destPort);
    if (Tk_IsTopLevel(macWin->winPtr) && !Tk_IsEmbedded(macWin->winPtr)) {

	/* 
	 * NOTE: we are not adding the new space to the update
	 * region.  It is currently assumed that Tk will need
	 * to completely redraw anway.
	 */
	SizeWindow((WindowRef) destPort,
		(short) width, (short) height, false);
	TkMacInvalidateWindow(macWin, TK_WINDOW_ONLY);
	TkMacInvalClipRgns(macWin->winPtr);





































    } else {
	/* TODO: update all xOff & yOffs */
	int deltaX, deltaY, parentBorderwidth;
	MacDrawable *macParent = macWin->winPtr->parentPtr->privatePtr;

        /*
         * Find the Parent window -
         *    For an embedded window this will be its container.
         */
         
	if (Tk_IsEmbedded(macWin->winPtr)) {
	    TkWindow *contWinPtr;
	    
	    contWinPtr = TkpGetOtherWindow(macWin->winPtr);
	    if (contWinPtr == NULL) {
	            panic("XMoveResizeWindow could not find container");
	    }
	    macParent = contWinPtr->privatePtr;
	    
	    /*
	     * NOTE: Here we should handle out of process embedding.
	     */
	
	} else {
	    macParent = macWin->winPtr->parentPtr->privatePtr;   
	    if (macParent == NULL) {
	        return; /* TODO: Probably should be a panic */
	    }
	}
	
	TkMacInvalClipRgns(macParent->winPtr);
	TkMacInvalidateWindow(macWin, TK_PARENT_WINDOW);

	deltaX = - macWin->xOff;
	deltaY = - macWin->yOff;

        /*
	 * If macWin->winPtr is an embedded window, don't offset by its
	 *  parent's borderwidth...
	 */
	 
	if (!Tk_IsEmbedded(macWin->winPtr)) {
	    parentBorderwidth = macWin->winPtr->parentPtr->changes.border_width;
	} else {
	    parentBorderwidth = 0;
	}
	deltaX += macParent->xOff + parentBorderwidth +
	    macWin->winPtr->changes.x;
	deltaY += macParent->yOff + parentBorderwidth +
	    macWin->winPtr->changes.y;

	UpdateOffsets(macWin->winPtr, deltaX, deltaY);
    }
}

/*
 *----------------------------------------------------------------------
 *







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




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





<
<
<
<
<
<
|
<
<
|




|







284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343




















344
345
346
347

348
349
350
351
352
353






354


355
356
357
358
359
360
361
362
363
364
365
366
367
    destPort = TkMacGetDrawablePort(window);
    if (destPort == NULL) {
	return;
    }

    display->request++;
    SetPort((GrafPtr) destPort);
    if (Tk_IsTopLevel(macWin->winPtr)) {
	if (!Tk_IsEmbedded(macWin->winPtr)) {
	    /* 
	     * NOTE: we are not adding the new space to the update
	     * region.  It is currently assumed that Tk will need
	     * to completely redraw anway.
	     */
	    SizeWindow((WindowRef) destPort,
		    (short) width, (short) height, false);
	    TkMacInvalidateWindow(macWin, TK_WINDOW_ONLY);
	    TkMacInvalClipRgns(macWin->winPtr);
	} else {
	    int deltaX, deltaY;
	    
	    /*
	     * Find the Parent window -
	     *    For an embedded window this will be its container.
	     */
	    TkWindow *contWinPtr;
	    
	    contWinPtr = TkpGetOtherWindow(macWin->winPtr);
	    
	    if (contWinPtr != NULL) {
	        MacDrawable *macParent = contWinPtr->privatePtr;

		TkMacInvalClipRgns(macParent->winPtr);	
		TkMacInvalidateWindow(macWin, TK_PARENT_WINDOW);
		
		deltaX = macParent->xOff +
		    macWin->winPtr->changes.x - macWin->xOff;
		deltaY = macParent->yOff +
		    macWin->winPtr->changes.y - macWin->yOff;
		
		UpdateOffsets(macWin->winPtr, deltaX, deltaY);
	    } else {
	        /*
	         * This is the case where we are embedded in
	         * another app.  At this point, we are assuming that
	         * the changes.x,y is not maintained, if you need
		 * the info get it from Tk_GetRootCoords,
	         * and that the toplevel sits at 0,0 when it is drawn.
	         */
		
		TkMacInvalidateWindow(macWin, TK_PARENT_WINDOW);
		UpdateOffsets(macWin->winPtr, 0, 0);
	    }
	         
	}   
    } else {
	/* TODO: update all xOff & yOffs */
	int deltaX, deltaY, parentBorderwidth;
	MacDrawable *macParent = macWin->winPtr->parentPtr->privatePtr;
	




















	if (macParent == NULL) {
	    return; /* TODO: Probably should be a panic */
	}
	

	TkMacInvalClipRgns(macParent->winPtr);	
	TkMacInvalidateWindow(macWin, TK_PARENT_WINDOW);

	deltaX = - macWin->xOff;
	deltaY = - macWin->yOff;







	parentBorderwidth = macWin->winPtr->parentPtr->changes.border_width;


	
	deltaX += macParent->xOff + parentBorderwidth +
	    macWin->winPtr->changes.x;
	deltaY += macParent->yOff + parentBorderwidth +
	    macWin->winPtr->changes.y;
        
	UpdateOffsets(macWin->winPtr, deltaX, deltaY);
    }
}

/*
 *----------------------------------------------------------------------
 *
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
	 * NOTE: we are not adding the new space to the update
	 * region.  It is currently assumed that Tk will need
	 * to completely redraw anway.
	 */
	
	SizeWindow((WindowRef) destPort,
		(short) width, (short) height, false);
	MacMoveWindow((WindowRef) destPort, x, y);
	
	/* TODO: is the following right? */
	TkMacInvalidateWindow(macWin, TK_WINDOW_ONLY);
	TkMacInvalClipRgns(macWin->winPtr);
    } else {
	int deltaX, deltaY, parentBorderwidth;
	Rect bounds;







|







401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
	 * NOTE: we are not adding the new space to the update
	 * region.  It is currently assumed that Tk will need
	 * to completely redraw anway.
	 */
	
	SizeWindow((WindowRef) destPort,
		(short) width, (short) height, false);
	tkMacMoveWindow((WindowRef) destPort, x, y);
	
	/* TODO: is the following right? */
	TkMacInvalidateWindow(macWin, TK_WINDOW_ONLY);
	TkMacInvalClipRgns(macWin->winPtr);
    } else {
	int deltaX, deltaY, parentBorderwidth;
	Rect bounds;
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
    SetPort((GrafPtr) destPort);
    if (Tk_IsTopLevel(macWin->winPtr) && !Tk_IsEmbedded(macWin->winPtr)) {
	/* 
	 * NOTE: we are not adding the new space to the update
	 * region.  It is currently assumed that Tk will need
	 * to completely redraw anway.
	 */
	MacMoveWindow((WindowRef) destPort, x, y);

	/* TODO: is the following right? */
	TkMacInvalidateWindow(macWin, TK_WINDOW_ONLY);
	TkMacInvalClipRgns(macWin->winPtr);
    } else {
	int deltaX, deltaY, parentBorderwidth;
	Rect bounds;







|







503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
    SetPort((GrafPtr) destPort);
    if (Tk_IsTopLevel(macWin->winPtr) && !Tk_IsEmbedded(macWin->winPtr)) {
	/* 
	 * NOTE: we are not adding the new space to the update
	 * region.  It is currently assumed that Tk will need
	 * to completely redraw anway.
	 */
	tkMacMoveWindow((WindowRef) destPort, x, y);

	/* TODO: is the following right? */
	TkMacInvalidateWindow(macWin, TK_WINDOW_ONLY);
	TkMacInvalClipRgns(macWin->winPtr);
    } else {
	int deltaX, deltaY, parentBorderwidth;
	Rect bounds;
740
741
742
743
744
745
746



747
748
749
750
751
752
753
        
	    contWinPtr = TkpGetOtherWindow(winPtr);
    	     
    	    if (contWinPtr != NULL) {
 	        TkMacUpdateClipRgn(contWinPtr);
	        SectRgn(rgn, 
		        contWinPtr->privatePtr->aboveClipRgn, rgn);



   	    }
	    
	    /*
	     * NOTE: Here we should handle out of process embedding.
	     */
		    
	}







>
>
>







749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
        
	    contWinPtr = TkpGetOtherWindow(winPtr);
    	     
    	    if (contWinPtr != NULL) {
 	        TkMacUpdateClipRgn(contWinPtr);
	        SectRgn(rgn, 
		        contWinPtr->privatePtr->aboveClipRgn, rgn);
   	    } else if (gMacEmbedHandler != NULL) {
   	        gMacEmbedHandler->getClipProc((Tk_Window) winPtr, tmpRgn);
   	        SectRgn(rgn, tmpRgn, rgn);
   	    }
	    
	    /*
	     * NOTE: Here we should handle out of process embedding.
	     */
		    
	}
879
880
881
882
883
884
885

886
887
888
889
890
891
892
 */

GWorldPtr
TkMacGetDrawablePort(
    Drawable drawable)
{
    MacDrawable *macWin = (MacDrawable *) drawable;

    
    if (macWin == NULL) {
        return NULL;
    }
    
    /*
     * This is NULL for off-screen pixmaps.  Then the portPtr







>







891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
 */

GWorldPtr
TkMacGetDrawablePort(
    Drawable drawable)
{
    MacDrawable *macWin = (MacDrawable *) drawable;
    GWorldPtr resultPort = NULL;
    
    if (macWin == NULL) {
        return NULL;
    }
    
    /*
     * This is NULL for off-screen pixmaps.  Then the portPtr
913
914
915
916
917
918
919

920
921





922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
        return macWin->toplevel->portPtr;
    } else {
    	TkWindow *contWinPtr;

	contWinPtr = TkpGetOtherWindow(macWin->toplevel->winPtr);
	
    	if (contWinPtr != NULL) {

    	    return TkMacGetDrawablePort((Drawable) contWinPtr->privatePtr);
    	} else {





    	    panic("TkMacGetDrawablePort couldn't find container");
    	    return NULL;
    	}	
	    
	/*
	 * NOTE: Here we should handle out of process embedding.
	 */
		    
    }

}

/*
 *----------------------------------------------------------------------
 *
 * TkMacInvalClipRgns --
 *







>
|
|
>
>
>
>
>









|







926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
        return macWin->toplevel->portPtr;
    } else {
    	TkWindow *contWinPtr;

	contWinPtr = TkpGetOtherWindow(macWin->toplevel->winPtr);
	
    	if (contWinPtr != NULL) {
    	    resultPort = TkMacGetDrawablePort(
		(Drawable) contWinPtr->privatePtr);
    	} else if (gMacEmbedHandler != NULL) {
	    resultPort = gMacEmbedHandler->getPortProc(
                    (Tk_Window) macWin->winPtr);
    	} 
	
	if (resultPort == NULL) {
    	    panic("TkMacGetDrawablePort couldn't find container");
    	    return NULL;
    	}	
	    
	/*
	 * NOTE: Here we should handle out of process embedding.
	 */
		    
    }
    return resultPort;
}

/*
 *----------------------------------------------------------------------
 *
 * TkMacInvalClipRgns --
 *
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
    bounds->bottom = (short) (winPtr->privatePtr->yOff +
	    winPtr->changes.height);
}

/*
 *----------------------------------------------------------------------
 *
 * MacMoveWindow --
 *
 *	A replacement for the Macintosh MoveWindow function.  This
 *	function adjusts the inputs to MoveWindow to offset the root of 
 *	the window system.  This has the effect of making the coords 
 *	refer to the window dressing rather than the top of the content.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Moves the Macintosh window.
 *
 *----------------------------------------------------------------------
 */

void 
MacMoveWindow(
    WindowRef window,
    int x,
    int y)
{
    int xOffset, yOffset;

    TkMacWindowOffset(window, &xOffset, &yOffset);







|
















|







1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
    bounds->bottom = (short) (winPtr->privatePtr->yOff +
	    winPtr->changes.height);
}

/*
 *----------------------------------------------------------------------
 *
 * tkMacMoveWindow --
 *
 *	A replacement for the Macintosh MoveWindow function.  This
 *	function adjusts the inputs to MoveWindow to offset the root of 
 *	the window system.  This has the effect of making the coords 
 *	refer to the window dressing rather than the top of the content.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Moves the Macintosh window.
 *
 *----------------------------------------------------------------------
 */

void 
tkMacMoveWindow(
    WindowRef window,
    int x,
    int y)
{
    int xOffset, yOffset;

    TkMacWindowOffset(window, &xOffset, &yOffset);

Changes to mac/tkMacTest.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
/* 
 * tkMacTest.c --
 *
 *	Contains commands for platform specific tests for
 *	the Macintosh platform.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacTest.c 1.2 96/12/15 14:34:00
 */

#include <Types.h>


/*
 * Forward declarations of procedures defined later in this file:
 */

int			TkplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
static int		DebuggerCmd _ANSI_ARGS_((ClientData dummy,











|



>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
/* 
 * tkMacTest.c --
 *
 *	Contains commands for platform specific tests for
 *	the Macintosh platform.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacTest.c,v 1.1.4.2 1998/09/30 02:18:17 stanton Exp $
 */

#include <Types.h>
#include <tcl.h>

/*
 * Forward declarations of procedures defined later in this file:
 */

int			TkplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
static int		DebuggerCmd _ANSI_ARGS_((ClientData dummy,

Changes to mac/tkMacWindowMgr.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkMacWindowMgr.c --
 *
 *	Implements common window manager functions for the Macintosh.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacWindowMgr.c 1.59 97/11/20 18:56:39
 */

#include <Events.h>
#include <Dialogs.h>
#include <EPPC.h>
#include <Windows.h>
#include <ToolUtils.h>





|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkMacWindowMgr.c --
 *
 *	Implements common window manager functions for the Macintosh.
 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacWindowMgr.c,v 1.1.4.3 1998/12/13 08:16:14 lfb Exp $
 */

#include <Events.h>
#include <Dialogs.h>
#include <EPPC.h>
#include <Windows.h>
#include <ToolUtils.h>
59
60
61
62
63
64
65
66
67
68
69
70
71
72

73
74
75
76
77
78
79
static void	BringWindowForward _ANSI_ARGS_((WindowRef wRef));
static int 	CheckEventsAvail _ANSI_ARGS_((void));
static int 	GenerateActivateEvents _ANSI_ARGS_((EventRecord *eventPtr,
			Window window));
static int 	GenerateFocusEvent _ANSI_ARGS_((EventRecord *eventPtr,
			Window window));
static int	GenerateKeyEvent _ANSI_ARGS_((EventRecord *eventPtr,
			Window window));
static int	GenerateUpdateEvent _ANSI_ARGS_((EventRecord *eventPtr,
			Window window));
static void 	GenerateUpdates _ANSI_ARGS_((RgnHandle updateRgn,
			TkWindow *winPtr));
static int 	GeneratePollingEvents _ANSI_ARGS_((void));	
static int 	GeneratePollingEvents2 _ANSI_ARGS_((Window window));	

static OSErr	TellWindowDefProcToCalcRegions _ANSI_ARGS_((WindowRef wRef));
static int	WindowManagerMouse _ANSI_ARGS_((EventRecord *theEvent,
		    Window window));


/*
 *----------------------------------------------------------------------







|





|
>







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
static void	BringWindowForward _ANSI_ARGS_((WindowRef wRef));
static int 	CheckEventsAvail _ANSI_ARGS_((void));
static int 	GenerateActivateEvents _ANSI_ARGS_((EventRecord *eventPtr,
			Window window));
static int 	GenerateFocusEvent _ANSI_ARGS_((EventRecord *eventPtr,
			Window window));
static int	GenerateKeyEvent _ANSI_ARGS_((EventRecord *eventPtr,
			Window window, UInt32 savedCode));
static int	GenerateUpdateEvent _ANSI_ARGS_((EventRecord *eventPtr,
			Window window));
static void 	GenerateUpdates _ANSI_ARGS_((RgnHandle updateRgn,
			TkWindow *winPtr));
static int 	GeneratePollingEvents _ANSI_ARGS_((void));	
static int 	GeneratePollingEvents2 _ANSI_ARGS_((Window window,
	                int adjustCursor));	
static OSErr	TellWindowDefProcToCalcRegions _ANSI_ARGS_((WindowRef wRef));
static int	WindowManagerMouse _ANSI_ARGS_((EventRecord *theEvent,
		    Window window));


/*
 *----------------------------------------------------------------------
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
    Window window)		/* Window pointer. */
{
    WindowRef whichWindow, frontWindow;
    Tk_Window tkwin;
    Point where, where2;
    int xOffset, yOffset;
    short windowPart;

				
    frontWindow = FrontWindow();

    /* 
     * The window manager only needs to know about mouse down events
     * and sometimes we need to "eat" the mouse up.  Otherwise, we
     * just pass the event to Tk.
     */
    if (eventPtr->what == mouseUp) {
	if (gEatButtonUp) {
	    gEatButtonUp = false;
	    return false;
	}
	return TkGenerateButtonEvent(eventPtr->where.h, eventPtr->where.v, 
		window, TkMacButtonKeyState());
    }

    windowPart = FindWindow(eventPtr->where, &whichWindow);

    tkwin = Tk_IdToWindow(tkDisplayList->display, window);
    switch (windowPart) {
	case inSysWindow:
	    SystemClick(eventPtr, (GrafPort *) whichWindow);
	    return false;
	case inDrag:
	    if (whichWindow != frontWindow) {
		if (!(eventPtr->modifiers & cmdKey)) {







>


















>
|







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
    Window window)		/* Window pointer. */
{
    WindowRef whichWindow, frontWindow;
    Tk_Window tkwin;
    Point where, where2;
    int xOffset, yOffset;
    short windowPart;
    TkDisplay *dispPtr;
				
    frontWindow = FrontWindow();

    /* 
     * The window manager only needs to know about mouse down events
     * and sometimes we need to "eat" the mouse up.  Otherwise, we
     * just pass the event to Tk.
     */
    if (eventPtr->what == mouseUp) {
	if (gEatButtonUp) {
	    gEatButtonUp = false;
	    return false;
	}
	return TkGenerateButtonEvent(eventPtr->where.h, eventPtr->where.v, 
		window, TkMacButtonKeyState());
    }

    windowPart = FindWindow(eventPtr->where, &whichWindow);
    dispPtr = TkGetDisplayList();
    tkwin = Tk_IdToWindow(dispPtr->display, window);
    switch (windowPart) {
	case inSysWindow:
	    SystemClick(eventPtr, (GrafPort *) whichWindow);
	    return false;
	case inDrag:
	    if (whichWindow != frontWindow) {
		if (!(eventPtr->modifiers & cmdKey)) {
288
289
290
291
292
293
294

295

296
297
298
299
300
301
302
303
static int
GenerateUpdateEvent(
    EventRecord *eventPtr,	/* Incoming Mac event */
    Window window)		/* Root X window for event. */
{
    WindowRef macWindow;
    register TkWindow *winPtr;

	

    winPtr = (TkWindow *) Tk_IdToWindow(tkDisplayList->display, window);

    if (winPtr == NULL) {
	 return false;
    }
    
    if (gDamageRgn == NULL) {
	gDamageRgn = NewRgn();







>

>
|







291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
static int
GenerateUpdateEvent(
    EventRecord *eventPtr,	/* Incoming Mac event */
    Window window)		/* Root X window for event. */
{
    WindowRef macWindow;
    register TkWindow *winPtr;
    TkDisplay *dispPtr;
	
    dispPtr = TkGetDisplayList();
    winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, window);

    if (winPtr == NULL) {
	 return false;
    }
    
    if (gDamageRgn == NULL) {
	gDamageRgn = NewRgn();
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
    Window window,	/* X Window containing button event. */
    unsigned int state)	/* Button Key state suitable for X event */
{
    WindowRef whichWin, frontWin;
    Point where;
    Tk_Window tkwin;
    int dummy;


    /* 
     * ButtonDown events will always occur in the front
     * window.  ButtonUp events, however, may occur anywhere
     * on the screen.  ButtonUp events should only be sent
     * to Tk if in the front window or during an implicit grab.
     */
    where.h = x;
    where.v = y;
    FindWindow(where, &whichWin);
    frontWin = FrontWindow();
			
    if ((frontWin == NULL) || (frontWin != whichWin && gGrabWinPtr == NULL)) {
	return false;
    }


    tkwin = Tk_IdToWindow(tkDisplayList->display, window);
    
    GlobalToLocal(&where);
    if (tkwin != NULL) {
	tkwin = Tk_TopCoordsToWindow(tkwin, where.h, where.v, &dummy, &dummy);
    }

    Tk_UpdatePointer(tkwin, x,  y, state);







>
















>
|







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
    Window window,	/* X Window containing button event. */
    unsigned int state)	/* Button Key state suitable for X event */
{
    WindowRef whichWin, frontWin;
    Point where;
    Tk_Window tkwin;
    int dummy;
    TkDisplay *dispPtr;

    /* 
     * ButtonDown events will always occur in the front
     * window.  ButtonUp events, however, may occur anywhere
     * on the screen.  ButtonUp events should only be sent
     * to Tk if in the front window or during an implicit grab.
     */
    where.h = x;
    where.v = y;
    FindWindow(where, &whichWin);
    frontWin = FrontWindow();
			
    if ((frontWin == NULL) || (frontWin != whichWin && gGrabWinPtr == NULL)) {
	return false;
    }

    dispPtr = TkGetDisplayList();
    tkwin = Tk_IdToWindow(dispPtr->display, window);
    
    GlobalToLocal(&where);
    if (tkwin != NULL) {
	tkwin = Tk_TopCoordsToWindow(tkwin, where.h, where.v, &dummy, &dummy);
    }

    Tk_UpdatePointer(tkwin, x,  y, state);
512
513
514
515
516
517
518

519

520
521
522
523
524
525
526
527

static int
GenerateActivateEvents(
    EventRecord *eventPtr,	/* Incoming Mac event */
    Window window)		/* Root X window for event. */
{
    TkWindow *winPtr;

    

    winPtr = (TkWindow *) Tk_IdToWindow(tkDisplayList->display, window);
    if (winPtr == NULL || winPtr->window == None) {
	return false;
    }

    TkGenerateActivateEvents(winPtr,
	    (eventPtr->modifiers & activeFlag) ? 1 : 0);
    return true;







>

>
|







519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536

static int
GenerateActivateEvents(
    EventRecord *eventPtr,	/* Incoming Mac event */
    Window window)		/* Root X window for event. */
{
    TkWindow *winPtr;
    TkDisplay *dispPtr;
    
    dispPtr = TkGetDisplayList();
    winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, window);
    if (winPtr == NULL || winPtr->window == None) {
	return false;
    }

    TkGenerateActivateEvents(winPtr,
	    (eventPtr->modifiers & activeFlag) ? 1 : 0);
    return true;
624
625
626
627
628
629
630

631

632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
static int
GenerateFocusEvent(
    EventRecord *eventPtr,	/* Incoming Mac event */
    Window window)		/* Root X window for event. */
{
    XEvent event;
    Tk_Window tkwin;

    

    tkwin = Tk_IdToWindow(tkDisplayList->display, window);
    if (tkwin == NULL) {
	return false;
    }

    /* 
     * Generate FocusIn and FocusOut events.  This event
     * is only sent to the toplevel window.
     */

    if (eventPtr->modifiers & activeFlag) {
	event.xany.type = FocusIn;
    } else {
	event.xany.type = FocusOut;
    }

    event.xany.serial = tkDisplayList->display->request;
    event.xany.send_event = False;
    event.xfocus.display = tkDisplayList->display;
    event.xfocus.window = window;
    event.xfocus.mode = NotifyNormal;
    event.xfocus.detail = NotifyDetailNone;

    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
    return true;
}







>

>
|















|

|







633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
static int
GenerateFocusEvent(
    EventRecord *eventPtr,	/* Incoming Mac event */
    Window window)		/* Root X window for event. */
{
    XEvent event;
    Tk_Window tkwin;
    TkDisplay *dispPtr;
    
    dispPtr = TkGetDisplayList();
    tkwin = Tk_IdToWindow(dispPtr->display, window);
    if (tkwin == NULL) {
	return false;
    }

    /* 
     * Generate FocusIn and FocusOut events.  This event
     * is only sent to the toplevel window.
     */

    if (eventPtr->modifiers & activeFlag) {
	event.xany.type = FocusIn;
    } else {
	event.xany.type = FocusOut;
    }

    event.xany.serial = dispPtr->display->request;
    event.xany.send_event = False;
    event.xfocus.display = dispPtr->display;
    event.xfocus.window = window;
    event.xfocus.mode = NotifyNormal;
    event.xfocus.detail = NotifyDetailNone;

    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
    return true;
}
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
 *
 *----------------------------------------------------------------------
 */

static int
GenerateKeyEvent(
    EventRecord *eventPtr,	/* Incoming Mac event */
    Window window)		/* Root X window for event. */




{
    Point where;
    Tk_Window tkwin;
    XEvent event;




    /*
     * The focus must be in the FrontWindow on the Macintosh.
     * We then query Tk to determine the exact Tk window
     * that owns the focus.
     */


    tkwin = Tk_IdToWindow(tkDisplayList->display, window);
    tkwin = (Tk_Window) ((TkWindow *) tkwin)->dispPtr->focusPtr;
    if (tkwin == NULL) {
	return false;
    }












    where.v = eventPtr->where.v;
    where.h = eventPtr->where.h;

    event.xany.send_event = False;
    event.xkey.same_screen = true;
    event.xkey.subwindow = None;
    event.xkey.time = TkpGetMS();

    event.xkey.x_root = where.h;
    event.xkey.y_root = where.v;
    GlobalToLocal(&where);
    Tk_TopCoordsToWindow(tkwin, where.h, where.v, 
	    &event.xkey.x, &event.xkey.y);

    event.xkey.keycode = eventPtr->message;



    event.xany.serial = Tk_Display(tkwin)->request;
    event.xkey.window = Tk_WindowId(tkwin);
    event.xkey.display = Tk_Display(tkwin);
    event.xkey.root = XRootWindow(Tk_Display(tkwin), 0);
    event.xkey.state = TkMacButtonKeyState();








|
>
>
>
>




>
>
>
|






>
|




>
>
>
>
>
>
>
>
>
>
>














>
|
>
>







685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
 *
 *----------------------------------------------------------------------
 */

static int
GenerateKeyEvent(
    EventRecord *eventPtr,	/* Incoming Mac event */
    Window window,		/* Root X window for event. */
    UInt32 savedKeyCode)	/* If non-zero, this is a lead byte which
    				 * should be combined with the character
    				 * in this event to form one multi-byte 
    				 * character. */
{
    Point where;
    Tk_Window tkwin;
    XEvent event;
    unsigned char byte;
    char buf[16];
    TkDisplay *dispPtr;
    
    /*
     * The focus must be in the FrontWindow on the Macintosh.
     * We then query Tk to determine the exact Tk window
     * that owns the focus.
     */

    dispPtr = TkGetDisplayList();
    tkwin = Tk_IdToWindow(dispPtr->display, window);
    tkwin = (Tk_Window) ((TkWindow *) tkwin)->dispPtr->focusPtr;
    if (tkwin == NULL) {
	return false;
    }
    byte = (unsigned char) (eventPtr->message & charCodeMask);
    if ((savedKeyCode == 0) && 
            (Tcl_ExternalToUtf(NULL, NULL, (char *) &byte, 1, 0, NULL, 
            	    buf, sizeof(buf), NULL, NULL, NULL) != TCL_OK)) {
        /*
         * This event specifies a lead byte.  Wait for the second byte
         * to come in before sending the XEvent.
         */
         
        return false;
    }   

    where.v = eventPtr->where.v;
    where.h = eventPtr->where.h;

    event.xany.send_event = False;
    event.xkey.same_screen = true;
    event.xkey.subwindow = None;
    event.xkey.time = TkpGetMS();

    event.xkey.x_root = where.h;
    event.xkey.y_root = where.v;
    GlobalToLocal(&where);
    Tk_TopCoordsToWindow(tkwin, where.h, where.v, 
	    &event.xkey.x, &event.xkey.y);
    
    event.xkey.keycode = byte |
            ((savedKeyCode & charCodeMask) << 8) |
            ((eventPtr->message & keyCodeMask) << 8);

    event.xany.serial = Tk_Display(tkwin)->request;
    event.xkey.window = Tk_WindowId(tkwin);
    event.xkey.display = Tk_Display(tkwin);
    event.xkey.root = XRootWindow(Tk_Display(tkwin), 0);
    event.xkey.state = TkMacButtonKeyState();

765
766
767
768
769
770
771

772
773
774
775
776
777
778
779
    Window window;
    WindowRef whichwindow, frontWin;
    Point whereLocal, whereGlobal;
    Boolean inContentRgn;
    short part;
    int local_x, local_y;
    int generatedEvents = false;

    
    /*
     * First we get the current mouse position and determine
     * what Tk window the mouse is over (if any).
     */
    frontWin = FrontWindow();
    if (frontWin == NULL) {
	return false;







>
|







798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
    Window window;
    WindowRef whichwindow, frontWin;
    Point whereLocal, whereGlobal;
    Boolean inContentRgn;
    short part;
    int local_x, local_y;
    int generatedEvents = false;
    TkDisplay *dispPtr;

    /*
     * First we get the current mouse position and determine
     * what Tk window the mouse is over (if any).
     */
    frontWin = FrontWindow();
    if (frontWin == NULL) {
	return false;
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
    part = FindWindow(whereGlobal, &whichwindow);
    inContentRgn = (part == inContent || part == inGrow);

    if ((frontWin != whichwindow) || !inContentRgn) {
	tkwin = NULL;
    } else {
	window = TkMacGetXWindow(whichwindow);

	rootwin = Tk_IdToWindow(tkDisplayList->display, window);
	if (rootwin == NULL) {
	    tkwin = NULL;
	} else {
	    tkwin = Tk_TopCoordsToWindow(rootwin, whereLocal.h, whereLocal.v, 
		    &local_x, &local_y);
	}
    }
    
    /*
     * The following call will generate the appropiate X events and
     * adjust any state that Tk must remember.
     */

    if ((tkwin == NULL) && (gGrabWinPtr != NULL)) {
	tkwin = gGrabWinPtr;
    }
    Tk_UpdatePointer(tkwin, whereGlobal.h,  whereGlobal.v,
	    TkMacButtonKeyState());

    /*
     * Finally, we make sure the proper cursor is installed.  The installation
     * is polled to 1) make our resize hack work, and 2) make sure we have the 
     * proper cursor even if someone else changed the cursor out from under
     * us.
     */
    if ((gGrabWinPtr == NULL) && (part == inGrow) && 







>
|


















|







821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
    part = FindWindow(whereGlobal, &whichwindow);
    inContentRgn = (part == inContent || part == inGrow);

    if ((frontWin != whichwindow) || !inContentRgn) {
	tkwin = NULL;
    } else {
	window = TkMacGetXWindow(whichwindow);
	dispPtr = TkGetDisplayList();
	rootwin = Tk_IdToWindow(dispPtr->display, window);
	if (rootwin == NULL) {
	    tkwin = NULL;
	} else {
	    tkwin = Tk_TopCoordsToWindow(rootwin, whereLocal.h, whereLocal.v, 
		    &local_x, &local_y);
	}
    }
    
    /*
     * The following call will generate the appropiate X events and
     * adjust any state that Tk must remember.
     */

    if ((tkwin == NULL) && (gGrabWinPtr != NULL)) {
	tkwin = gGrabWinPtr;
    }
    Tk_UpdatePointer(tkwin, whereGlobal.h,  whereGlobal.v,
	    TkMacButtonKeyState());
    
    /*
     * Finally, we make sure the proper cursor is installed.  The installation
     * is polled to 1) make our resize hack work, and 2) make sure we have the 
     * proper cursor even if someone else changed the cursor out from under
     * us.
     */
    if ((gGrabWinPtr == NULL) && (part == inGrow) && 
845
846
847
848
849
850
851
852

853
854
855
856
857
858
859

860
861
862
863
864
865
866
 *	The cursor may be changed.
 *
 *----------------------------------------------------------------------
 */

static int
GeneratePollingEvents2(
    Window window)

{
    Tk_Window tkwin, rootwin;
    WindowRef whichwindow, frontWin;
    Point whereLocal, whereGlobal;
    int local_x, local_y;
    int generatedEvents = false;
    Rect bounds;

    
    /*
     * First we get the current mouse position and determine
     * what Tk window the mouse is over (if any).
     */
    frontWin = FrontWindow();
    if (frontWin == NULL) {







|
>







>







880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
 *	The cursor may be changed.
 *
 *----------------------------------------------------------------------
 */

static int
GeneratePollingEvents2(
    Window window,
    int adjustCursor)
{
    Tk_Window tkwin, rootwin;
    WindowRef whichwindow, frontWin;
    Point whereLocal, whereGlobal;
    int local_x, local_y;
    int generatedEvents = false;
    Rect bounds;
    TkDisplay *dispPtr;
    
    /*
     * First we get the current mouse position and determine
     * what Tk window the mouse is over (if any).
     */
    frontWin = FrontWindow();
    if (frontWin == NULL) {
875
876
877
878
879
880
881

882
883
884
885
886
887
888
889
890
891

892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908


909
910
911
912
913
914
915
916
917
    /*
     * Determine if we are in a Tk window or not.
     */
    whichwindow = (WindowRef) TkMacGetDrawablePort(window);
    if (whichwindow != frontWin) {
	tkwin = NULL;
    } else {

	rootwin = Tk_IdToWindow(tkDisplayList->display, window);
	TkMacWinBounds((TkWindow *) rootwin, &bounds);
	if (!PtInRect(whereLocal, &bounds)) {
	    tkwin = NULL;
	} else {
	    tkwin = Tk_TopCoordsToWindow(rootwin, whereLocal.h, whereLocal.v, 
		    &local_x, &local_y);
	}
    }


    /*
     * The following call will generate the appropiate X events and
     * adjust any state that Tk must remember.
     */

    if ((tkwin == NULL) && (gGrabWinPtr != NULL)) {
	tkwin = gGrabWinPtr;
    }
    Tk_UpdatePointer(tkwin, whereGlobal.h,  whereGlobal.v,
	    TkMacButtonKeyState());

    /*
     * Finally, we make sure the proper cursor is installed.  The installation
     * is polled to 1) make our resize hack work, and 2) make sure we have the 
     * proper cursor even if someone else changed the cursor out from under
     * us.
     */


    TkMacInstallCursor(0);

    return true;
}

/*
 *----------------------------------------------------------------------
 *
 * TkMacButtonKeyState --







>
|









>










|






>
>
|
|







912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
    /*
     * Determine if we are in a Tk window or not.
     */
    whichwindow = (WindowRef) TkMacGetDrawablePort(window);
    if (whichwindow != frontWin) {
	tkwin = NULL;
    } else {
        dispPtr = TkGetDisplayList();
	rootwin = Tk_IdToWindow(dispPtr->display, window);
	TkMacWinBounds((TkWindow *) rootwin, &bounds);
	if (!PtInRect(whereLocal, &bounds)) {
	    tkwin = NULL;
	} else {
	    tkwin = Tk_TopCoordsToWindow(rootwin, whereLocal.h, whereLocal.v, 
		    &local_x, &local_y);
	}
    }

    
    /*
     * The following call will generate the appropiate X events and
     * adjust any state that Tk must remember.
     */

    if ((tkwin == NULL) && (gGrabWinPtr != NULL)) {
	tkwin = gGrabWinPtr;
    }
    Tk_UpdatePointer(tkwin, whereGlobal.h,  whereGlobal.v,
	    TkMacButtonKeyState());
    
    /*
     * Finally, we make sure the proper cursor is installed.  The installation
     * is polled to 1) make our resize hack work, and 2) make sure we have the 
     * proper cursor even if someone else changed the cursor out from under
     * us.
     */
     
    if (adjustCursor) {
        TkMacInstallCursor(0);
    }
    return true;
}

/*
 *----------------------------------------------------------------------
 *
 * TkMacButtonKeyState --
1101
1102
1103
1104
1105
1106
1107

1108
1109
1110
1111
1112
1113
1114
int
TkMacConvertEvent(
    EventRecord *eventPtr)
{
    WindowRef whichWindow;
    Window window;
    int eventFound = false;

    
    switch (eventPtr->what) {
	case nullEvent:
	case adjustCursorEvent:
	    if (GeneratePollingEvents()) {
		eventFound = true;
	    }







>







1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
int
TkMacConvertEvent(
    EventRecord *eventPtr)
{
    WindowRef whichWindow;
    Window window;
    int eventFound = false;
    static UInt32 savedKeyCode;
    
    switch (eventPtr->what) {
	case nullEvent:
	case adjustCursorEvent:
	    if (GeneratePollingEvents()) {
		eventFound = true;
	    }
1144
1145
1146
1147
1148
1149
1150


1151
1152










1153
1154




1155

1156
1157
1158
1159
1160
1161
1162
		Tcl_SetServiceMode(oldMode);

		if (HiWord(menuResult) != 0) {
		    TkMacHandleMenuSelect(menuResult, false);
		    break;
		}
	    }


	case keyUp:
	    whichWindow = FrontWindow();










	    window = TkMacGetXWindow(whichWindow);
	    eventFound |= GenerateKeyEvent(eventPtr, window);




	    break;

	case activateEvt:
	    window = TkMacGetXWindow((WindowRef) eventPtr->message);
	    eventFound |= GenerateActivateEvents(eventPtr, window);
	    eventFound |= GenerateFocusEvent(eventPtr, window);
	    break;
	case getFocusEvent:
	    eventPtr->modifiers |= activeFlag;







>
>


>
>
>
>
>
>
>
>
>
>

|
>
>
>
>

>







1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
		Tcl_SetServiceMode(oldMode);

		if (HiWord(menuResult) != 0) {
		    TkMacHandleMenuSelect(menuResult, false);
		    break;
		}
	    }
	    /* fall through */
	    
	case keyUp:
	    whichWindow = FrontWindow();
	    if (whichWindow == NULL) {
	        /*
	         * This happens if we get a key event before Tk has had a
	         * chance to actually create and realize ".", if they type
	         * when "." is withdrawn(!), or between the time "." is 
	         * destroyed and the app exits.
	         */
	         
	        return false;
	    }
	    window = TkMacGetXWindow(whichWindow);
	    if (GenerateKeyEvent(eventPtr, window, savedKeyCode) == 0) {
	        savedKeyCode = eventPtr->message;
	        return false;
	    }
	    eventFound = true;
	    break;
	    	    
	case activateEvt:
	    window = TkMacGetXWindow((WindowRef) eventPtr->message);
	    eventFound |= GenerateActivateEvents(eventPtr, window);
	    eventFound |= GenerateFocusEvent(eventPtr, window);
	    break;
	case getFocusEvent:
	    eventPtr->modifiers |= activeFlag;
1201
1202
1203
1204
1205
1206
1207

1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234







1235
1236
1237









1238
1239
1240
1241
1242
1243





1244
1245
1246
1247
1248
1249
1250
		pt.v = pt.h = 120;	  /* parameter ignored in sys 7 */
		DIBadMount(pt, eventPtr->message);
		DIUnload();
	    }
	    break;
    }
    

    return eventFound;
}

/*
 *----------------------------------------------------------------------
 *
 * TkMacConvertTkEvent --
 *
 *	This function converts a Macintosh event into zero or more
 *	Tcl events.
 *
 * Results:
 *	Returns 1 if event added to Tcl queue, 0 otherwse.
 *
 * Side effects:
 *	May add events to Tcl's event queue.
 *
 *----------------------------------------------------------------------
 */

int
TkMacConvertTkEvent(
    EventRecord *eventPtr,
    Window window)
{
    int eventFound = false;
    Point where;







    
    switch (eventPtr->what) {
	case nullEvent:









	case adjustCursorEvent:
	    if (GeneratePollingEvents2(window)) {
		eventFound = true;
	    }
	    break;
	case updateEvt:





	    if (GenerateUpdateEvent(eventPtr, window)) {
		eventFound = true;
	    }
	    break;
	case mouseDown:
	case mouseUp:
	    GetMouse(&where);







>









|

















>
>
>
>
>
>
>



>
>
>
>
>
>
>
>
>

|




>
>
>
>
>







1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
		pt.v = pt.h = 120;	  /* parameter ignored in sys 7 */
		DIBadMount(pt, eventPtr->message);
		DIUnload();
	    }
	    break;
    }
    
    savedKeyCode = 0;
    return eventFound;
}

/*
 *----------------------------------------------------------------------
 *
 * TkMacConvertTkEvent --
 *
 *	This function converts a Macintosh event into zero or more
 *	Tcl events.  It is intended for use in Netscape-style embedding.
 *
 * Results:
 *	Returns 1 if event added to Tcl queue, 0 otherwse.
 *
 * Side effects:
 *	May add events to Tcl's event queue.
 *
 *----------------------------------------------------------------------
 */

int
TkMacConvertTkEvent(
    EventRecord *eventPtr,
    Window window)
{
    int eventFound = false;
    Point where;
    static UInt32 savedKeyCode;
    
    /*
     * By default, assume it is legal for us to set the cursor 
     */
     
    Tk_MacTkOwnsCursor(1);
    
    switch (eventPtr->what) {
	case nullEvent:
        /*
         * We get NULL events only when the cursor is NOT over
	 * the plugin.  Otherwise we get updateCursor events.
	 * We will not generate polling events or move the cursor
	 * in this case.
         */
            
	    eventFound = false;
	    break;
	case adjustCursorEvent:
	    if (GeneratePollingEvents2(window, 1)) {
		eventFound = true;
	    }
	    break;
	case updateEvt:
        /*
         * It is possibly not legal for us to set the cursor 
         */
     
            Tk_MacTkOwnsCursor(0);
	    if (GenerateUpdateEvent(eventPtr, window)) {
		eventFound = true;
	    }
	    break;
	case mouseDown:
	case mouseUp:
	    GetMouse(&where);
1263
1264
1265
1266
1267
1268
1269


1270
1271




1272

1273







1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293







1294
1295
1296
1297


1298
1299
1300
1301
1302
1303
1304
		long menuResult = MenuKey(eventPtr->message & charCodeMask);
		
		if (HiWord(menuResult) != 0) {
		    TkMacHandleMenuSelect(menuResult, false);
		    break;
		}
	    }


	case keyUp:
	    eventFound |= GenerateKeyEvent(eventPtr, window);




	    break;

	case activateEvt:







	    eventFound |= GenerateActivateEvents(eventPtr, window);
	    eventFound |= GenerateFocusEvent(eventPtr, window);
	    break;
	case getFocusEvent:
	    eventPtr->modifiers |= activeFlag;
	    eventFound |= GenerateFocusEvent(eventPtr, window);
	    break;
	case loseFocusEvent:
	    eventPtr->modifiers &= ~activeFlag;
	    eventFound |= GenerateFocusEvent(eventPtr, window);
	    break;
	case kHighLevelEvent:
	    TkMacDoHLEvent(eventPtr);
	    /* TODO: should return true if events were placed on event queue. */
	    break;
	case osEvt:
	    /*
	     * Do clipboard conversion.
	     */
	    switch ((eventPtr->message & osEvtMessageMask) >> 24) {







		case mouseMovedMessage:
		    if (GeneratePollingEvents2(window)) {
			eventFound = true;
		    }


		    break;
		case suspendResumeMessage:
		    if (!(eventPtr->message & resumeFlag)) {
			TkSuspendClipboard();
		    }
		    tkMacAppInFront = (eventPtr->message & resumeFlag);
		    break;







>
>

|
>
>
>
>

>

>
>
>
>
>
>
>




















>
>
>
>
>
>
>

|

<
>
>







1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398

1399
1400
1401
1402
1403
1404
1405
1406
1407
		long menuResult = MenuKey(eventPtr->message & charCodeMask);
		
		if (HiWord(menuResult) != 0) {
		    TkMacHandleMenuSelect(menuResult, false);
		    break;
		}
	    }
	    /* fall through. */
	    
	case keyUp:
	    if (GenerateKeyEvent(eventPtr, window, savedKeyCode) == 0) {
	        savedKeyCode = eventPtr->message;
	        return false;
	    }	        
	    eventFound = true;
	    break;
	    
	case activateEvt:
        /*
         * It is probably not legal for us to set the cursor
	 * here, since we don't know where the mouse is in the
	 * window that is being activated.
         */
     
            Tk_MacTkOwnsCursor(0);
	    eventFound |= GenerateActivateEvents(eventPtr, window);
	    eventFound |= GenerateFocusEvent(eventPtr, window);
	    break;
	case getFocusEvent:
	    eventPtr->modifiers |= activeFlag;
	    eventFound |= GenerateFocusEvent(eventPtr, window);
	    break;
	case loseFocusEvent:
	    eventPtr->modifiers &= ~activeFlag;
	    eventFound |= GenerateFocusEvent(eventPtr, window);
	    break;
	case kHighLevelEvent:
	    TkMacDoHLEvent(eventPtr);
	    /* TODO: should return true if events were placed on event queue. */
	    break;
	case osEvt:
	    /*
	     * Do clipboard conversion.
	     */
	    switch ((eventPtr->message & osEvtMessageMask) >> 24) {
        /*
         * It is possibly not legal for us to set the cursor.
         * Netscape sends us these events all the time... 
         */
     
                Tk_MacTkOwnsCursor(0);
        
		case mouseMovedMessage:
		    /* if (GeneratePollingEvents2(window, 0)) {
			eventFound = true;

		    }  NEXT LINE IS TEMPORARY */
		    eventFound = false;
		    break;
		case suspendResumeMessage:
		    if (!(eventPtr->message & resumeFlag)) {
			TkSuspendClipboard();
		    }
		    tkMacAppInFront = (eventPtr->message & resumeFlag);
		    break;
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
		DILoad();
		pt.v = pt.h = 120;	  /* parameter ignored in sys 7 */
		DIBadMount(pt, eventPtr->message);
		DIUnload();
	    }
	    break;
    }
    
    return eventFound;
}

/*
 *----------------------------------------------------------------------
 *
 * CheckEventsAvail --







|







1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
		DILoad();
		pt.v = pt.h = 120;	  /* parameter ignored in sys 7 */
		DIBadMount(pt, eventPtr->message);
		DIUnload();
	    }
	    break;
    }
    savedKeyCode = 0;    
    return eventFound;
}

/*
 *----------------------------------------------------------------------
 *
 * CheckEventsAvail --
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
	}
    }
    
    /*
     * Assuming there are no errors we now call the window definition 
     * procedure to tell it to calculate the regions for the window.
     */

    if (err == noErr) {
 	(void) CallWindowDefProc((UniversalProcPtr) *wdef,
		GetWVariant(wRef), wRef, wCalcRgns, 0);

	HSetState(wdef, hState);
	if (!err) {
	     err = MemError();







<







1615
1616
1617
1618
1619
1620
1621

1622
1623
1624
1625
1626
1627
1628
	}
    }
    
    /*
     * Assuming there are no errors we now call the window definition 
     * procedure to tell it to calculate the regions for the window.
     */

    if (err == noErr) {
 	(void) CallWindowDefProc((UniversalProcPtr) *wdef,
		GetWVariant(wRef), wRef, wCalcRgns, 0);

	HSetState(wdef, hState);
	if (!err) {
	     err = MemError();

Changes to mac/tkMacWm.c.

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
/* 
 * tkMacWm.c --
 *
 *	This module takes care of the interactions between a Tk-based
 *	application and the window manager.  Among other things, it
 *	implements the "wm" command and passes geometry information
 *	to the window manager.
 *
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacWm.c 1.72 97/10/29 13:27:30
 */

#include <Gestalt.h>
#include <QDOffscreen.h>
#include <Windows.h>
#include <ToolUtils.h>


#include "tkPort.h"
#include "tkInt.h"
#include "tkMacInt.h"
#include <errno.h>
#include "tkScrollbar.h"

/*
 * If HAVE_APPEARANCE is defined in MW_TkHeader.pch then we must have the
 * Appearance manager header & library.  If so we can use these new API's to
 * have the iconify code do the right thing.
 */

#ifdef HAVE_APPEARANCE
#   include <Appearance.h>
#endif

/*
 * A data structure of the following type holds information for
 * each window manager protocol (such as WM_DELETE_WINDOW) for
 * which a handler (i.e. a Tcl command) has been defined for a
 * particular top-level window.
 */













|







>







|
|
|

|
<
|
<







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
/* 
 * tkMacWm.c --
 *
 *	This module takes care of the interactions between a Tk-based
 *	application and the window manager.  Among other things, it
 *	implements the "wm" command and passes geometry information
 *	to the window manager.
 *
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacWm.c,v 1.1.4.4 1998/12/13 08:16:14 lfb Exp $
 */

#include <Gestalt.h>
#include <QDOffscreen.h>
#include <Windows.h>
#include <ToolUtils.h>

#include <tclMac.h>
#include "tkPort.h"
#include "tkInt.h"
#include "tkMacInt.h"
#include <errno.h>
#include "tkScrollbar.h"

/*
 * We now require the Appearance headers.  They come with CodeWarrior Pro,
 * and are on the SDK CD.  However, we do not require the Appearance 
 * extension
 */
 

#include <Appearance.h>


/*
 * A data structure of the following type holds information for
 * each window manager protocol (such as WM_DELETE_WINDOW) for
 * which a handler (i.e. a Tcl command) has been defined for a
 * particular top-level window.
 */
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
/*
 * Hash table for Mac Window -> TkWindow mapping.
 */

static Tcl_HashTable windowTable;
static int windowHashInit = false;

void MacMoveWindow(WindowRef window, int x, int y);

/*
 * Forward declarations for procedures defined in this file:
 */

static int		HaveAppearance _ANSI_ARGS_((void));
static void		InitialWindowBounds _ANSI_ARGS_((TkWindow *winPtr, 
			    Rect *geometry));
static int		ParseGeometry _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, TkWindow *winPtr));
static void		TopLevelEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		TopLevelReqProc _ANSI_ARGS_((ClientData dummy,







|





<







302
303
304
305
306
307
308
309
310
311
312
313
314

315
316
317
318
319
320
321
/*
 * Hash table for Mac Window -> TkWindow mapping.
 */

static Tcl_HashTable windowTable;
static int windowHashInit = false;

void tkMacMoveWindow(WindowRef window, int x, int y);

/*
 * Forward declarations for procedures defined in this file:
 */


static void		InitialWindowBounds _ANSI_ARGS_((TkWindow *winPtr, 
			    Rect *geometry));
static int		ParseGeometry _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, TkWindow *winPtr));
static void		TopLevelEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		TopLevelReqProc _ANSI_ARGS_((ClientData dummy,
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
    wmPtr->flags &= ~WM_ABOUT_TO_MAP;

    /*
     * Map the window.
     */

    XMapWindow(winPtr->display, winPtr->window);

    /*
     * Now that the window is visable we can determine the offset
     * from the window's content orgin to the window's decorative
     * orgin (structure orgin).
     */
    TkMacWindowOffset((WindowRef) TkMacGetDrawablePort(Tk_WindowId(winPtr)), 
	&wmPtr->xInParent, &wmPtr->yInParent);







|







526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
    wmPtr->flags &= ~WM_ABOUT_TO_MAP;

    /*
     * Map the window.
     */

    XMapWindow(winPtr->display, winPtr->window);
    
    /*
     * Now that the window is visable we can determine the offset
     * from the window's content orgin to the window's decorative
     * orgin (structure orgin).
     */
    TkMacWindowOffset((WindowRef) TkMacGetDrawablePort(Tk_WindowId(winPtr)), 
	&wmPtr->xInParent, &wmPtr->yInParent);
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
	    && (length >= 3)) {
	if ((argc != 2) && (argc != 3)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " tracing ?boolean?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 2) {
	    interp->result = (wmTracing) ? "on" : "off";
	    return TCL_OK;
	}
	return Tcl_GetBoolean(interp, argv[2], &wmTracing);
    }

    if (argc < 3) {
	goto wrongNumArgs;







|







705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
	    && (length >= 3)) {
	if ((argc != 2) && (argc != 3)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " tracing ?boolean?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 2) {
	    Tcl_SetResult(interp, ((wmTracing) ? "on" : "off"), TCL_STATIC);
	    return TCL_OK;
	}
	return Tcl_GetBoolean(interp, argv[2], &wmTracing);
    }

    if (argc < 3) {
	goto wrongNumArgs;
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
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " aspect window ?minNumer minDenom ",
		    "maxNumer maxDenom?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & PAspect) {


		sprintf(interp->result, "%d %d %d %d", wmPtr->minAspect.x,
			wmPtr->minAspect.y, wmPtr->maxAspect.x,
			wmPtr->maxAspect.y);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~PAspect;
	} else {
	    if ((Tcl_GetInt(interp, argv[3], &numer1) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[4], &denom1) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[5], &numer2) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[6], &denom2) != TCL_OK)) {
		return TCL_ERROR;
	    }
	    if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
		    (denom2 <= 0)) {
		interp->result = "aspect number can't be <= 0";

		return TCL_ERROR;
	    }
	    wmPtr->minAspect.x = numer1;
	    wmPtr->minAspect.y = denom1;
	    wmPtr->maxAspect.x = numer2;
	    wmPtr->maxAspect.y = denom2;
	    wmPtr->sizeHintsFlags |= PAspect;
	}
	wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
	goto updateGeom;
    } else if ((c == 'c') && (strncmp(argv[1], "client", length) == 0)
	    && (length >= 2)) {
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " client window ?name?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->clientMachine != NULL) {
		interp->result = wmPtr->clientMachine;
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == 0) {
	    if (wmPtr->clientMachine != NULL) {
		ckfree((char *) wmPtr->clientMachine);
		wmPtr->clientMachine = NULL;







>
>
|


>














|
>




















|







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
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " aspect window ?minNumer minDenom ",
		    "maxNumer maxDenom?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & PAspect) {
		char buf[TCL_INTEGER_SPACE * 4];

		sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x,
			wmPtr->minAspect.y, wmPtr->maxAspect.x,
			wmPtr->maxAspect.y);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~PAspect;
	} else {
	    if ((Tcl_GetInt(interp, argv[3], &numer1) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[4], &denom1) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[5], &numer2) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[6], &denom2) != TCL_OK)) {
		return TCL_ERROR;
	    }
	    if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
		    (denom2 <= 0)) {
		Tcl_SetResult(interp, "aspect number can't be <= 0",
			TCL_STATIC);
		return TCL_ERROR;
	    }
	    wmPtr->minAspect.x = numer1;
	    wmPtr->minAspect.y = denom1;
	    wmPtr->maxAspect.x = numer2;
	    wmPtr->maxAspect.y = denom2;
	    wmPtr->sizeHintsFlags |= PAspect;
	}
	wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
	goto updateGeom;
    } else if ((c == 'c') && (strncmp(argv[1], "client", length) == 0)
	    && (length >= 2)) {
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " client window ?name?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->clientMachine != NULL) {
		Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == 0) {
	    if (wmPtr->clientMachine != NULL) {
		ckfree((char *) wmPtr->clientMachine);
		wmPtr->clientMachine = NULL;
873
874
875
876
877
878
879

880
881

882
883
884
885
886
887
888
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " command window ?value?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->cmdArgv != NULL) {

		interp->result = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
		interp->freeProc = (Tcl_FreeProc *) free;

	    }
	    return TCL_OK;
	}
	if (argv[3][0] == 0) {
	    if (wmPtr->cmdArgv != NULL) {
		ckfree((char *) wmPtr->cmdArgv);
		wmPtr->cmdArgv = NULL;







>
|
<
>







875
876
877
878
879
880
881
882
883

884
885
886
887
888
889
890
891
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " command window ?value?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->cmdArgv != NULL) {
		Tcl_SetResult(interp,
			Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv),

			TCL_DYNAMIC);
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == 0) {
	    if (wmPtr->cmdArgv != NULL) {
		ckfree((char *) wmPtr->cmdArgv);
		wmPtr->cmdArgv = NULL;
924
925
926
927
928
929
930
931

932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947

948
949
950
951
952
953
954
955
956
957
958

959
960
961
962
963
964
965
966
967
968
969
970


971
972
973
974
975
976
977
978
979
980
981
982
983

984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003


1004
1005
1006

1007
1008
1009
1010
1011
1012
1013
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " focusmodel window ?active|passive?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    interp->result = wmPtr->hints.input ? "passive" : "active";

	    return TCL_OK;
	}
	c = argv[3][0];
	length = strlen(argv[3]);
	if ((c == 'a') && (strncmp(argv[3], "active", length) == 0)) {
	    wmPtr->hints.input = False;
	} else if ((c == 'p') && (strncmp(argv[3], "passive", length) == 0)) {
	    wmPtr->hints.input = True;
	} else {
	    Tcl_AppendResult(interp, "bad argument \"", argv[3],
		    "\": must be active or passive", (char *) NULL);
	    return TCL_ERROR;
	}
    } else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0)
	    && (length >= 2)) {
	Window window;


	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " frame window\"", (char *) NULL);
	    return TCL_ERROR;
	}
	window = wmPtr->reparent;
	if (window == None) {
	    window = Tk_WindowId((Tk_Window) winPtr);
	}
	sprintf(interp->result, "0x%x", (unsigned int) window);

    } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)
	    && (length >= 2)) {
	char xSign, ySign;
	int width, height;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " geometry window ?newGeometry?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {


	    xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
	    ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
	    if (wmPtr->gridWin != NULL) {
		width = wmPtr->reqGridWidth + (winPtr->changes.width
			- winPtr->reqWidth)/wmPtr->widthInc;
		height = wmPtr->reqGridHeight + (winPtr->changes.height
			- winPtr->reqHeight)/wmPtr->heightInc;
	    } else {
		width = winPtr->changes.width;
		height = winPtr->changes.height;
	    }
	    sprintf(interp->result, "%dx%d%c%d%c%d", width, height,
		    xSign, wmPtr->x, ySign, wmPtr->y);

	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->width = -1;
	    wmPtr->height = -1;
	    goto updateGeom;
	}
	return ParseGeometry(interp, argv[3], winPtr);
    } else if ((c == 'g') && (strncmp(argv[1], "grid", length) == 0)
	    && (length >= 3)) {
	int reqWidth, reqHeight, widthInc, heightInc;

	if ((argc != 3) && (argc != 7)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " grid window ?baseWidth baseHeight ",
		    "widthInc heightInc?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & PBaseSize) {


		sprintf(interp->result, "%d %d %d %d", wmPtr->reqGridWidth,
			wmPtr->reqGridHeight, wmPtr->widthInc,
			wmPtr->heightInc);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    /*
	     * Turn off gridding and reset the width and height
	     * to make sense as ungridded numbers.







|
>
















>










|
>












>
>











|
|
>




















>
>
|


>







927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " focusmodel window ?active|passive?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
		    TCL_STATIC);
	    return TCL_OK;
	}
	c = argv[3][0];
	length = strlen(argv[3]);
	if ((c == 'a') && (strncmp(argv[3], "active", length) == 0)) {
	    wmPtr->hints.input = False;
	} else if ((c == 'p') && (strncmp(argv[3], "passive", length) == 0)) {
	    wmPtr->hints.input = True;
	} else {
	    Tcl_AppendResult(interp, "bad argument \"", argv[3],
		    "\": must be active or passive", (char *) NULL);
	    return TCL_ERROR;
	}
    } else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0)
	    && (length >= 2)) {
	Window window;
	char buf[TCL_INTEGER_SPACE];

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " frame window\"", (char *) NULL);
	    return TCL_ERROR;
	}
	window = wmPtr->reparent;
	if (window == None) {
	    window = Tk_WindowId((Tk_Window) winPtr);
	}
	sprintf(buf, "0x%x", (unsigned int) window);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)
	    && (length >= 2)) {
	char xSign, ySign;
	int width, height;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " geometry window ?newGeometry?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    char buf[16 + TCL_INTEGER_SPACE * 4];

	    xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
	    ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
	    if (wmPtr->gridWin != NULL) {
		width = wmPtr->reqGridWidth + (winPtr->changes.width
			- winPtr->reqWidth)/wmPtr->widthInc;
		height = wmPtr->reqGridHeight + (winPtr->changes.height
			- winPtr->reqHeight)/wmPtr->heightInc;
	    } else {
		width = winPtr->changes.width;
		height = winPtr->changes.height;
	    }
	    sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x,
		    ySign, wmPtr->y);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->width = -1;
	    wmPtr->height = -1;
	    goto updateGeom;
	}
	return ParseGeometry(interp, argv[3], winPtr);
    } else if ((c == 'g') && (strncmp(argv[1], "grid", length) == 0)
	    && (length >= 3)) {
	int reqWidth, reqHeight, widthInc, heightInc;

	if ((argc != 3) && (argc != 7)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " grid window ?baseWidth baseHeight ",
		    "widthInc heightInc?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & PBaseSize) {
		char buf[TCL_INTEGER_SPACE * 4];

		sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth,
			wmPtr->reqGridHeight, wmPtr->widthInc,
			wmPtr->heightInc);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    /*
	     * Turn off gridding and reset the width and height
	     * to make sense as ungridded numbers.
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
	    if ((Tcl_GetInt(interp, argv[3], &reqWidth) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[4], &reqHeight) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[5], &widthInc) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[6], &heightInc) != TCL_OK)) {
		return TCL_ERROR;
	    }
	    if (reqWidth < 0) {
		interp->result = "baseWidth can't be < 0";
		return TCL_ERROR;
	    }
	    if (reqHeight < 0) {
		interp->result = "baseHeight can't be < 0";
		return TCL_ERROR;
	    }
	    if (widthInc < 0) {
		interp->result = "widthInc can't be < 0";
		return TCL_ERROR;
	    }
	    if (heightInc < 0) {
		interp->result = "heightInc can't be < 0";
		return TCL_ERROR;
	    }
	    Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
		    heightInc);
	}
	wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
	goto updateGeom;
    } else if ((c == 'g') && (strncmp(argv[1], "group", length) == 0)
	    && (length >= 3)) {
	Tk_Window tkwin2;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " group window ?pathName?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & WindowGroupHint) {
		interp->result = wmPtr->leaderName;
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~WindowGroupHint;
	    if (wmPtr->leaderName != NULL) {
		ckfree(wmPtr->leaderName);







|



|



|



|



















|







1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
	    if ((Tcl_GetInt(interp, argv[3], &reqWidth) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[4], &reqHeight) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[5], &widthInc) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[6], &heightInc) != TCL_OK)) {
		return TCL_ERROR;
	    }
	    if (reqWidth < 0) {
		Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC);
		return TCL_ERROR;
	    }
	    if (reqHeight < 0) {
		Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC);
		return TCL_ERROR;
	    }
	    if (widthInc < 0) {
		Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC);
		return TCL_ERROR;
	    }
	    if (heightInc < 0) {
		Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC);
		return TCL_ERROR;
	    }
	    Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
		    heightInc);
	}
	wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
	goto updateGeom;
    } else if ((c == 'g') && (strncmp(argv[1], "group", length) == 0)
	    && (length >= 3)) {
	Tk_Window tkwin2;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " group window ?pathName?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & WindowGroupHint) {
		Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~WindowGroupHint;
	    if (wmPtr->leaderName != NULL) {
		ckfree(wmPtr->leaderName);
1091
1092
1093
1094
1095
1096
1097
1098
1099

1100
1101
1102
1103
1104
1105
1106
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconbitmap window ?bitmap?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconPixmapHint) {
		interp->result = Tk_NameOfBitmap(winPtr->display,
			wmPtr->hints.icon_pixmap);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    if (wmPtr->hints.icon_pixmap != None) {
		Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap);
	    }







|
|
>







1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconbitmap window ?bitmap?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconPixmapHint) {
		Tcl_SetResult(interp,
			Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap),
			TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    if (wmPtr->hints.icon_pixmap != None) {
		Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap);
	    }
1151
1152
1153
1154
1155
1156
1157
1158
1159

1160
1161
1162
1163
1164
1165
1166
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconmask window ?bitmap?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconMaskHint) {
		interp->result = Tk_NameOfBitmap(winPtr->display,
			wmPtr->hints.icon_mask);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    if (wmPtr->hints.icon_mask != None) {
		Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask);
	    }







|
|
>







1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconmask window ?bitmap?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconMaskHint) {
		Tcl_SetResult(interp,
			Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
			TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    if (wmPtr->hints.icon_mask != None) {
		Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask);
	    }
1177
1178
1179
1180
1181
1182
1183

1184

1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203


1204
1205

1206
1207
1208
1209
1210
1211
1212
	    && (length >= 5)) {
	if (argc > 4) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconname window ?newName?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {

	    interp->result = (wmPtr->iconName != NULL) ? wmPtr->iconName : "";

	    return TCL_OK;
	} else {
	    wmPtr->iconName = Tk_GetUid(argv[3]);
	    if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
		XSetIconName(winPtr->display, winPtr->window, wmPtr->iconName);
	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "iconposition", length) == 0)
	    && (length >= 5)) {
	int x, y;

	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconposition window ?x y?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconPositionHint) {


		sprintf(interp->result, "%d %d", wmPtr->hints.icon_x,
			wmPtr->hints.icon_y);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~IconPositionHint;
	} else {
	    if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK)







>
|
>



















>
>
|

>







1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
	    && (length >= 5)) {
	if (argc > 4) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconname window ?newName?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    Tcl_SetResult(interp,
		    ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""),
		    TCL_STATIC);
	    return TCL_OK;
	} else {
	    wmPtr->iconName = Tk_GetUid(argv[3]);
	    if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
		XSetIconName(winPtr->display, winPtr->window, wmPtr->iconName);
	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "iconposition", length) == 0)
	    && (length >= 5)) {
	int x, y;

	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconposition window ?x y?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconPositionHint) {
		char buf[TCL_INTEGER_SPACE * 2];
		
		sprintf(buf, "%d %d", wmPtr->hints.icon_x,
			wmPtr->hints.icon_y);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~IconPositionHint;
	} else {
	    if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK)
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconwindow window ?pathName?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->icon != NULL) {
		interp->result = Tk_PathName(wmPtr->icon);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~IconWindowHint;
	    if (wmPtr->icon != NULL) {
		wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr;







|







1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconwindow window ?pathName?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->icon != NULL) {
		Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~IconWindowHint;
	    if (wmPtr->icon != NULL) {
		wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr;
1280
1281
1282
1283
1284
1285
1286

1287
1288

1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307

1308
1309

1310
1311
1312
1313
1314
1315
1316
	int width, height;
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " maxsize window ?width height?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {

	    sprintf(interp->result, "%d %d", wmPtr->maxWidth,
		    wmPtr->maxHeight);

	    return TCL_OK;
	}
	if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	wmPtr->maxWidth = width;
	wmPtr->maxHeight = height;
	wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
	goto updateGeom;
    } else if ((c == 'm') && (strncmp(argv[1], "minsize", length) == 0)
	    && (length >= 2)) {
	int width, height;
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		   argv[0], " minsize window ?width height?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {

	    sprintf(interp->result, "%d %d", wmPtr->minWidth,
		    wmPtr->minHeight);

	    return TCL_OK;
	}
	if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	wmPtr->minWidth = width;







>
|
|
>



















>
|
|
>







1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
	int width, height;
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " maxsize window ?width height?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    char buf[TCL_INTEGER_SPACE * 2];
	    
	    sprintf(buf, "%d %d", wmPtr->maxWidth, wmPtr->maxHeight);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    return TCL_OK;
	}
	if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	wmPtr->maxWidth = width;
	wmPtr->maxHeight = height;
	wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
	goto updateGeom;
    } else if ((c == 'm') && (strncmp(argv[1], "minsize", length) == 0)
	    && (length >= 2)) {
	int width, height;
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		   argv[0], " minsize window ?width height?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    char buf[TCL_INTEGER_SPACE * 2];
	    
	    sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    return TCL_OK;
	}
	if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	wmPtr->minWidth = width;
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " overrideredirect window ?boolean?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
		interp->result = "1";
	    } else {
		interp->result = "0";
	    }
	    return TCL_OK;
	}
	if (Tcl_GetBoolean(interp, argv[3], &boolean) != TCL_OK) {
	    return TCL_ERROR;
	}
	atts.override_redirect = (boolean) ? True : False;
	Tk_ChangeWindowAttributes((Tk_Window) winPtr, CWOverrideRedirect,
		&atts);
	wmPtr->style = (boolean) ? plainDBox : documentProc;
    } else if ((c == 'p') && (strncmp(argv[1], "positionfrom", length) == 0)
	    && (length >= 2)) {
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " positionfrom window ?user/program?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & USPosition) {
		interp->result = "user";
	    } else if (wmPtr->sizeHintsFlags & PPosition) {
		interp->result = "program";
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~(USPosition|PPosition);
	} else {
	    c = argv[3][0];







|

|




















|

|







1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " overrideredirect window ?boolean?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
		Tcl_SetResult(interp, "1", TCL_STATIC);
	    } else {
		Tcl_SetResult(interp, "0", TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (Tcl_GetBoolean(interp, argv[3], &boolean) != TCL_OK) {
	    return TCL_ERROR;
	}
	atts.override_redirect = (boolean) ? True : False;
	Tk_ChangeWindowAttributes((Tk_Window) winPtr, CWOverrideRedirect,
		&atts);
	wmPtr->style = (boolean) ? plainDBox : documentProc;
    } else if ((c == 'p') && (strncmp(argv[1], "positionfrom", length) == 0)
	    && (length >= 2)) {
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " positionfrom window ?user/program?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & USPosition) {
		Tcl_SetResult(interp, "user", TCL_STATIC);
	    } else if (wmPtr->sizeHintsFlags & PPosition) {
		Tcl_SetResult(interp, "program", TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~(USPosition|PPosition);
	} else {
	    c = argv[3][0];
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
	if (argc == 4) {
	    /*
	     * Return the command to handle a given protocol.
	     */
	    for (protPtr = wmPtr->protPtr; protPtr != NULL;
					   protPtr = protPtr->nextPtr) {
		if (protPtr->protocol == protocol) {
		    interp->result = protPtr->command;
		    return TCL_OK;
		}
	    }
	    return TCL_OK;
	}

	/*







|







1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
	if (argc == 4) {
	    /*
	     * Return the command to handle a given protocol.
	     */
	    for (protPtr = wmPtr->protPtr; protPtr != NULL;
					   protPtr = protPtr->nextPtr) {
		if (protPtr->protocol == protocol) {
		    Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
		    return TCL_OK;
		}
	    }
	    return TCL_OK;
	}

	/*
1450
1451
1452
1453
1454
1455
1456


1457
1458
1459

1460
1461
1462
1463
1464
1465
1466
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " resizable window ?width height?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {


	    sprintf(interp->result, "%d %d",
		    (wmPtr->flags  & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
		    (wmPtr->flags  & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);

	    return TCL_OK;
	}
	if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetBoolean(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	if (width) {







>
>
|


>







1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " resizable window ?width height?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    char buf[TCL_INTEGER_SPACE * 2];

	    sprintf(buf, "%d %d",
		    (wmPtr->flags  & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
		    (wmPtr->flags  & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    return TCL_OK;
	}
	if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetBoolean(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	if (width) {
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " sizefrom window ?user|program?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & USSize) {
		interp->result = "user";
	    } else if (wmPtr->sizeHintsFlags & PSize) {
		interp->result = "program";
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~(USSize|PSize);
	} else {
	    c = argv[3][0];







|

|







1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " sizefrom window ?user|program?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & USSize) {
		Tcl_SetResult(interp, "user", TCL_STATIC);
	    } else if (wmPtr->sizeHintsFlags & PSize) {
		Tcl_SetResult(interp, "program", TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~(USSize|PSize);
	} else {
	    c = argv[3][0];
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550

1551
1552

1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " state window\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (wmPtr->iconFor != NULL) {
	    interp->result = "icon";
	} else {
	    switch (wmPtr->hints.initial_state) {
		case NormalState:
		    interp->result = "normal";
		    break;
		case IconicState:
		    interp->result = "iconic";
		    break;
		case WithdrawnState:
		    interp->result = "withdrawn";
		    break;
		case ZoomState:
		    interp->result = "zoomed";
		    break;
	    }
	}
    } else if ((c == 't') && (strncmp(argv[1], "title", length) == 0)
	    && (length >= 2)) {
	if (argc > 4) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " title window ?newTitle?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {

	    interp->result = (wmPtr->titleUid != NULL) ? wmPtr->titleUid
		: winPtr->nameUid;

	    return TCL_OK;
	} else {
	    wmPtr->titleUid = Tk_GetUid(argv[3]);
	    if (!(wmPtr->flags & WM_NEVER_MAPPED) && !Tk_IsEmbedded(winPtr)) {
		TkSetWMName(winPtr, wmPtr->titleUid);
	    }
	}
    } else if ((c == 't') && (strncmp(argv[1], "transient", length) == 0)
	    && (length >= 3)) {
	Tk_Window master;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " transient window ?master?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->master != None) {
		interp->result = wmPtr->masterWindowName;
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == '\0') {
	    wmPtr->master = None;
	    if (wmPtr->masterWindowName != NULL) {
		ckfree(wmPtr->masterWindowName);







|



|


|


|


|











>
|
<
>


















|







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
	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " state window\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (wmPtr->iconFor != NULL) {
	    Tcl_SetResult(interp, "icon", TCL_STATIC);
	} else {
	    switch (wmPtr->hints.initial_state) {
		case NormalState:
		    Tcl_SetResult(interp, "normal", TCL_STATIC);
		    break;
		case IconicState:
		    Tcl_SetResult(interp, "iconic", TCL_STATIC);
		    break;
		case WithdrawnState:
		    Tcl_SetResult(interp, "withdrawn", TCL_STATIC);
		    break;
		case ZoomState:
		    Tcl_SetResult(interp, "zoomed", TCL_STATIC);
		    break;
	    }
	}
    } else if ((c == 't') && (strncmp(argv[1], "title", length) == 0)
	    && (length >= 2)) {
	if (argc > 4) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " title window ?newTitle?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    Tcl_SetResult(interp,
		    ((wmPtr->titleUid != NULL) ? wmPtr->titleUid : winPtr->nameUid),

		    TCL_STATIC);
	    return TCL_OK;
	} else {
	    wmPtr->titleUid = Tk_GetUid(argv[3]);
	    if (!(wmPtr->flags & WM_NEVER_MAPPED) && !Tk_IsEmbedded(winPtr)) {
		TkSetWMName(winPtr, wmPtr->titleUid);
	    }
	}
    } else if ((c == 't') && (strncmp(argv[1], "transient", length) == 0)
	    && (length >= 3)) {
	Tk_Window master;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " transient window ?master?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->master != None) {
		Tcl_SetResult(interp, wmPtr->masterWindowName, TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == '\0') {
	    wmPtr->master = None;
	    if (wmPtr->masterWindowName != NULL) {
		ckfree(wmPtr->masterWindowName);
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
 *
 *	This procedure parses a geometry string and updates
 *	information used to control the geometry of a top-level
 *	window.
 *
 * Results:
 *	A standard Tcl return value, plus an error message in
 *	interp->result if an error occurs.
 *
 * Side effects:
 *	The size and/or location of winPtr may change.
 *
 *--------------------------------------------------------------
 */








|







2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
 *
 *	This procedure parses a geometry string and updates
 *	information used to control the geometry of a top-level
 *	window.
 *
 * Results:
 *	A standard Tcl return value, plus an error message in
 *	the interp's result if an error occurs.
 *
 * Side effects:
 *	The size and/or location of winPtr may change.
 *
 *--------------------------------------------------------------
 */

2329
2330
2331
2332
2333
2334
2335

2336

2337
2338




2339

2340
2341








2342
2343
2344
2345
2346
2347
2348
		     * pop out to the container's parent...
		     */
		     
	            x += winPtr->changes.x + winPtr->changes.border_width;
	            y += winPtr->changes.y + winPtr->changes.border_width;
		    
		} else {

		    

		    /*
		     * NOTE: Here we should handle




		     * out of process embedding.

		     */
		    








		    break;
		}
	    }
	}
	winPtr = winPtr->parentPtr;
    }
    *xPtr = x;







>

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







2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366

2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
		     * pop out to the container's parent...
		     */
		     
	            x += winPtr->changes.x + winPtr->changes.border_width;
	            y += winPtr->changes.y + winPtr->changes.border_width;
		    
		} else {
		    Point theOffset;
		    
		    if (gMacEmbedHandler->getOffsetProc != NULL) {
		        /*

		         * We do not require that the changes.x & changes.y for 
		         * a non-Tk master window be kept up to date.  So we
		         * first subtract off the possibly bogus values that have
		         * been added on at the top of this pass through the loop,
		         * and then call out to the getOffsetProc to give us
		         * the correct offset.
		         */
		         
	                x -= winPtr->changes.x + winPtr->changes.border_width;
	                y -= winPtr->changes.y + winPtr->changes.border_width;
	                
		        gMacEmbedHandler->getOffsetProc((Tk_Window) winPtr, &theOffset);
		        
		        x += theOffset.h;
		        y += theOffset.v;
		    }
		    break;
		}
	    }
	}
	winPtr = winPtr->parentPtr;
    }
    *xPtr = x;
2383
2384
2385
2386
2387
2388
2389

2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401

2402
2403
2404
2405
2406
2407
2408
2409
    Point where;
    Window rootChild;
    register TkWindow *winPtr, *childPtr;
    TkWindow *nextPtr;		/* Coordinates of highest child found so
				 * far that contains point. */
    int x, y;			/* Coordinates in winPtr. */
    int tmpx, tmpy, bd;


    /*
     * Step 1: find the top-level window that contains the desired point.
     */
     
    where.h = rootX;
    where.v = rootY;
    FindWindow(where, &whichWin);
    if (whichWin == NULL) {
	return NULL;
    }
    rootChild = TkMacGetXWindow(whichWin);

    winPtr = (TkWindow *) Tk_IdToWindow(tkDisplayList->display, rootChild);
    if (winPtr == NULL) {
        return NULL;
    }

    /*
     * Step 2: work down through the hierarchy underneath this window.
     * At each level, scan through all the children to find the highest







>












>
|







2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
    Point where;
    Window rootChild;
    register TkWindow *winPtr, *childPtr;
    TkWindow *nextPtr;		/* Coordinates of highest child found so
				 * far that contains point. */
    int x, y;			/* Coordinates in winPtr. */
    int tmpx, tmpy, bd;
    TkDisplay *dispPtr;

    /*
     * Step 1: find the top-level window that contains the desired point.
     */
     
    where.h = rootX;
    where.v = rootY;
    FindWindow(where, &whichWin);
    if (whichWin == NULL) {
	return NULL;
    }
    rootChild = TkMacGetXWindow(whichWin);
    dispPtr = TkGetDisplayList();
    winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, rootChild);
    if (winPtr == NULL) {
        return NULL;
    }

    /*
     * Step 2: work down through the hierarchy underneath this window.
     * At each level, scan through all the children to find the highest
3239
3240
3241
3242
3243
3244
3245

3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257

3258
3259
3260
3261
3262
3263
3264
3265

int
TkMacGrowToplevel(
    WindowPtr whichWindow,
    Point start)
{
    Point where = start;


    GlobalToLocal(&where);
    if (where.h > (whichWindow->portRect.right - 16) &&
	    where.v > (whichWindow->portRect.bottom - 16)) {
		
	Window window;
	TkWindow *winPtr;
	WmInfo *wmPtr;
	Rect bounds;
	long growResult;

	window = TkMacGetXWindow(whichWindow);

	winPtr = (TkWindow *) Tk_IdToWindow(tkDisplayList->display, window);
	wmPtr = winPtr->wmInfoPtr;
	
	/* TODO: handle grid size options. */
	if ((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) &&
		(wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE)) {
	    return false;
	}







>












>
|







3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310

int
TkMacGrowToplevel(
    WindowPtr whichWindow,
    Point start)
{
    Point where = start;
    TkDisplay *dispPtr;

    GlobalToLocal(&where);
    if (where.h > (whichWindow->portRect.right - 16) &&
	    where.v > (whichWindow->portRect.bottom - 16)) {
		
	Window window;
	TkWindow *winPtr;
	WmInfo *wmPtr;
	Rect bounds;
	long growResult;

	window = TkMacGetXWindow(whichWindow);
	dispPtr = TkGetDisplayList();
	winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, window);
	wmPtr = winPtr->wmInfoPtr;
	
	/* TODO: handle grid size options. */
	if ((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) &&
		(wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE)) {
	    return false;
	}
3314
3315
3316
3317
3318
3319
3320

3321
3322
3323
3324





3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
void
TkSetWMName(
    TkWindow *winPtr,
    Tk_Uid titleUid)
{
    Str255  pTitle;
    GWorldPtr macWin;

    
    if (Tk_IsEmbedded(winPtr)) {
        return;
    }





    
     macWin = TkMacGetDrawablePort(winPtr->window);
	
    strcpy((char *) pTitle + 1, titleUid);
    pTitle[0] = strlen(titleUid);
    SetWTitle((WindowPtr) macWin, pTitle);
}

void
TkGenWMDestroyEvent(
    Tk_Window tkwin)
{







>




>
>
>
>
>

|
|
<
<







3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378


3379
3380
3381
3382
3383
3384
3385
void
TkSetWMName(
    TkWindow *winPtr,
    Tk_Uid titleUid)
{
    Str255  pTitle;
    GWorldPtr macWin;
    int destWrote;
    
    if (Tk_IsEmbedded(winPtr)) {
        return;
    }
    Tcl_UtfToExternal(NULL, NULL, titleUid,
	    strlen(titleUid), 0, NULL, 
	    (char *) &pTitle[1],
	    255, NULL, &destWrote, NULL); /* Internalize native */
    pTitle[0] = destWrote;
    
    macWin = TkMacGetDrawablePort(winPtr->window);



    SetWTitle((WindowPtr) macWin, pTitle);
}

void
TkGenWMDestroyEvent(
    Tk_Window tkwin)
{
3579
3580
3581
3582
3583
3584
3585

3586
3587
3588
3589
3590
3591
3592
3593

    /*
     * We should now zoom the window (as long as it's one of ours).  We 
     * also need to generate an event to let Tk know that the window size 
     * has changed.
     */
    window = TkMacGetXWindow(whichWindow);

    tkwin = Tk_IdToWindow(tkDisplayList->display, window);
    if (tkwin == NULL) {
	return false;
    }

    /*
     * The following block of code works around a bug in the window
     * definition for Apple's floating windows.  The zoom behavior is







>
|







3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643

    /*
     * We should now zoom the window (as long as it's one of ours).  We 
     * also need to generate an event to let Tk know that the window size 
     * has changed.
     */
    window = TkMacGetXWindow(whichWindow);
    dispPtr = TkGetDisplayList();
    tkwin = Tk_IdToWindow(dispPtr->display, window);
    if (tkwin == NULL) {
	return false;
    }

    /*
     * The following block of code works around a bug in the window
     * definition for Apple's floating windows.  The zoom behavior is
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    switch (wmPtr->style) {
		case noGrowDocProc:
		case documentProc:
		    interp->result = "documentProc";
		    break;
		case dBoxProc:
		    interp->result = "dBoxProc";
		    break;
		case plainDBox:
		    interp->result = "plainDBox";
		    break;
		case altDBoxProc:
		    interp->result = "altDBoxProc";
		    break;
		case movableDBoxProc:
		    interp->result = "movableDBoxProc";
		    break;
		case zoomDocProc:
		case zoomNoGrow:
		    interp->result = "zoomDocProc";
		    break;
		case rDocProc:
		    interp->result = "rDocProc";
		    break;
		case floatProc:
		case floatGrowProc:
		    interp->result = "floatProc";
		    break;
		case floatZoomProc:
		case floatZoomGrowProc:
		    interp->result = "floatZoomProc";
		    break;
		case floatSideProc:
		case floatSideGrowProc:
		    interp->result = "floatSideProc";
		    break;
		case floatSideZoomProc:
		case floatSideZoomGrowProc:
		    interp->result = "floatSideZoomProc";
		    break;
		default:
		   panic("invalid style");
	    }
	    return TCL_OK;
	}
	if (strcmp(argv[3], "documentProc") == 0) {







|


|


|


|


|



|


|



|



|



|



|







3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    switch (wmPtr->style) {
		case noGrowDocProc:
		case documentProc:
		    Tcl_SetResult(interp, "documentProc", TCL_STATIC);
		    break;
		case dBoxProc:
		    Tcl_SetResult(interp, "dBoxProc", TCL_STATIC);
		    break;
		case plainDBox:
		    Tcl_SetResult(interp, "plainDBox", TCL_STATIC);
		    break;
		case altDBoxProc:
		    Tcl_SetResult(interp, "altDBoxProc", TCL_STATIC);
		    break;
		case movableDBoxProc:
		    Tcl_SetResult(interp, "movableDBoxProc", TCL_STATIC);
		    break;
		case zoomDocProc:
		case zoomNoGrow:
		    Tcl_SetResult(interp, "zoomDocProc", TCL_STATIC);
		    break;
		case rDocProc:
		    Tcl_SetResult(interp, "rDocProc", TCL_STATIC);
		    break;
		case floatProc:
		case floatGrowProc:
		    Tcl_SetResult(interp, "floatProc", TCL_STATIC);
		    break;
		case floatZoomProc:
		case floatZoomGrowProc:
		    Tcl_SetResult(interp, "floatZoomProc", TCL_STATIC);
		    break;
		case floatSideProc:
		case floatSideGrowProc:
		    Tcl_SetResult(interp, "floatSideProc", TCL_STATIC);
		    break;
		case floatSideZoomProc:
		case floatSideZoomGrowProc:
		    Tcl_SetResult(interp, "floatSideZoomProc", TCL_STATIC);
		    break;
		default:
		   panic("invalid style");
	    }
	    return TCL_OK;
	}
	if (strcmp(argv[3], "documentProc") == 0) {
3856
3857
3858
3859
3860
3861
3862







3863
3864
3865
3866
3867
3868
3869
    if (Tk_IsEmbedded(winPtr)) {
	TkWindow *contWinPtr;

	contWinPtr = TkpGetOtherWindow(winPtr);
	if (contWinPtr != NULL) {
	    TkMacMakeRealWindowExist(contWinPtr->privatePtr->toplevel->winPtr);
	    macWin->flags |= TK_HOST_EXISTS;







	    return;
	} else {
	    panic("TkMacMakeRealWindowExist could not find container");
	}

	/*
	 * NOTE: Here we should handle out of process embedding.







>
>
>
>
>
>
>







3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
    if (Tk_IsEmbedded(winPtr)) {
	TkWindow *contWinPtr;

	contWinPtr = TkpGetOtherWindow(winPtr);
	if (contWinPtr != NULL) {
	    TkMacMakeRealWindowExist(contWinPtr->privatePtr->toplevel->winPtr);
	    macWin->flags |= TK_HOST_EXISTS;
	    return;
	} else if (gMacEmbedHandler != NULL) {
	    if (gMacEmbedHandler->containerExistProc != NULL) {
	        if (gMacEmbedHandler->containerExistProc((Tk_Window) winPtr) != TCL_OK) {
	           panic("ContainerExistProc could not make container");
	       }
	    }
	    return;
	} else {
	    panic("TkMacMakeRealWindowExist could not find container");
	}

	/*
	 * NOTE: Here we should handle out of process embedding.
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
    
    listPtr = (TkMacWindowList *) ckalloc(sizeof(TkMacWindowList));
    listPtr->nextPtr = tkMacWindowListPtr;
    listPtr->winPtr = winPtr;
    tkMacWindowListPtr = listPtr;
    
    macWin->portPtr = (GWorldPtr) newWindow;
    MacMoveWindow(newWindow, (int) geometry.left, (int) geometry.top);
    SetPort((GrafPtr) newWindow);
	
    if (!windowHashInit) {
	Tcl_InitHashTable(&windowTable, TCL_ONE_WORD_KEYS);
	windowHashInit = true;
    }
    valueHashPtr = Tcl_CreateHashEntry(&windowTable,







|







3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
    
    listPtr = (TkMacWindowList *) ckalloc(sizeof(TkMacWindowList));
    listPtr->nextPtr = tkMacWindowListPtr;
    listPtr->winPtr = winPtr;
    tkMacWindowListPtr = listPtr;
    
    macWin->portPtr = (GWorldPtr) newWindow;
    tkMacMoveWindow(newWindow, (int) geometry.left, (int) geometry.top);
    SetPort((GrafPtr) newWindow);
	
    if (!windowHashInit) {
	Tcl_InitHashTable(&windowTable, TCL_ONE_WORD_KEYS);
	windowHashInit = true;
    }
    valueHashPtr = Tcl_CreateHashEntry(&windowTable,
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184


4185
4186
4187

4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208



4209
4210
4211

4212
4213

    macWin = TkMacGetDrawablePort(winPtr->window);

    if (state == WithdrawnState) {
	Tk_UnmapWindow((Tk_Window) winPtr);
    } else if (state == IconicState) {
	Tk_UnmapWindow((Tk_Window) winPtr);
#ifdef HAVE_APPEARANCE
	if (HaveAppearance()) {
	    /*
	     * The window always gets unmapped.  However, if we can show the
	     * icon version of the window (collapsed) we make the window visable
	     * and then collapse it.
	     *
	     * TODO: This approach causes flashing!
	     */

	    if (IsWindowCollapsable((WindowRef) macWin)) {
		ShowWindow((WindowRef) macWin);
		CollapseWindow((WindowPtr) macWin, true);
	    }
	}
#endif
    } else if (state == NormalState) {
	Tk_MapWindow((Tk_Window) winPtr);
#ifdef HAVE_APPEARANCE
	if (HaveAppearance()) {
	    CollapseWindow((WindowPtr) macWin, false);
	}
#endif
    } else if (state == ZoomState) {
	/* TODO: need to support zoomed windows */
    }
}
/*
 *----------------------------------------------------------------------
 *
 * HaveAppearance --
 *
 *	Determine if the appearance manager is available on this Mac.
 *	We cache the result so future calls are fast.


 *
 * Results:
 *	True if the appearance manager is present, false otherwise.

 *
 * Side effects:
 *	Calls Gestalt to query system values.
 *
 *----------------------------------------------------------------------
 */

static int
HaveAppearance()
{
    static initialized = false;
    static int haveAppearance = false;
    long response = 0;
    OSErr err = noErr;
    
#ifdef HAVE_APPEARANCE
    if (!initialized) {
	err = Gestalt(gestaltAppearanceAttr, &response);
	if (err == noErr) {
	    haveAppearance = true;
	}



    }
#endif


    return haveAppearance;
}







<
|













<


<
|


<







|


|
>
>


|
>







|
|


|



<



|

>
>
>
|
<
|
>
|

4201
4202
4203
4204
4205
4206
4207

4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221

4222
4223

4224
4225
4226

4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258

4259
4260
4261
4262
4263
4264
4265
4266
4267

4268
4269
4270
4271

    macWin = TkMacGetDrawablePort(winPtr->window);

    if (state == WithdrawnState) {
	Tk_UnmapWindow((Tk_Window) winPtr);
    } else if (state == IconicState) {
	Tk_UnmapWindow((Tk_Window) winPtr);

	if (TkMacHaveAppearance()) {
	    /*
	     * The window always gets unmapped.  However, if we can show the
	     * icon version of the window (collapsed) we make the window visable
	     * and then collapse it.
	     *
	     * TODO: This approach causes flashing!
	     */

	    if (IsWindowCollapsable((WindowRef) macWin)) {
		ShowWindow((WindowRef) macWin);
		CollapseWindow((WindowPtr) macWin, true);
	    }
	}

    } else if (state == NormalState) {
	Tk_MapWindow((Tk_Window) winPtr);

	if (TkMacHaveAppearance()) {
	    CollapseWindow((WindowPtr) macWin, false);
	}

    } else if (state == ZoomState) {
	/* TODO: need to support zoomed windows */
    }
}
/*
 *----------------------------------------------------------------------
 *
 * TkMacHaveAppearance --
 *
 *	Determine if the appearance manager is available on this Mac.
 *	We cache the result so future calls are fast.  Return a different
 *      value if 1.0.1 is present, since many interfaces were added in
 *      1.0.1
 *
 * Results:
 *	1 if the appearance manager is present, 2 if the appearance
 *      manager version is 1.0.1 or greater, 0 if it is not present.
 *
 * Side effects:
 *	Calls Gestalt to query system values.
 *
 *----------------------------------------------------------------------
 */

int
TkMacHaveAppearance()
{
    static initialized = false;
    static int TkMacHaveAppearance = 0;
    long response = 0;
    OSErr err = noErr;
    

    if (!initialized) {
	err = Gestalt(gestaltAppearanceAttr, &response);
	if (err == noErr) {
	    TkMacHaveAppearance = 1;
	}
	err = Gestalt(gestaltAppearanceVersion, &response);
	if (err == noErr) {
	    TkMacHaveAppearance = 2;
	}

    }

    return TkMacHaveAppearance;
}

Changes to mac/tkMacXCursors.r.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkMacXCursors.r --
 *
 *	This file defines a set of Macintosh cursor resources that
 * 	emulate the X cursor set.  All of these cursors were
 *	constructed and donated by Grant Neufeld. ([email protected])
 *	
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacXCursors.r 1.4 96/01/11 13:18:22
 */

/*
 * All of the X cursors are defined as 'CURS' resources.  However, a
 * subset of the X cursors are also defined as 'crsr' resources.  Tk
 * will attempt to first use the color cursors ('crsr') if it doesn't
 * exist it will attempt to use the black & white cursor ('CURS').













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkMacXCursors.r --
 *
 *	This file defines a set of Macintosh cursor resources that
 * 	emulate the X cursor set.  All of these cursors were
 *	constructed and donated by Grant Neufeld. ([email protected])
 *	
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacXCursors.r,v 1.1.4.1 1998/09/30 02:18:20 stanton Exp $
 */

/*
 * All of the X cursors are defined as 'CURS' resources.  However, a
 * subset of the X cursors are also defined as 'crsr' resources.  Tk
 * will attempt to first use the color cursors ('crsr') if it doesn't
 * exist it will attempt to use the black & white cursor ('CURS').

Changes to mac/tkMacXStubs.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkMacXStubs.c --
 *
 *	This file contains most of the X calls called by Tk.  Many of
 * these calls are just stubs and either don't make sense on the
 * Macintosh or thier implamentation just doesn't do anything.  Other
 * calls will eventually be moved into other files.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkMacXStubs.c 1.87 97/11/20 18:35:29
 */

#include "tkInt.h"
#include <X.h>
#include <Xlib.h>
#include <stdio.h>
#include <tcl.h>













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkMacXStubs.c --
 *
 *	This file contains most of the X calls called by Tk.  Many of
 * these calls are just stubs and either don't make sense on the
 * Macintosh or thier implamentation just doesn't do anything.  Other
 * calls will eventually be moved into other files.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkMacXStubs.c,v 1.1.4.3 1999/03/10 07:13:49 stanton Exp $
 */

#include "tkInt.h"
#include <X.h>
#include <Xlib.h>
#include <stdio.h>
#include <tcl.h>
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
#define ROOT_ID 10

/*
 * Declarations of static variables used in this file.
 */

static TkDisplay *gMacDisplay = NULL; /* Macintosh display. */
static char *macScreenName = "Macintosh:0";
				/* Default name of macintosh display. */

/*
 * Forward declarations of procedures used in this file.
 */

static XID MacXIdAlloc _ANSI_ARGS_((Display *display));







|







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
#define ROOT_ID 10

/*
 * Declarations of static variables used in this file.
 */

static TkDisplay *gMacDisplay = NULL; /* Macintosh display. */
static char *macScreenName = ":0";
				/* Default name of macintosh display. */

/*
 * Forward declarations of procedures used in this file.
 */

static XID MacXIdAlloc _ANSI_ARGS_((Display *display));
511
512
513
514
515
516
517









































518
519
520
521
522
523
524
    /* 
     * This function is just a no-op.  It is defined to 
     * reset the screen saver.  However, there is no real
     * way to do this on a Mac.  Let me know if there is!
     */
    display->request++;
}










































/*
 *----------------------------------------------------------------------
 *
 * TkGetServerInfo --
 *
 *	Given a window, this procedure returns information about







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







511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
    /* 
     * This function is just a no-op.  It is defined to 
     * reset the screen saver.  However, there is no real
     * way to do this on a Mac.  Let me know if there is!
     */
    display->request++;
}

void
Tk_FreeXId (
    Display *display,
    XID xid)
{
    /* no-op function needed for stubs implementation. */
}

void
Tk_3DHorizontalBevel (
    Tk_Window tkwin,
    Drawable d,
    Tk_3DBorder b,
    int x,
    int y,
    int width,
    int height,
    int leftIn,
    int rightIn,
    int topBevel,
    int relief)
{
    /* no-op function needed for stubs implementation. */
}

void
Tk_3DVerticalBevel (
    Tk_Window tkwin,
    Drawable d,
    Tk_3DBorder b,
    int x,
    int y,
    int width,
    int height,
    int leftBevel,
    int relief)
{
    /* no-op function needed for stubs implementation. */
}


/*
 *----------------------------------------------------------------------
 *
 * TkGetServerInfo --
 *
 *	Given a window, this procedure returns information about
537
538
539
540
541
542
543

544
545
546
547
548
549
550
551
void
TkGetServerInfo(
    Tcl_Interp *interp,		/* The server information is returned in
				 * this interpreter's result. */
    Tk_Window tkwin)		/* Token for window;  this selects a
				 * particular display and server. */
{

    char buffer[50], buffer2[50];

    sprintf(buffer, "X%dR%d ", ProtocolVersion(Tk_Display(tkwin)),
	    ProtocolRevision(Tk_Display(tkwin)));
    sprintf(buffer2, " %d", VendorRelease(Tk_Display(tkwin)));
    Tcl_AppendResult(interp, buffer, ServerVendor(Tk_Display(tkwin)),
	    buffer2, (char *) NULL);
}







>
|







578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
void
TkGetServerInfo(
    Tcl_Interp *interp,		/* The server information is returned in
				 * this interpreter's result. */
    Tk_Window tkwin)		/* Token for window;  this selects a
				 * particular display and server. */
{
    char buffer[8 + TCL_INTEGER_SPACE * 2];
    char buffer2[TCL_INTEGER_SPACE];

    sprintf(buffer, "X%dR%d ", ProtocolVersion(Tk_Display(tkwin)),
	    ProtocolRevision(Tk_Display(tkwin)));
    sprintf(buffer2, " %d", VendorRelease(Tk_Display(tkwin)));
    Tcl_AppendResult(interp, buffer, ServerVendor(Tk_Display(tkwin)),
	    buffer2, (char *) NULL);
}

Changes to tests/README.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Tk Test Suite
--------------

SCCS: @(#) README 1.2 96/03/27 08:52:21

This directory contains a set of validation tests for Tk.
Each of the files whose name ends in ".test" is intended to
fully exercise one or a few Tk features.  The features
tested by a given file are listed in the first line of the
file.  The test suite is nowhere near complete yet.  Contributions
of additional tests would be most welcome.

You can run the tests in two ways:
    (a) type "make test" in the directory ../unix; this will run all of
        the tests.
    (b) start up tktest in this directory, then "source" the test
        file (for example, type "source pack.test").  To run all
	of the tests, type "source all".
In either case no output will be generated if all goes well, except
for a listing of the tests.  If there are errors then additional
messages will appear.

For more details on the testing environment, see the README
file in the Tcl test directory.

You can also run a set of visual tests, which create various screens
that you can verify visually for appropriate behavior.  The visual
tests are available through the "visual" script:  if you invoke this
script, it creates a main window with a bunch of menus.  Each menu
runs a particular test.
|
<

|

|
<
<
<
<
<
|
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
1

2
3
4
5





6


7















README -- Tk test suite design document.


RCS: @(#) $Id: README,v 1.1.4.3 1999/03/24 01:16:26 hershey Exp $

This directory contains a set of validation tests for the Tk commands.





Please see the tests/README file in the Tcl source distribution for


information about the test suite.















Deleted tests/all.

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
# This file contains a top-level script to run all of the Tcl
# tests.  Execute it by invoking "source all" when running tclTest
# in this directory.
#
# SCCS: @(#) all 1.23 97/08/06 18:50:18

switch $tcl_platform(platform) {
    "windows" {
	# Tests that cause tk to crash under windows.
	set crash {}

	# Tests that fail under windows.

	set fail { grid.test }

	if {! [info exist exclude] } {
	    set exclude [string tolower "$crash $fail"]
	}
    }
    "macintosh" {
	set x [pwd]
	cd $tk_library
	set tk_library [pwd]
	cd $x
	
	# Tests that cause tk to crash under mac.
	set crash {}

	# Tests that fail under mac.
	set fail {bind.test entry.test send.test textDisp.test}
	
	set exclude [string tolower "$crash $fail"]
    }    
    "unix" {
	set exclude ""
    }
}

if {$tcl_platform(os) == "Win32s"} {
    set tests [lsort [glob *.tes]]
} else {
    set tests [lsort [glob *.test]]
}

foreach i $tests {
    if [string match l.*.test $i] {
	# This is an SCCS lock file;  ignore it.
	continue
    }
    if [lsearch $exclude [string tolower $i]]>=0 {
	# Do not source this file; it exercises a known bug at this time.
	puts stdout "Skipping $i"
	continue
    }
    puts stdout $i
    source $i
}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















































































































Added tests/all.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
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
# all.tcl --
#
# This file contains a top-level script to run all of the Tk
# tests.  Execute it by invoking "source all.tcl" when running tktest
# in this directory.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
# 
# RCS: @(#) $Id: all.tcl,v 1.1.2.6 1999/04/07 01:59:48 hershey Exp $

if {[lsearch ::tcltest [namespace children]] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}
set ::tcltest::testSingleFile false

puts stdout "Tk $tk_patchLevel tests running in interp:  [info nameofexecutable]"
puts stdout "Tests running in working dir:  $::tcltest::workingDir"
if {[llength $::tcltest::skip] > 0} {
    puts stdout "Skipping tests that match:  $::tcltest::skip"
}
if {[llength $::tcltest::match] > 0} {
    puts stdout "Only running tests that match:  $::tcltest::match"
}

# Use command line specified glob pattern (specified by -file or -f)
# if one exists.  Otherwise use *.test.  If given, the file pattern
# should be specified relative to the dir containing this file.  If no
# files are found to match the pattern, print an error message and exit.
set fileIndex [expr {[lsearch $argv "-file"] + 1}]
set fIndex [expr {[lsearch $argv "-f"] + 1}]
if {($fileIndex < 1) || ($fIndex > $fileIndex)} {
    set fileIndex $fIndex
}
if {$fileIndex > 0} {
    set globPattern [file join $::tcltest::testsDir [lindex $argv $fileIndex]]
    puts stdout "Sourcing files that match:  $globPattern"
} else {
    set globPattern [file join $::tcltest::testsDir *.test]
}
set fileList [glob -nocomplain $globPattern]
if {[llength $fileList] < 1} {
    puts "Error: no files found matching $globPattern"
    exit
}
set timeCmd {clock format [clock seconds]}
puts stdout "Tests began at [eval $timeCmd]"

# source each of the specified tests
foreach file [lsort $fileList] {
    set tail [file tail $file]
    if {[string match l.*.test $tail]} {
	# This is an SCCS lockfile; ignore it
	continue
    }
    puts stdout $tail
    if {[catch {source $file} msg]} {
	puts stdout $msg
    }
}

# cleanup
puts stdout "\nTests ended at [eval $timeCmd]"
::tcltest::cleanupTests 1
return













Changes to tests/arc.tcl.

1
2
3
4
5
6
7
8
9
10
11
# This file creates a visual test for arcs.  It is part of the Tk
# visual test suite, which is invoked via the "visual" script.
#
# SCCS: @(#) arc.tcl 1.5 96/02/16 10:55:40

catch {destroy .t}
toplevel .t
wm title .t "Visual Tests for Canvas Arcs"
wm iconname .t "Arcs"
wm geom .t +0+0
wm minsize .t 1 1



|







1
2
3
4
5
6
7
8
9
10
11
# This file creates a visual test for arcs.  It is part of the Tk
# visual test suite, which is invoked via the "visual" script.
#
# RCS: @(#) $Id: arc.tcl,v 1.1.4.3 1999/03/24 02:54:20 hershey Exp $

catch {destroy .t}
toplevel .t
wm title .t "Visual Tests for Canvas Arcs"
wm iconname .t "Arcs"
wm geom .t +0+0
wm minsize .t 1 1
134
135
136
137
138
139
140













	update
    }
}

bind .t.c b {set go 0}

bind .t.c <Control-x> {.t.c delete current}




















>
>
>
>
>
>
>
>
>
>
>
>
>
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
	update
    }
}

bind .t.c b {set go 0}

bind .t.c <Control-x> {.t.c delete current}













Changes to tests/bell.test.

1
2
3
4
5

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out Tk's "bell" command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.

#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) bell.test 1.5 96/04/09 23:47:12

if {[string compare test [info procs test]] == 1} {
    source defs
}

test bell-1.1 {bell command} {
    list [catch {bell a} msg] $msg
} {1 {wrong # args: should be "bell ?-displayof window?"}}
test bell-1.2 {bell command} {
    list [catch {bell a b} msg] $msg




|
>

<
|
|
<
|
<
|







1
2
3
4
5
6
7

8
9

10

11
12
13
14
15
16
17
18
# This file is a Tcl script to test out Tk's "bell" command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#

# RCS: @(#) $Id: bell.test,v 1.1.4.4 1999/03/24 02:54:21 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {

    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test bell-1.1 {bell command} {
    list [catch {bell a} msg] $msg
} {1 {wrong # args: should be "bell ?-displayof window?"}}
test bell-1.2 {bell command} {
    list [catch {bell a b} msg] $msg
28
29
30
31
32
33
34

















    after 500
    bell -displayof .
    after 200
    bell
    after 200
    bell
} {}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
    after 500
    bell -displayof .
    after 200
    bell
    after 200
    bell
} {}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/bevel.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# This file creates a visual test for bevels drawn around text in text
# widgets.  It is part of the Tk visual test suite, which is invoked
# via the "visual" script.
#
# SCCS: @(#) bevel.tcl 1.4 96/06/24 16:48:14

catch {destroy .t}
toplevel .t
wm title .t "Visual Tests for Borders in Text Widgets"
wm iconname .t "Text Borders"
wm geom .t +0+0





|







1
2
3
4
5
6
7
8
9
10
11
12
# This file creates a visual test for bevels drawn around text in text
# widgets.  It is part of the Tk visual test suite, which is invoked
# via the "visual" script.
#
# RCS: @(#) $Id: bevel.tcl,v 1.1.4.3 1999/03/24 02:54:22 hershey Exp $

catch {destroy .t}
toplevel .t
wm title .t "Visual Tests for Borders in Text Widgets"
wm iconname .t "Text Borders"
wm geom .t +0+0

122
123
124
125
126
127
128













    .t.t insert end ***
    .t.t insert end rrrrr r1
}
.t.t insert end \n
.t.t insert end rrr r1
.t.t insert end *****
.t.t insert end rrr r1




















>
>
>
>
>
>
>
>
>
>
>
>
>
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
    .t.t insert end ***
    .t.t insert end rrrrr r1
}
.t.t insert end \n
.t.t insert end rrr r1
.t.t insert end *****
.t.t insert end rrr r1













Changes to tests/bgerror.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# This file is a Tcl script to test the bgerror command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) bgerror.test 1.1 97/08/06 09:28:30

if {[info commands test] == ""} {
    source defs
}


test bgerror-1.1 {bgerror / tkerror compat} {
    set errRes {}
    proc tkerror {err} {
	global errRes;
	set errRes $err;
    }




|
|
<

|

|
|

<







1
2
3
4
5
6

7
8
9
10
11
12

13
14
15
16
17
18
19
# This file is a Tcl script to test the bgerror command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: bgerror.test,v 1.1.4.4 1999/03/24 02:54:22 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}


test bgerror-1.1 {bgerror / tkerror compat} {
    set errRes {}
    proc tkerror {err} {
	global errRes;
	set errRes $err;
    }
52
53
54
55
56
57
58
59
















} err1

catch {rename tkerror {}}

# some testing of the default error dialog
# would be needed too, but that's not easy at all
# to emulate.

























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
} err1

catch {rename tkerror {}}

# some testing of the default error dialog
# would be needed too, but that's not easy at all
# to emulate.

# cleanup
::tcltest::cleanupTests
return













Changes to tests/bind.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# This file is a Tcl script to test out Tk's "bind" and "bindtags"
# commands plus the procedures in tkBind.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) bind.test 1.39 97/07/01 18:01:05

if {[string compare test [info procs test]] != 0} {
    source defs
}

catch {destroy .b}
toplevel .b -width 100 -height 50
wm geom .b +0+0
update idletasks







|
|
<

|

|
|







1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out Tk's "bind" and "bindtags"
# commands plus the procedures in tkBind.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: bind.test,v 1.1.4.6 1999/03/24 02:54:23 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

catch {destroy .b}
toplevel .b -width 100 -height 50
wm geom .b +0+0
update idletasks

211
212
213
214
215
216
217






218
219
220
221
222
223
224

test bind-5.1 {Tk_CreateBindingTable procedure} {
    catch {destroy .b.c}
    canvas .b.c
    .b.c bind foo
} {}








test bind-6.1 {Tk_DeleteBindTable procedure} {
    catch {destroy .b.c}
    canvas .b.c
    .b.c bind foo <1> {string 1}
    .b.c create rectangle 0 0 100 100
    .b.c bind 1 <2> {string 2}







>
>
>
>
>
>







210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229

test bind-5.1 {Tk_CreateBindingTable procedure} {
    catch {destroy .b.c}
    canvas .b.c
    .b.c bind foo
} {}


if {[string compare testcbind [info commands testcbind]] != 0} {
    puts "This application hasn't been compiled with the testcbind command,"
    puts "therefore I am skipping all of these tests."
    return
}

test bind-6.1 {Tk_DeleteBindTable procedure} {
    catch {destroy .b.c}
    canvas .b.c
    .b.c bind foo <1> {string 1}
    .b.c create rectangle 0 0 100 100
    .b.c bind 1 <2> {string 2}
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
	event gen .t <1>
    }
    set x [foo eval set x]
    interp delete foo
    set x
} {a1 bye.all2 bye.a1 b1 bye.c1}

test bind-7.1 {Tk_CreateBinding procedure: error} {
    catch {destroy .b.c}
    canvas .b.c
    list [catch {.b.c bind foo <} msg] $msg
} {1 {no event type or button # or keysym}}
test bind-7.2 {Tk_CreateBinding procedure: replace existing C binding} {
    catch {destroy .b.f}
    frame .b.f







|







248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
	event gen .t <1>
    }
    set x [foo eval set x]
    interp delete foo
    set x
} {a1 bye.all2 bye.a1 b1 bye.c1}

test bind-7.1 {Tk_CreateBinding procedure: bad binding} {
    catch {destroy .b.c}
    canvas .b.c
    list [catch {.b.c bind foo <} msg] $msg
} {1 {no event type or button # or keysym}}
test bind-7.2 {Tk_CreateBinding procedure: replace existing C binding} {
    catch {destroy .b.f}
    frame .b.f
1459
1460
1461
1462
1463
1464
1465



1466
1467
1468
1469
1470
1471
1472
1473
1474
    event gen .b.f <Key-Tab>
    event gen .b.f <Key-Return>
    event gen .b.f <Key-F1>
    event gen .b.f <Key-Shift_L>
    event gen .b.f <Key-space>
    event gen .b.f <Key-dollar> -state 1
    event gen .b.f <Key-braceleft> -state 1



    set x
} "a A {	} {\r} {{}} {{}} { } {\$} \\\{"
test bind-16.36 {ExpandPercents procedure} {
    setup
    bind .b.f <Configure> {set x "%B"}
    set x none
    event gen .b.f <Configure> -borderwidth 24 -window .b.f
    set x
} 24







>
>
>

|







1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
    event gen .b.f <Key-Tab>
    event gen .b.f <Key-Return>
    event gen .b.f <Key-F1>
    event gen .b.f <Key-Shift_L>
    event gen .b.f <Key-space>
    event gen .b.f <Key-dollar> -state 1
    event gen .b.f <Key-braceleft> -state 1
    event gen .b.f <Key-Multi_key>
    event gen .b.f <Key-e>
    event gen .b.f <Key-apostrophe>
    set x
} "a A {	} {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} \u00e9"
test bind-16.36 {ExpandPercents procedure} {
    setup
    bind .b.f <Configure> {set x "%B"}
    set x none
    event gen .b.f <Configure> -borderwidth 24 -window .b.f
    set x
} 24
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
    event gen .b.f <Button> -rootx 422 -rooty 13
    set x
} {422 13}


test bind-17.1 {event command} {
    list [catch {event} msg] $msg
} {1 {wrong # args: should be "event option ?arg1?"}}
test bind-17.2 {event command} {
    list [catch {event {}} msg] $msg
} {1 {bad option "": should be add, delete, generate, info}}
test bind-17.3 {event command: add} {
    list [catch {event add} msg] $msg
} {1 {wrong # args: should be "event add virtual sequence ?sequence ...?"}}
test bind-17.4 {event command: add 1} {
    setup
    event add <<Paste>> <Control-v>
    event info <<Paste>>







|

|
|







1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
    event gen .b.f <Button> -rootx 422 -rooty 13
    set x
} {422 13}


test bind-17.1 {event command} {
    list [catch {event} msg] $msg
} {1 {wrong # args: should be "event option ?arg?"}}
test bind-17.2 {event command} {
    list [catch {event xyz} msg] $msg
} {1 {bad option "xyz": must be add, delete, generate, or info}}
test bind-17.3 {event command: add} {
    list [catch {event add} msg] $msg
} {1 {wrong # args: should be "event add virtual sequence ?sequence ...?"}}
test bind-17.4 {event command: add 1} {
    setup
    event add <<Paste>> <Control-v>
    event info <<Paste>>
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
    set x
} {1}
test bind-17.16 {event command: generate} {
    list [catch {event generate .b.f <xyz>} msg] $msg
} {1 {bad event type or keysym "xyz"}}
test bind-17.17 {event command} {
    list [catch {event foo} msg] $msg
} {1 {bad option "foo": should be add, delete, generate, info}}


test bind-18.1 {CreateVirtualEvent procedure: GetVirtualEventUid} {
    list [catch {event add asd <Ctrl-v>} msg] $msg
} {1 {virtual event "asd" is badly formed}}
test bind-18.2 {CreateVirtualEvent procedure: FindSequence} {
    list [catch {event add <<asd>> <Ctrl-v>} msg] $msg
} {1 {bad event type or keysym "Ctrl"}}







|
<







1608
1609
1610
1611
1612
1613
1614
1615

1616
1617
1618
1619
1620
1621
1622
    set x
} {1}
test bind-17.16 {event command: generate} {
    list [catch {event generate .b.f <xyz>} msg] $msg
} {1 {bad event type or keysym "xyz"}}
test bind-17.17 {event command} {
    list [catch {event foo} msg] $msg
} {1 {bad option "foo": must be add, delete, generate, or info}}


test bind-18.1 {CreateVirtualEvent procedure: GetVirtualEventUid} {
    list [catch {event add asd <Ctrl-v>} msg] $msg
} {1 {virtual event "asd" is badly formed}}
test bind-18.2 {CreateVirtualEvent procedure: FindSequence} {
    list [catch {event add <<asd>> <Ctrl-v>} msg] $msg
} {1 {bad event type or keysym "Ctrl"}}
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
    event gen .b.f <Button> -when tail -serial 102
    lappend x foo
    update
    set x
} {foo 99 100 101 102}
test bind-22.17 {HandleEventGenerate} {
    list [catch {event gen . <Button> -when xyz} msg] $msg
} {1 {bad position "xyz": should be now, head, mark, tail}}
set i 14
foreach check {
    {<Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}}
    {<Configure> %a {-above .b} {[winfo id .b]}}
    {<Configure> %a {-above xyz} {{1 {expected integer but got "xyz"}}}}
    {<Configure> %a {-above [winfo id .b]} {[winfo id .b]}}
    {<Key> %b    {-above .} {{1 {bad option to <Key> event: "-above"}}}}

    {<Configure> %B {-borderwidth xyz} {{1 {bad screen distance "xyz"}}}}    
    {<Configure> %B {-borderwidth 2i} {[winfo pixels .b.f 2i]}}
    {<Key> %k	    {-borderwidth 2i} {{1 {bad option to <Key> event: "-borderwidth"}}}}

    {<Button> %b    {-button xyz} {{1 {expected integer but got "xyz"}}}}
    {<Button> %b    {-button 1} 1}
    {<Key> %k	    {-button 1} {{1 {bad option to <Key> event: "-button"}}}}

    {<Expose> %c    {-count xyz} {{1 {expected integer but got "xyz"}}}}
    {<Expose> %c    {-count 20} 20}
    {<Key> %b	    {-count 20} {{1 {bad option to <Key> event: "-count"}}}}

    {<Enter> %d	    {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, NotifyDetailNone}}}}
    {<FocusIn> %d   {-detail NotifyVirtual} {{}}}
    {<Enter> %d	    {-detail NotifyVirtual} NotifyVirtual}
    {<Key> %k	    {-detail NotifyVirtual} {{1 {bad option to <Key> event: "-detail"}}}}

    {<Enter> %f	    {-focus xyz} {{1 {expected boolean value but got "xyz"}}}}
    {<Enter> %f	    {-focus 1} 1}
    {<Key> %k	    {-focus 1} {{1 {bad option to <Key> event: "-focus"}}}}

    {<Expose> %h    {-height xyz} {{1 {bad screen distance "xyz"}}}}
    {<Expose> %h    {-height 2i} {[winfo pixels .b.f 2i]}}
    {<Configure> %h {-height 2i} {[winfo pixels .b.f 2i]}}
    {<Key> %k	    {-height 2i} {{1 {bad option to <Key> event: "-height"}}}}

    {<Key> %k	    {-keycode xyz} {{1 {expected integer but got "xyz"}}}}
    {<Key> %k	    {-keycode 20} 20}
    {<Button> %b    {-keycode 20} {{1 {bad option to <Button> event: "-keycode"}}}}

    {<Key> %K	    {-keysym xyz} {{1 {unknown keysym "xyz"}}}}
    {<Key> %K	    {-keysym a} a}
    {<Button> %b    {-keysym a} {{1 {bad option to <Button> event: "-keysym"}}}}

    {<Enter> %m	    {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, NotifyWhileGrabbed}}}}
    {<Enter> %m	    {-mode NotifyNormal} NotifyNormal}
    {<FocusIn> %m   {-mode NotifyNormal} {{}}}
    {<Key> %k	    {-mode NotifyNormal} {{1 {bad option to <Key> event: "-mode"}}}}

    {<Map> %o	    {-override xyz} {{1 {expected boolean value but got "xyz"}}}}
    {<Map> %o	    {-override 1} 1}
    {<Reparent> %o  {-override 1} 1}
    {<Configure> %o {-override 1} 1}
    {<Key> %k	    {-override 1} {{1 {bad option to <Key> event: "-override"}}}}

    {<Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, PlaceOnBottom}}}}
    {<Circulate> %p {-place PlaceOnTop} PlaceOnTop}
    {<Key> %k	    {-place PlaceOnTop} {{1 {bad option to <Key> event: "-place"}}}}

    {<Key> %R	    {-root .xyz} {{1 {bad window path name ".xyz"}}}}
    {<Key> %R	    {-root .b} {[winfo id .b]}}
    {<Key> %R	    {-root xyz} {{1 {expected integer but got "xyz"}}}}
    {<Key> %R	    {-root [winfo id .b]} {[winfo id .b]}}
    {<Button> %R    {-root .b} {[winfo id .b]}}
    {<Motion> %R    {-root .b} {[winfo id .b]}}
    {<<Paste>> %R   {-root .b} {[winfo id .b]}}
    {<Enter> %R	    {-root .b} {[winfo id .b]}}
    {<Configure> %R {-root .b} {{1 {bad option to <Configure> event: "-root"}}}}

    {<Key> %X	    {-rootx xyz} {{1 {bad screen distance "xyz"}}}}
    {<Key> %X	    {-rootx 2i} {[winfo pixels .b.f 2i]}}
    {<Button> %X    {-rootx 2i} {[winfo pixels .b.f 2i]}}
    {<Motion> %X    {-rootx 2i} {[winfo pixels .b.f 2i]}}
    {<<Paste>> %X   {-rootx 2i} {[winfo pixels .b.f 2i]}}
    {<Enter> %X	    {-rootx 2i} {[winfo pixels .b.f 2i]}}
    {<Configure> %X {-rootx 2i} {{1 {bad option to <Configure> event: "-rootx"}}}}

    {<Key> %Y	    {-rooty xyz} {{1 {bad screen distance "xyz"}}}}
    {<Key> %Y	    {-rooty 2i} {[winfo pixels .b.f 2i]}}
    {<Button> %Y    {-rooty 2i} {[winfo pixels .b.f 2i]}}
    {<Motion> %Y    {-rooty 2i} {[winfo pixels .b.f 2i]}}
    {<<Paste>> %Y   {-rooty 2i} {[winfo pixels .b.f 2i]}}
    {<Enter> %Y	    {-rooty 2i} {[winfo pixels .b.f 2i]}}
    {<Configure> %Y {-rooty 2i} {{1 {bad option to <Configure> event: "-rooty"}}}}

    {<Key> %E	    {-sendevent xyz} {{1 {expected boolean value but got "xyz"}}}}
    {<Key> %E	    {-sendevent 1} 1}
    {<Key> %E	    {-sendevent yes} 1}
    {<Key> %E	    {-sendevent 43} 43}

    {<Key> %#	    {-serial xyz} {{1 {expected integer but got "xyz"}}}}
    {<Key> %#	    {-serial 100} 100}

    {<Key> %s	    {-state xyz} {{1 {expected integer but got "xyz"}}}}
    {<Key> %s	    {-state 1} 1}
    {<Button> %s    {-state 1} 1}
    {<Motion> %s    {-state 1} 1}
    {<<Paste>> %s   {-state 1} 1}
    {<Enter> %s	    {-state 1} 1}
    {<Visibility> %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, VisibilityFullyObscured}}}}
    {<Visibility> %s {-state VisibilityUnobscured} VisibilityUnobscured}
    {<Configure> %s {-state xyz} {{1 {bad option to <Configure> event: "-state"}}}}

    {<Key> %S	    {-subwindow .xyz} {{1 {bad window path name ".xyz"}}}}
    {<Key> %S	    {-subwindow .b} {[winfo id .b]}}
    {<Key> %S	    {-subwindow xyz} {{1 {expected integer but got "xyz"}}}}
    {<Key> %S	    {-subwindow [winfo id .b]} {[winfo id .b]}}
    {<Button> %S    {-subwindow .b} {[winfo id .b]}}
    {<Motion> %S    {-subwindow .b} {[winfo id .b]}}
    {<<Paste>> %S   {-subwindow .b} {[winfo id .b]}}
    {<Enter> %S	    {-subwindow .b} {[winfo id .b]}}
    {<Configure> %S {-subwindow .b} {{1 {bad option to <Configure> event: "-subwindow"}}}}

    {<Key> %t	    {-time xyz} {{1 {expected integer but got "xyz"}}}}
    {<Key> %t	    {-time 100} 100}
    {<Button> %t    {-time 100} 100}
    {<Motion> %t    {-time 100} 100}
    {<<Paste>> %t   {-time 100} 100}
    {<Enter> %t	    {-time 100} 100}
    {<Property> %t  {-time 100} 100}
    {<Configure> %t {-time 100} {{1 {bad option to <Configure> event: "-time"}}}}

    {<Expose> %w    {-width xyz} {{1 {bad screen distance "xyz"}}}}
    {<Expose> %w    {-width 2i} {[winfo pixels .b.f 2i]}}
    {<Configure> %w {-width 2i} {[winfo pixels .b.f 2i]}}
    {<Key> %k	    {-width 2i} {{1 {bad option to <Key> event: "-width"}}}}

    {<Unmap> %W    {-window .xyz} {{1 {bad window path name ".xyz"}}}}
    {<Unmap> %W    {-window .b.f} .b.f}
    {<Unmap> %W    {-window xyz} {{1 {expected integer but got "xyz"}}}}
    {<Unmap> %W    {-window [winfo id .b.f]} .b.f}
    {<Unmap> %W	    {-window .b.f} .b.f}
    {<Map> %W	    {-window .b.f} .b.f}
    {<Reparent> %W  {-window .b.f} .b.f}
    {<Configure> %W {-window .b.f} .b.f}
    {<Gravity> %W   {-window .b.f} .b.f}
    {<Circulate> %W {-window .b.f} .b.f}
    {<Key> %W	    {-window .b.f} {{1 {bad option to <Key> event: "-window"}}}}

    {<Key> %x	    {-x xyz} {{1 {bad screen distance "xyz"}}}}
    {<Key> %x	    {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Button> %x    {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Motion> %x    {-x 2i} {[winfo pixels .b.f 2i]}}
    {<<Paste>> %x   {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Enter> %x	    {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Expose> %x    {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Configure> %x {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Gravity> %x   {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Reparent> %x  {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Map> %x	    {-x 2i} {{1 {bad option to <Map> event: "-x"}}}}

    {<Key> %y	    {-y xyz} {{1 {bad screen distance "xyz"}}}}
    {<Key> %y	    {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Button> %y    {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Motion> %y    {-y 2i} {[winfo pixels .b.f 2i]}}
    {<<Paste>> %y   {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Enter> %y	    {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Expose> %y    {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Configure> %y {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Gravity> %y   {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Reparent> %y  {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Map> %y	    {-y 2i} {{1 {bad option to <Map> event: "-y"}}}}

    {<Key> %k	    {-xyz 1} {{1 {bad option to <Key> event: "-xyz"}}}}
} {
    set event [lindex $check 0]
    test bind-22.$i "HandleEventGenerate: options $event [lindex $check 2]" {
	setup
	bind .b.f $event "lappend x [lindex $check 1]"
	set x {}
	if [catch {eval event gen .b.f $event [lindex $check 2]} msg] {







|
|



|

|



|



|



|

|


|



|




|



|



|

|


|





|

|

|



|





|







|







|















|

|



|





|








|




|



|







|











|











|

|







1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
    event gen .b.f <Button> -when tail -serial 102
    lappend x foo
    update
    set x
} {foo 99 100 101 102}
test bind-22.17 {HandleEventGenerate} {
    list [catch {event gen . <Button> -when xyz} msg] $msg
} {1 {bad -when value "xyz": must be now, head, mark, or tail}}
set i 18
foreach check {
    {<Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}}
    {<Configure> %a {-above .b} {[winfo id .b]}}
    {<Configure> %a {-above xyz} {{1 {bad window name/identifier "xyz"}}}}
    {<Configure> %a {-above [winfo id .b]} {[winfo id .b]}}
    {<Key> %b    {-above .} {{1 {<Key> event doesn't accept "-above" option}}}}

    {<Configure> %B {-borderwidth xyz} {{1 {bad screen distance "xyz"}}}}    
    {<Configure> %B {-borderwidth 2i} {[winfo pixels .b.f 2i]}}
    {<Key> %k	    {-borderwidth 2i} {{1 {<Key> event doesn't accept "-borderwidth" option}}}}

    {<Button> %b    {-button xyz} {{1 {expected integer but got "xyz"}}}}
    {<Button> %b    {-button 1} 1}
    {<Key> %k	    {-button 1} {{1 {<Key> event doesn't accept "-button" option}}}}

    {<Expose> %c    {-count xyz} {{1 {expected integer but got "xyz"}}}}
    {<Expose> %c    {-count 20} 20}
    {<Key> %b	    {-count 20} {{1 {<Key> event doesn't accept "-count" option}}}}

    {<Enter> %d	    {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, or NotifyDetailNone}}}}
    {<FocusIn> %d   {-detail NotifyVirtual} {{}}}
    {<Enter> %d	    {-detail NotifyVirtual} NotifyVirtual}
    {<Key> %k	    {-detail NotifyVirtual} {{1 {<Key> event doesn't accept "-detail" option}}}}

    {<Enter> %f	    {-focus xyz} {{1 {expected boolean value but got "xyz"}}}}
    {<Enter> %f	    {-focus 1} 1}
    {<Key> %k	    {-focus 1} {{1 {<Key> event doesn't accept "-focus" option}}}}

    {<Expose> %h    {-height xyz} {{1 {bad screen distance "xyz"}}}}
    {<Expose> %h    {-height 2i} {[winfo pixels .b.f 2i]}}
    {<Configure> %h {-height 2i} {[winfo pixels .b.f 2i]}}
    {<Key> %k	    {-height 2i} {{1 {<Key> event doesn't accept "-height" option}}}}

    {<Key> %k	    {-keycode xyz} {{1 {expected integer but got "xyz"}}}}
    {<Key> %k	    {-keycode 20} 20}
    {<Button> %b    {-keycode 20} {{1 {<Button> event doesn't accept "-keycode" option}}}}

    {<Key> %K	    {-keysym xyz} {{1 {unknown keysym "xyz"}}}}
    {<Key> %K	    {-keysym a} a}
    {<Button> %b    {-keysym a} {{1 {<Button> event doesn't accept "-keysym" option}}}}

    {<Enter> %m	    {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed}}}}
    {<Enter> %m	    {-mode NotifyNormal} NotifyNormal}
    {<FocusIn> %m   {-mode NotifyNormal} {{}}}
    {<Key> %k	    {-mode NotifyNormal} {{1 {<Key> event doesn't accept "-mode" option}}}}

    {<Map> %o	    {-override xyz} {{1 {expected boolean value but got "xyz"}}}}
    {<Map> %o	    {-override 1} 1}
    {<Reparent> %o  {-override 1} 1}
    {<Configure> %o {-override 1} 1}
    {<Key> %k	    {-override 1} {{1 {<Key> event doesn't accept "-override" option}}}}

    {<Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom}}}}
    {<Circulate> %p {-place PlaceOnTop} PlaceOnTop}
    {<Key> %k	    {-place PlaceOnTop} {{1 {<Key> event doesn't accept "-place" option}}}}

    {<Key> %R	    {-root .xyz} {{1 {bad window path name ".xyz"}}}}
    {<Key> %R	    {-root .b} {[winfo id .b]}}
    {<Key> %R	    {-root xyz} {{1 {bad window name/identifier "xyz"}}}}
    {<Key> %R	    {-root [winfo id .b]} {[winfo id .b]}}
    {<Button> %R    {-root .b} {[winfo id .b]}}
    {<Motion> %R    {-root .b} {[winfo id .b]}}
    {<<Paste>> %R   {-root .b} {[winfo id .b]}}
    {<Enter> %R	    {-root .b} {[winfo id .b]}}
    {<Configure> %R {-root .b} {{1 {<Configure> event doesn't accept "-root" option}}}}

    {<Key> %X	    {-rootx xyz} {{1 {bad screen distance "xyz"}}}}
    {<Key> %X	    {-rootx 2i} {[winfo pixels .b.f 2i]}}
    {<Button> %X    {-rootx 2i} {[winfo pixels .b.f 2i]}}
    {<Motion> %X    {-rootx 2i} {[winfo pixels .b.f 2i]}}
    {<<Paste>> %X   {-rootx 2i} {[winfo pixels .b.f 2i]}}
    {<Enter> %X	    {-rootx 2i} {[winfo pixels .b.f 2i]}}
    {<Configure> %X {-rootx 2i} {{1 {<Configure> event doesn't accept "-rootx" option}}}}

    {<Key> %Y	    {-rooty xyz} {{1 {bad screen distance "xyz"}}}}
    {<Key> %Y	    {-rooty 2i} {[winfo pixels .b.f 2i]}}
    {<Button> %Y    {-rooty 2i} {[winfo pixels .b.f 2i]}}
    {<Motion> %Y    {-rooty 2i} {[winfo pixels .b.f 2i]}}
    {<<Paste>> %Y   {-rooty 2i} {[winfo pixels .b.f 2i]}}
    {<Enter> %Y	    {-rooty 2i} {[winfo pixels .b.f 2i]}}
    {<Configure> %Y {-rooty 2i} {{1 {<Configure> event doesn't accept "-rooty" option}}}}

    {<Key> %E	    {-sendevent xyz} {{1 {expected boolean value but got "xyz"}}}}
    {<Key> %E	    {-sendevent 1} 1}
    {<Key> %E	    {-sendevent yes} 1}
    {<Key> %E	    {-sendevent 43} 43}

    {<Key> %#	    {-serial xyz} {{1 {expected integer but got "xyz"}}}}
    {<Key> %#	    {-serial 100} 100}

    {<Key> %s	    {-state xyz} {{1 {expected integer but got "xyz"}}}}
    {<Key> %s	    {-state 1} 1}
    {<Button> %s    {-state 1} 1}
    {<Motion> %s    {-state 1} 1}
    {<<Paste>> %s   {-state 1} 1}
    {<Enter> %s	    {-state 1} 1}
    {<Visibility> %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, or VisibilityFullyObscured}}}}
    {<Visibility> %s {-state VisibilityUnobscured} VisibilityUnobscured}
    {<Configure> %s {-state xyz} {{1 {<Configure> event doesn't accept "-state" option}}}}

    {<Key> %S	    {-subwindow .xyz} {{1 {bad window path name ".xyz"}}}}
    {<Key> %S	    {-subwindow .b} {[winfo id .b]}}
    {<Key> %S	    {-subwindow xyz} {{1 {bad window name/identifier "xyz"}}}}
    {<Key> %S	    {-subwindow [winfo id .b]} {[winfo id .b]}}
    {<Button> %S    {-subwindow .b} {[winfo id .b]}}
    {<Motion> %S    {-subwindow .b} {[winfo id .b]}}
    {<<Paste>> %S   {-subwindow .b} {[winfo id .b]}}
    {<Enter> %S	    {-subwindow .b} {[winfo id .b]}}
    {<Configure> %S {-subwindow .b} {{1 {<Configure> event doesn't accept "-subwindow" option}}}}

    {<Key> %t	    {-time xyz} {{1 {expected integer but got "xyz"}}}}
    {<Key> %t	    {-time 100} 100}
    {<Button> %t    {-time 100} 100}
    {<Motion> %t    {-time 100} 100}
    {<<Paste>> %t   {-time 100} 100}
    {<Enter> %t	    {-time 100} 100}
    {<Property> %t  {-time 100} 100}
    {<Configure> %t {-time 100} {{1 {<Configure> event doesn't accept "-time" option}}}}

    {<Expose> %w    {-width xyz} {{1 {bad screen distance "xyz"}}}}
    {<Expose> %w    {-width 2i} {[winfo pixels .b.f 2i]}}
    {<Configure> %w {-width 2i} {[winfo pixels .b.f 2i]}}
    {<Key> %k	    {-width 2i} {{1 {<Key> event doesn't accept "-width" option}}}}

    {<Unmap> %W    {-window .xyz} {{1 {bad window path name ".xyz"}}}}
    {<Unmap> %W    {-window .b.f} .b.f}
    {<Unmap> %W    {-window xyz} {{1 {bad window name/identifier "xyz"}}}}
    {<Unmap> %W    {-window [winfo id .b.f]} .b.f}
    {<Unmap> %W	    {-window .b.f} .b.f}
    {<Map> %W	    {-window .b.f} .b.f}
    {<Reparent> %W  {-window .b.f} .b.f}
    {<Configure> %W {-window .b.f} .b.f}
    {<Gravity> %W   {-window .b.f} .b.f}
    {<Circulate> %W {-window .b.f} .b.f}
    {<Key> %W	    {-window .b.f} {{1 {<Key> event doesn't accept "-window" option}}}}

    {<Key> %x	    {-x xyz} {{1 {bad screen distance "xyz"}}}}
    {<Key> %x	    {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Button> %x    {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Motion> %x    {-x 2i} {[winfo pixels .b.f 2i]}}
    {<<Paste>> %x   {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Enter> %x	    {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Expose> %x    {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Configure> %x {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Gravity> %x   {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Reparent> %x  {-x 2i} {[winfo pixels .b.f 2i]}}
    {<Map> %x	    {-x 2i} {{1 {<Map> event doesn't accept "-x" option}}}}

    {<Key> %y	    {-y xyz} {{1 {bad screen distance "xyz"}}}}
    {<Key> %y	    {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Button> %y    {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Motion> %y    {-y 2i} {[winfo pixels .b.f 2i]}}
    {<<Paste>> %y   {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Enter> %y	    {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Expose> %y    {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Configure> %y {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Gravity> %y   {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Reparent> %y  {-y 2i} {[winfo pixels .b.f 2i]}}
    {<Map> %y	    {-y 2i} {{1 {<Map> event doesn't accept "-y" option}}}}

    {<Key> %k	    {-xyz 1} {{1 {bad option "-xyz": must be -when, -above, -borderwidth, -button, -count, -delta, -detail, -focus, -height, -keycode, -keysym, -mode, -override, -place, -root, -rootx, -rooty, -sendevent, -serial, -state, -subwindow, -time, -width, -window, -x, or -y}}}}
} {
    set event [lindex $check 0]
    test bind-22.$i "HandleEventGenerate: options $event [lindex $check 2]" {
	setup
	bind .b.f $event "lappend x [lindex $check 1]"
	set x {}
	if [catch {eval event gen .b.f $event [lindex $check 2]} msg] {
2233
2234
2235
2236
2237
2238
2239
2240










2241
2242
2243
2244
2245
2246
2247
    bind .b.f <Button-2>
} {}
test bind-24.12 {FindSequence procedure: not new sequence, don't create} {
    setup
    bind .b.f <Control-Button-2> "foo"
    bind .b.f <Button-2>
} {}












test bind-25.1 {ParseEventDescription procedure} {
    list [catch {bind .b \x7 test} msg] $msg
} {1 {bad ASCII character 0x7}}
test bind-25.2 {ParseEventDescription procedure} {
    list [catch {bind .b "\x7f" test} msg] $msg
} {1 {bad ASCII character 0x7f}}







|
>
>
>
>
>
>
>
>
>
>







2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
    bind .b.f <Button-2>
} {}
test bind-24.12 {FindSequence procedure: not new sequence, don't create} {
    setup
    bind .b.f <Control-Button-2> "foo"
    bind .b.f <Button-2>
} {}
test bind-24.13 {FindSequence procedure: no binding} {
    catch {destroy .b.f}
    frame .b.f -class Test -width 150 -height 100
    list [catch {bind .b.f <a>} msg] $msg
} {0 {}}
test bind-24.14 {FindSequence procedure: no binding} {
    catch {destroy .b.f}
    canvas .b.f
    set i [.b.f create rect 10 10 100 100]
    list [catch {.b.f bind $i <a>} msg] $msg
} {0 {}}

test bind-25.1 {ParseEventDescription procedure} {
    list [catch {bind .b \x7 test} msg] $msg
} {1 {bad ASCII character 0x7}}
test bind-25.2 {ParseEventDescription procedure} {
    list [catch {bind .b "\x7f" test} msg] $msg
} {1 {bad ASCII character 0x7f}}
2522
2523
2524
2525
2526
2527
2528





















2529

2530

















    set x
} {Message2 {Message2
    while executing
"error Message2"
    (command bound to event)}}
rename bgerror {}
























destroy .b
























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

>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
    set x
} {Message2 {Message2
    while executing
"error Message2"
    (command bound to event)}}
rename bgerror {}

test bind-31.1 {MouseWheel events} {
    setup
    set x {}
    bind .b.f <MouseWheel> {set x Wheel}
    event gen .b.f <MouseWheel>
    set x
} {Wheel}
test bind-31.2 {MouseWheel events} {
    setup
    set x {}
    bind .b.f <MouseWheel> {set x %D}
    event gen .b.f <MouseWheel> -delta 120
    set x
} {120}
test bind-31.2 {MouseWheel events} {
    setup
    set x {}
    bind .b.f <MouseWheel> {set x "%D %x %y"}
    event gen .b.f <MouseWheel> -delta 240 -x 10 -y 30
    set x
} {240 10 30}


destroy .b

# cleanup
::tcltest::cleanupTests
return













Added tests/bitmap.test.









































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
# This file is a Tcl script to test out the procedures in the file
# tkBitmap.c.  It is organized in the standard white-box fashion for
# Tcl tests.
#
# Copyright (c) 1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: bitmap.test,v 1.1.2.6 1999/03/26 00:07:49 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[info commands testbitmap] != "testbitmap"} {
    puts "testbitmap command not available; skipping tests"
    ::tcltest::cleanupTests
    return
}

eval destroy [winfo children .]
wm geometry . {}
raise .

test bitmap-1.1 {Tk_AllocBitmapFromObj - converting internal reps} {
    set x gray25
    lindex $x 0
    destroy .b1
    button .b1 -bitmap $x
    lindex $x 0
    testbitmap gray25
} {{1 0}}
test bitmap-1.2 {Tk_AllocBitmapFromObj - discard stale bitmap} {
    set x gray25
    destroy .b1 .b2
    button .b1 -bitmap $x
    destroy .b1
    set result {}
    lappend result [testbitmap gray25]
    button .b2 -bitmap $x
    lappend result [testbitmap gray25]
} {{} {{1 1}}}
test bitmap-1.3 {Tk_AllocBitmapFromObj - reuse existing bitmap} {
    set x gray25
    destroy .b1 .b2
    button .b1 -bitmap $x
    set result {}
    lappend result [testbitmap gray25]
    button .b2 -bitmap $x
    pack .b1 .b2 -side top
    lappend result [testbitmap gray25]
} {{{1 1}} {{2 1}}}

test bitmap-2.1 {Tk_GetBitmap procedure} {
    destroy .b1
    list [catch {button .b1 -bitmap bad_name} msg] $msg
} {1 {bitmap "bad_name" not defined}}
test bitmap-2.2 {Tk_GetBitmap procedure} {
    destroy .b1
    list [catch {button .b1 -bitmap @xyzzy} msg] $msg
} {1 {error reading bitmap file "xyzzy"}}

test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} {
    set x questhead
    destroy .b1 .b2 .b3
    button .b1 -bitmap $x
    button .b3 -bitmap $x
    button .b2 -bitmap $x
    set result {}
    lappend result [testbitmap questhead]
    destroy .b1
    lappend result [testbitmap questhead]
    destroy .b2
    lappend result [testbitmap questhead]
    destroy .b3
    lappend result [testbitmap questhead]
} {{{3 1}} {{2 1}} {{1 1}} {}}

test bitmap-4.1 {FreeBitmapObjProc} {
    destroy .b
    set x [format questhead]
    button .b -bitmap $x
    set y [format questhead]
    .b configure -bitmap $y
    set z [format questhead]
    .b configure -bitmap $z
    set result {}
    lappend result [testbitmap questhead]
    set x red
    lappend result [testbitmap questhead]
    set z 32
    lappend result [testbitmap questhead]
    destroy .b
    lappend result [testbitmap questhead]
    set y bogus
    set result
} {{{1 3}} {{1 2}} {{1 1}} {}}

destroy .t

# cleanup
::tcltest::cleanupTests
return













Added tests/border.test.







































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
# This file is a Tcl script to test out the procedures in the file
# tkBorder.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: border.test,v 1.1.2.6 1999/03/26 00:07:49 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[info commands testborder] != "testborder"} {
    puts "testborder command not available; skipping tests"
    ::tcltest::cleanupTests
    return
}

eval destroy [winfo children .]
wm geometry . {}
raise .

# Create a top-level with its own colormap (so we can test under
# controlled conditions), then check to make sure that the visual
# is color-mapped with 256 borders.  If not, just skip this whole
# test file.

if [catch {toplevel .t -visual {pseudocolor 8} -colormap new}] {
    ::tcltest::cleanupTests
    return
}
wm geom .t +0+0
if {[winfo depth .t] != 8} {
    destroy .t
    ::tcltest::cleanupTests
    return
}

test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} {
    set x orange
    lindex $x 0
    destroy .b1
    button .b1 -bg $x -text .b1
    lindex $x 0
    testborder orange
} {{1 0}}
test border-1.3 {Tk_AllocBorderFromObj - discard stale border} {
    set x orange
    destroy .b1 .b2
    button .b1 -bg $x -text First
    destroy .b1
    set result {}
    lappend result [testborder orange]
    button .b2 -bg $x -text Second
    lappend result [testborder orange]
} {{} {{1 1}}}
test border-1.2 {Tk_AllocBorderFromObj - reuse existing border} {
    set x orange
    destroy .b1 .b2
    button .b1 -bg $x -text First
    set result {}
    lappend result [testborder orange]
    button .b2 -bg $x -text Second
    pack .b1 .b2 -side top
    lappend result [testborder orange]
} {{{1 1}} {{2 1}}}
test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} {
    set x purple
    destroy .b1 .b2 .t.b
    button .b1 -bg $x -text First
    pack .b1 -side top
    set result {}
    lappend result [testborder purple]
    button .t.b -bg $x -text Second
    pack .t.b -side top
    lappend result [testborder purple]
    button .b2 -bg $x -text Third
    pack .b2 -side top
    lappend result [testborder purple]
} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}}

test border-3.1 {Tk_Free3DBorder - reference counts} {
    set x purple
    destroy .b1 .b2 .t.b
    button .b1 -bg $x -text First
    pack .b1 -side top
    button .t.b -bg $x -text Second
    pack .t.b -side top
    button .b2 -bg $x -text Third
    pack .b2 -side top
    set result {}
    lappend result [testborder purple]
    destroy .b1
    lappend result [testborder purple]
    destroy .b2
    lappend result [testborder purple]
    destroy .t.b
    lappend result [testborder purple]
} {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}}
test border-3.4 {Tk_Free3DBorder - unlinking from list} {
    destroy .b .t.b .t2 .t3
    toplevel .t2 -visual {pseudocolor 8} -colormap new
    toplevel .t3 -visual {pseudocolor 8} -colormap new
    set x purple
    button .b -bg $x -text .b1
    button .t.b1 -bg $x -text .t.b1
    button .t.b2 -bg $x -text .t.b2
    button .t2.b1 -bg $x -text .t2.b1
    button .t2.b2 -bg $x -text .t2.b2
    button .t2.b3 -bg $x -text .t2.b3
    button .t3.b1 -bg $x -text .t3.b1
    button .t3.b2 -bg $x -text .t3.b2
    button .t3.b3 -bg $x -text .t3.b3
    button .t3.b4 -bg $x -text .t3.b4
    set result {}
    lappend result [testborder purple]
    destroy .t2
    lappend result [testborder purple]
    destroy .b
    lappend result [testborder purple]
    destroy .t3
    lappend result [testborder purple]
    destroy .t
    lappend result [testborder purple]
} {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}

test border-4.1 {FreeBorderObjProc} {
    destroy .b
    set x [format purple]
    button .b -bg $x -text .b1
    set y [format purple]
    .b configure -bg $y
    set z [format purple]
    .b configure -bg $z
    set result {}
    lappend result [testborder purple]
    set x red
    lappend result [testborder purple]
    set z 32
    lappend result [testborder purple]
    destroy .b
    lappend result [testborder purple]
    set y bogus
    set result
} {{{1 3}} {{1 2}} {{1 1}} {}}

catch {destroy .b}
button .b
test get-2.1 {Tk_GetReliefFromObj} {
    .b configure -relief flat
    .b cget -relief
} {flat}
test get-2.2 {Tk_GetReliefFromObj} {
    .b configure -relief groove
    .b cget -relief
} {groove}
test get-2.3 {Tk_GetReliefFromObj} {
    .b configure -relief raised
    .b cget -relief
} {raised}
test get-2.3 {Tk_GetReliefFromObj} {
    .b configure -relief ridge
    .b cget -relief
} {ridge}
test get-2.3 {Tk_GetReliefFromObj} {
    .b configure -relief solid
    .b cget -relief
} {solid}
test get-2.3 {Tk_GetReliefFromObj} {
    .b configure -relief sunken
    .b cget -relief
} {sunken}
test get-2.4 {Tk_GetReliefFromObj - error} {
    list [catch {.b configure -relief upanddown} msg] $msg
} {1 {bad relief "upanddown": must be flat, groove, raised, ridge, solid, or sunken}}

destroy .t

# cleanup
::tcltest::cleanupTests
return













Changes to tests/bugs.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













# This file is a Tcl script to test out various known bugs that will
# cause Tk to crash.  This file ends with .tcl instead of .test to make
# sure it isn't run when you type "source all".  We currently are not 
# shipping this file with the rest of the source release.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) bugs.tcl 1.1 96/07/25 15:49:45

if {[info procs test] != "test"} {
    source defs
}

test crash-1.0 {imgPhoto} {
    image create photo p1
    image create photo p2
    catch {image create photo p2 -file bogus}
    p1 copy p2
    label .l -image p1
    destroy .l
    set foo ""
} {}

test crash-1.1 {color} {
    . configure -bg rgb:345
    set foo ""
} {}























|



















>
>
>
>
>
>
>
>
>
>
>
>
>
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
# This file is a Tcl script to test out various known bugs that will
# cause Tk to crash.  This file ends with .tcl instead of .test to make
# sure it isn't run when you type "source all".  We currently are not 
# shipping this file with the rest of the source release.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: bugs.tcl,v 1.1.4.3 1999/03/24 02:54:25 hershey Exp $

if {[info procs test] != "test"} {
    source defs
}

test crash-1.0 {imgPhoto} {
    image create photo p1
    image create photo p2
    catch {image create photo p2 -file bogus}
    p1 copy p2
    label .l -image p1
    destroy .l
    set foo ""
} {}

test crash-1.1 {color} {
    . configure -bg rgb:345
    set foo ""
} {}













Changes to tests/butGeom.tcl.

1
2
3
4
5
6
7
8
9
10
11
# This file creates a visual test for button layout.  It is part of
# the Tk visual test suite, which is invoked via the "visual" script.
#
# SCCS: @(#) butGeom.tcl 1.3 97/06/13 13:46:57

catch {destroy .t}
toplevel .t
wm title .t "Visual Tests for Button Geometry"
wm iconname .t "Button Geometry"
wm geom .t +0+0
wm minsize .t 1 1



|







1
2
3
4
5
6
7
8
9
10
11
# This file creates a visual test for button layout.  It is part of
# the Tk visual test suite, which is invoked via the "visual" script.
#
# RCS: @(#) $Id: butGeom.tcl,v 1.1.4.3 1999/03/24 02:54:25 hershey Exp $

catch {destroy .t}
toplevel .t
wm title .t "Visual Tests for Button Geometry"
wm iconname .t "Button Geometry"
wm geom .t +0+0
wm minsize .t 1 1
109
110
111
112
113
114
115














proc config {option value} {
    foreach w {.t.l1 .t.l2 .t.l3 .t.b1 .t.b2 .t.b3 .t.c1 .t.c2 .t.c3
	    .t.r1 .t.r2 .t.r3} {
	$w configure $option $value
    }
}




















>
>
>
>
>
>
>
>
>
>
>
>
>
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128

proc config {option value} {
    foreach w {.t.l1 .t.l2 .t.l3 .t.b1 .t.b2 .t.b3 .t.c1 .t.c2 .t.c3
	    .t.r1 .t.r2 .t.r3} {
	$w configure $option $value
    }
}













Changes to tests/butGeom2.tcl.

1
2
3
4
5
6
7
8
9
10
11
# This file creates a visual test for button layout.  It is part of
# the Tk visual test suite, which is invoked via the "visual" script.
#
# SCCS: @(#) butGeom2.tcl 1.3 97/06/13 17:00:32

catch {destroy .t}
toplevel .t
wm title .t "Visual Tests for Button Geometry"
wm iconname .t "Button Geometry"
wm geom .t +0+0
wm minsize .t 1 1



|







1
2
3
4
5
6
7
8
9
10
11
# This file creates a visual test for button layout.  It is part of
# the Tk visual test suite, which is invoked via the "visual" script.
#
# RCS: @(#) $Id: butGeom2.tcl,v 1.1.4.3 1999/03/24 02:54:26 hershey Exp $

catch {destroy .t}
toplevel .t
wm title .t "Visual Tests for Button Geometry"
wm iconname .t "Button Geometry"
wm geom .t +0+0
wm minsize .t 1 1
107
108
109
110
111
112
113













}

proc config-but {option value} {
    foreach w {.t.b1 .t.b2 .t.b3} {
	$w configure $option $value
    }
}




















>
>
>
>
>
>
>
>
>
>
>
>
>
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
}

proc config-but {option value} {
    foreach w {.t.b1 .t.b2 .t.b3} {
	$w configure $option $value
    }
}













Changes to tests/button.test.

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
# This file is a Tcl script to test labels, buttons, checkbuttons, and
# radiobuttons in Tk (i.e., all the widgets defined in tkButton.c).  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) button.test 1.39 97/07/31 10:19:02




if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\""
    puts "image, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"

    return
}

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

proc bogusTrace args {






>
>

<
<
>
|
<
>
>
>





>



<
<
<
<







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
# This file is a Tcl script to test labels, buttons, checkbuttons, and
# radiobuttons in Tk (i.e., all the widgets defined in tkButton.c).  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: button.test,v 1.1.4.6 1999/03/26 00:07:50 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\""
    puts "image, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    ::tcltest::cleanupTests
    return
}





foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

proc bogusTrace args {
47
48
49
50
51
52
53
54
55
56
57
58
59

60
61

62

63
64
65



66

67
68
69
70
71

72
73
74




75

76
77
78
79
80
81
82
83
84
85
86
87
88

89
90
91
92



93
94
95
96
97
98
99
100
101
102
103






104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220








221
222
223






224
225
226
227
228
229
230
231



232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
checkbutton .c -text Checkbutton
radiobutton .r -text Radiobutton
pack .l .b .c .r
update
set i 1
foreach test {
    {-activebackground #012345 #012345 non-existent
	    {unknown color name "non-existent"}}
    {-activeforeground #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-anchor nw nw bogus {bad anchor position "bogus": must be n, ne, e, se, s, sw, w, nw, or center}}
    {-background #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}

    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
    {-bd 4 4 badValue {bad screen distance "badValue"}}

    {-bitmap questhead questhead badValue {bitmap "badValue" not defined}}

    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
    {-command "set x" {set x} {} {}}
    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}



    {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}

    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
    {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}}
    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
    {-height 18 18 20.0 {expected integer but got "20.0"}}
    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}

    {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}}
    {-highlightthickness 18 18 badValue {bad screen distance "badValue"}}
    {-image image1 image1 bogus {image "bogus" doesn't exist}}




    {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}}

    {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
    {-offvalue lousy lousy {} {}}
    {-offvalue fantastic fantastic {} {}}
    {-padx 12 12 420x {bad screen distance "420x"}}
    {-pady 12 12 420x {bad screen distance "420x"}}
    {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
    {-selectcolor #110022 #110022 bogus {unknown color name "bogus"}}
    {-selectimage image1 image1 bogus {image "bogus" doesn't exist}}
    {-state normal normal bogus {bad state value "bogus": must be normal, active, or disabled}}
    {-takefocus "any string" "any string" {} {}}
    {-text "Sample text" {Sample text} {} {}}
    {-textvariable i i {} {}}
    {-underline 5 5 3p {expected integer but got "3p"}}

    {-width 402 402 3p {expected integer but got "3p"}}
    {-wraplength 100 100 6x {bad screen distance "6x"}}
} {
    set name [lindex $test 0]



    test button-1.$i {configuration options} {
	.c configure $name [lindex $test 1]
	lindex [.c configure $name] 4
    } [lindex $test 2]
    incr i
    if {[lindex $test 3] != ""} {
	test button-1.$i {configuration options} {
	    list [catch {.c configure $name [lindex $test 3]} msg] $msg
	} [list 1 [lindex $test 4]]
    }
    .c configure $name [lindex [.c configure $name] 3]






    incr i
}
test button-1.$i {configuration options} {
    .c configure -selectcolor {}
} {}
incr i
# the following tests only work on buttons, not checkbuttons
test button-1.$i {configuration options} {
    .b configure -default active
    lindex [.b configure -default] 4
} active
incr i
test button-1.$i {configuration options} {
    .b configure -default normal
    lindex [.b configure -default] 4
} normal
incr i
test button-1.$i {configuration options} {
    .b configure -default disabled
    lindex [.b configure -default] 4
} disabled
incr i
test button-1.$i {configuration options} {
    .b configure -default active
    lindex [.b configure -default] 3
} disabled
incr i
test button-1.$i {configuration options} {
    list [catch {.b configure -default no_way} msg] $msg
} {1 {bad -default value "no_way": must be normal, active, or disabled}}

set i 1
foreach check {
    {-activebackground 1 0 0 0}
    {-activeforeground 1 0 0 0}
    {-anchor 0 0 0 0}
    {-background 0 0 0 0}
    {-bd 0 0 0 0}
    {-bg 0 0 0 0}
    {-bitmap 0 0 0 0}
    {-borderwidth 0 0 0 0}
    {-command 1 0 0 0}
    {-cursor 0 0 0 0}
    {-default 1 0 1 1}
    {-disabledforeground 1 0 0 0}
    {-fg 0 0 0 0}
    {-font 0 0 0 0}
    {-foreground 0 0 0 0}
    {-height 0 0 0 0}
    {-image 0 0 0 0}
    {-indicatoron 1 1 0 0}
    {-offvalue 1 1 0 1}
    {-onvalue 1 1 0 1}
    {-padx 0 0 0 0}
    {-pady 0 0 0 0}
    {-relief 0 0 0 0}
    {-selectcolor 1 1 0 0}
    {-selectimage 1 1 0 0}
    {-state 1 0 0 0}
    {-text 0 0 0 0}
    {-textvariable 0 0 0 0}
    {-value 1 1 1 0}
    {-variable 1 1 0 0}
    {-width 0 0 0 0}
} {
    test button-2.$i {label-specific options} "
	catch {.l configure [lindex $check 0]}
    " [lindex $check 1]
    incr i
    test button-2.$i {button-specific options} "
	catch {.b configure [lindex $check 0]}
    " [lindex $check 2]
    incr i
    test button-2.$i {checkbutton-specific options} "
	catch {.c configure [lindex $check 0]}
    " [lindex $check 3]
    incr i
    test button-2.$i {radiobutton-specific options} "
	catch {.r configure [lindex $check 0]}
    " [lindex $check 4]
    incr i
}

test button-3.1 {ButtonCreate procedure} {
    list [catch {button} msg] $msg
} {1 {wrong # args: should be "button pathName ?options?"}}
test button-3.2 {ButtonCreate procedure} {
    catch {destroy .x}
    label .x
    winfo class .x
} {Label}
test button-3.3 {ButtonCreate procedure} {
    catch {destroy .x}
    button .x
    winfo class .x
} {Button}
test button-3.4 {ButtonCreate procedure} {
    catch {destroy .x}
    checkbutton .x
    winfo class .x
} {Checkbutton}
test button-3.5 {ButtonCreate procedure} {
    catch {destroy .x}
    radiobutton .x
    winfo class .x
} {Radiobutton}
rename button gorp
test button-3.6 {ButtonCreate procedure} {
    catch {destroy .x}
    gorp .x
    winfo class .x
} {Button}
rename gorp button
test button-3.7 {ButtonCreate procedure} {
    list [catch {button foo} msg] $msg
} {1 {bad window path name "foo"}}
test button-3.8 {ButtonCreate procedure} {








    catch {destroy .x}
    list [catch {button .x -gorp foo} msg] $msg [winfo exists .x]
} {1 {unknown option "-gorp"} 0}







test button-4.1 {ButtonWidgetCmd procedure} {
    list [catch {.b} msg] $msg
} {1 {wrong # args: should be ".b option ?arg arg ...?"}}
test button-4.2 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.b c} msg] $msg
} {1 {bad option "c": must be cget, configure, flash, or invoke}}
test button-4.3 {ButtonWidgetCmd procedure, "cget" option} {



    list [catch {.b cget a b} msg] $msg
} {1 {wrong # args: should be ".b cget option"}}
test button-4.4 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.b cget -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
test button-4.5 {ButtonWidgetCmd procedure, "cget" option} {
    .b configure -highlightthickness 3
    .b cget -highlightthickness
} {3}
test button-4.6 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.l cget -disabledforeground} msg] $msg
} {1 {unknown option "-disabledforeground"}}
test button-4.7 {ButtonWidgetCmd procedure, "cget" option} {
    catch {.b cget -disabledforeground}
} {0}
test button-4.8 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.b cget -variable} msg] $msg
} {1 {unknown option "-variable"}}
test button-4.9 {ButtonWidgetCmd procedure, "cget" option} {
    catch {.c cget -variable}
} {0}
test button-4.10 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.c cget -value} msg] $msg
} {1 {unknown option "-value"}}
test button-4.11 {ButtonWidgetCmd procedure, "cget" option} {
    catch {.r cget -value}
} {0}
test button-4.12 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.r cget -onvalue} msg] $msg
} {1 {unknown option "-onvalue"}}
test button-4.13 {ButtonWidgetCmd procedure, "configure" option} {
    llength [.c configure]
} {36}
test button-4.14 {ButtonWidgetCmd procedure, "configure" option} {
    list [catch {.b configure -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
test button-4.15 {ButtonWidgetCmd procedure, "configure" option} {
    list [catch {.b co -bg #ffffff -fg} msg] $msg
} {1 {value for "-fg" missing}}
test button-4.16 {ButtonWidgetCmd procedure, "configure" option} {
    .b configure -fg #123456
    .b configure -bg #654321
    lindex [.b configure -fg] 4
} {#123456}
.c configure -variable value -onvalue 1 -offvalue 0
.r configure -variable value2 -value red
test button-4.17 {ButtonWidgetCmd procedure, "deselect" option} {
    list [catch {.c deselect foo} msg] $msg
} {1 {wrong # args: should be ".c deselect"}}
test button-4.18 {ButtonWidgetCmd procedure, "deselect" option} {
    list [catch {.l deselect} msg] $msg
} {1 {bad option "deselect": must be cget or configure}}
test button-4.19 {ButtonWidgetCmd procedure, "deselect" option} {
    list [catch {.b deselect} msg] $msg
} {1 {bad option "deselect": must be cget, configure, flash, or invoke}}
test button-4.20 {ButtonWidgetCmd procedure, "deselect" option} {
    set value 1
    .c d
    set value
} {0}
test button-4.21 {ButtonWidgetCmd procedure, "deselect" option} {
    set value2 green
    .r deselect
    set value2
} {green}
test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} {
    set value2 red
    .r deselect
    set value2
} {}
test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} {
    set value 1
    trace variable value w bogusTrace
    set result [list [catch {.c deselect} msg] $msg $errorInfo $value]
    trace vdelete value w bogusTrace
    set result
} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
    while executing
".c deselect"} 0}
test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} {
    set value2 red
    trace variable value2 w bogusTrace
    set result [list [catch {.r deselect} msg] $msg $errorInfo $value2]
    trace vdelete value2 w bogusTrace
    set result
} {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
    while executing
".r deselect"} {}}
test button-4.25 {ButtonWidgetCmd procedure, "flash" option} {
    list [catch {.b flash foo} msg] $msg
} {1 {wrong # args: should be ".b flash"}}
test button-4.26 {ButtonWidgetCmd procedure, "flash" option} {
    list [catch {.l flash} msg] $msg
} {1 {bad option "flash": must be cget or configure}}
test button-4.27 {ButtonWidgetCmd procedure, "flash" option} {
    list [catch {.b flash} msg] $msg
} {0 {}}
test button-4.28 {ButtonWidgetCmd procedure, "flash" option} {
    list [catch {.c flash} msg] $msg
} {0 {}}
test button-4.29 {ButtonWidgetCmd procedure, "flash" option} {
    list [catch {.r f} msg] $msg
} {0 {}}
test button-4.30 {ButtonWidgetCmd procedure, "invoke" option} {
    list [catch {.b invoke foo} msg] $msg
} {1 {wrong # args: should be ".b invoke"}}
test button-4.31 {ButtonWidgetCmd procedure, "invoke" option} {
    list [catch {.l invoke} msg] $msg
} {1 {bad option "invoke": must be cget or configure}}
test button-4.32 {ButtonWidgetCmd procedure, "invoke" option} {
    .b configure -command {set x invoked}
    set x "not invoked"
    .b invoke
    set x
} {invoked}
test button-4.33 {ButtonWidgetCmd procedure, "invoke" option} {
    .b configure -command {set x invoked} -state disabled
    set x "not invoked"
    .b invoke
    set x
} {not invoked}
test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} {
    set value bogus
    .c configure -command {set x invoked} -variable value -onvalue 1 \
	    -offvalue 0
    set x "not invoked"
    .c invoke
    list $x $value
} {invoked 1}
test button-4.35 {ButtonWidgetCmd procedure, "invoke" option} {
    set value2 green
    .r configure -command {set x invoked} -variable value2 -value red
    set x "not invoked"
    .r i
    list $x $value2
} {invoked red}
test button-4.36 {ButtonWidgetCmd procedure, "select" option} {
    list [catch {.l select} msg] $msg
} {1 {bad option "select": must be cget or configure}}
test button-4.37 {ButtonWidgetCmd procedure, "select" option} {
    list [catch {.b select} msg] $msg
} {1 {bad option "select": must be cget, configure, flash, or invoke}}
test button-4.38 {ButtonWidgetCmd procedure, "select" option} {
    list [catch {.c select foo} msg] $msg
} {1 {wrong # args: should be ".c select"}}
test button-4.39 {ButtonWidgetCmd procedure, "select" option} {
    set value bogus
    .c configure -command {} -variable value -onvalue lovely -offvalue 0
    .c s
    set value
} {lovely}
test button-4.40 {ButtonWidgetCmd procedure, "select" option} {
    set value2 green
    .r configure -command {} -variable value2 -value red
    .r select
    set value2
} {red}
test button-4.41 {ButtonWidgetCmd procedure, "select" option} {
    set value2 yellow
    trace variable value2 w bogusTrace
    set result [list [catch {.r select} msg] $msg $errorInfo $value2]
    trace vdelete value2 w bogusTrace
    set result
} {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
    while executing
".r select"} red}
test button-4.42 {ButtonWidgetCmd procedure, "toggle" option} {
    list [catch {.l toggle} msg] $msg
} {1 {bad option "toggle": must be cget or configure}}
test button-4.43 {ButtonWidgetCmd procedure, "toggle" option} {
    list [catch {.b toggle} msg] $msg
} {1 {bad option "toggle": must be cget, configure, flash, or invoke}}
test button-4.44 {ButtonWidgetCmd procedure, "toggle" option} {
    list [catch {.r toggle} msg] $msg
} {1 {bad option "toggle": must be cget, configure, deselect, flash, invoke, or select}}
test button-4.45 {ButtonWidgetCmd procedure, "toggle" option} {
    list [catch {.c toggle foo} msg] $msg
} {1 {wrong # args: should be ".c toggle"}}
test button-4.46 {ButtonWidgetCmd procedure, "toggle" option} {
    set value bogus
    .c configure -command {} -variable value -onvalue sunshine -offvalue rain
    .c toggle
    set result $value
    .c toggle
    lappend result $value
    .c toggle
    lappend result $value
} {sunshine rain sunshine}
test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} {
    .c configure -onvalue xyz -offvalue abc
    set value xyz
    trace variable value w bogusTrace
    set result [list [catch {.c toggle} msg] $msg $errorInfo $value]
    trace vdelete value w bogusTrace
    set result
} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
    while executing
".c toggle"} abc}
test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} {
    .c configure -onvalue xyz -offvalue abc
    set value abc
    trace variable value w bogusTrace
    set result [list [catch {.c toggle} msg] $msg $errorInfo $value]
    trace vdelete value w bogusTrace
    set result
} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
    while executing
".c toggle"} xyz}
test button-4.49 {ButtonWidgetCmd procedure} {
    list [catch {.c bad_option} msg] $msg
} {1 {bad option "bad_option": must be cget, configure, deselect, flash, invoke, select, or toggle}}
test button-4.50 {ButtonWidgetCmd procedure, "toggle" option} {
    catch {unset value}; set value(1) 1;
    set result [list [catch {.c toggle} msg] $msg $errorInfo]
    unset value;
    set result
} {1 {can't set "value": variable is array} {can't set "value": variable is array
    while executing







|

|
|

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


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






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

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

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


|




|




|




|





|





|


|
>
>
>
>
>
>
>
>



>
>
>
>
>
>

|


|

|
|
>
>
>


|


|



|


|


|


|


|


|


|


|


|


|


|






|


|


|


|




|




|




|








|








|


|


|


|


|


|


|


|





|





|







|






|


|


|


|





|





|








|


|


|


|


|









|









|









<
<
<







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79


80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
























130



























131





132



















133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401



402
403
404
405
406
407
408
checkbutton .c -text Checkbutton
radiobutton .r -text Radiobutton
pack .l .b .c .r
update
set i 1
foreach test {
    {-activebackground #012345 #012345 non-existent
	    {unknown color name "non-existent"} {0 1 1 1}}
    {-activeforeground #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"} {0 1 1 1}}
    {-anchor nw nw bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} {1 1 1 1}}
    {-background #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"} {1 1 1 1}}
    {-bd 4 4 badValue {bad screen distance "badValue"} {1 1 1 1}}
    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}

	    {1 1 1 1}}
    {-bitmap questhead questhead badValue {bitmap "badValue" not defined}
	    {1 1 1 1}}
    {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"} {1 1 1 1}}
    {-command "set x" {set x} {} {} {0 1 1 1}}
    {-cursor arrow arrow badValue {bad cursor spec "badValue"} {1 1 1 1}}
    {-default active active huh?
	    {bad default "huh?": must be active, disabled, or normal}
	    {0 1 0 0}}
    {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}
	    {0 1 1 1}}
    {-fg #110022 #110022 bogus {unknown color name "bogus"} {1 1 1 1}}
    {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist} {1 1 1 1}}
    {-foreground #110022 #110022 bogus {unknown color name "bogus"} {1 1 1 1}}
    {-height 18 18 20.0 {expected integer but got "20.0"} {1 1 1 1}}
    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}
	    {1 1 1 1}}
    {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}


	    {1 1 1 1}}
    {-highlightthickness 6m 6m badValue {bad screen distance "badValue"}
	    {1 1 1 1}}
    {-image image1 image1 bogus {image "bogus" doesn't exist} {1 1 1 1}}
    {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}
	    {0 0 1 1}}
    {-justify right right bogus {bad justification "bogus": must be left, right, or center} {1 1 1 1}}
    {-offvalue lousy lousy {} {} {0 0 1 0}}
    {-offvalue fantastic fantastic {} {} {0 0 1 0}}
    {-padx 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
    {-pady 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
    {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {1 1 1 1}}
    {-selectcolor #110022 #110022 bogus {unknown color name "bogus"} {0 0 1 1}}
    {-selectimage image1 image1 bogus {image "bogus" doesn't exist} {0 0 1 1}}
    {-state normal normal bogus {bad state "bogus": must be active, disabled, or normal} {0 1 1 1}}
    {-takefocus "any string" "any string" {} {} {1 1 1 1}}
    {-text "Sample text" {Sample text} {} {} {1 1 1 1}}
    {-textvariable i i {} {} {1 1 1 1}}
    {-underline 5 5 3p {expected integer but got "3p"} {1 1 1 1}}
    {-value anyString anyString {} {} {0 0 0 1}}
    {-width 402 402 3p {expected integer but got "3p"} {1 1 1 1}}
    {-wraplength 100 100 6x {bad screen distance "6x"} {1 1 1 1}}
} {
    set name [lindex $test 0]
    set classes [lindex $test 5]
    foreach w {.l .b .c .r} hasOption [lindex $test 5] {
	if $hasOption {
	    test button-1.$i {configuration options} {
		$w configure $name [lindex $test 1]
		lindex [$w configure $name] 4
	    } [lindex $test 2]
	    incr i
	    if {[lindex $test 3] != ""} {
		test button-1.$i {configuration options} {
		    list [catch {$w configure $name [lindex $test 3]} msg] $msg
		} [list 1 [lindex $test 4]]
	    }
	    $w configure $name [lindex [$w configure $name] 3]
	} else {
	    test button-1.$i {configuration options} {
		list [catch {$w configure $name [lindex $test 1]} msg] $msg
	    } "1 {unknown option \"$name\"}"
	}
    }
    incr i
}
test button-1.$i {configuration options} {
    .c configure -selectcolor {}
} {}
incr i




















































test button-3.1 {ButtonCreate - not enough cd ../unix





} {



















    list [catch {button} msg] $msg
} {1 {wrong # args: should be "button pathName ?options?"}}
test button-3.2 {ButtonCreate procedure - setting label class} {
    catch {destroy .x}
    label .x
    winfo class .x
} {Label}
test button-3.3 {ButtonCreate - setting button class} {
    catch {destroy .x}
    button .x
    winfo class .x
} {Button}
test button-3.4 {ButtonCreate - setting checkbutton class} {
    catch {destroy .x}
    checkbutton .x
    winfo class .x
} {Checkbutton}
test button-3.5 {ButtonCreate - setting radiobutton class} {
    catch {destroy .x}
    radiobutton .x
    winfo class .x
} {Radiobutton}
rename button gorp
test button-3.6 {ButtonCreate - setting class} {
    catch {destroy .x}
    gorp .x
    winfo class .x
} {Button}
rename gorp button
test button-3.7 {ButtonCreate - bad window name} {
    list [catch {button foo} msg] $msg
} {1 {bad window path name "foo"}}
test button-3.8 {ButtonCreate procedure - error in default option value} {
    catch {destroy .funny}
    option add *funny.background bogus
    list [catch {button .funny} msg] $msg $errorInfo
} {1 {unknown color name "bogus"} {unknown color name "bogus"
    (database entry for "-background" in widget ".funny")
    invoked from within
"button .funny"}}
test button-3.9 {ButtonCreate procedure - option error} {
    catch {destroy .x}
    list [catch {button .x -gorp foo} msg] $msg [winfo exists .x]
} {1 {unknown option "-gorp"} 0}
test button-3.10 {ButtonCreate procedure - return value} {
    catch {destroy .abcd}
    set x [button .abcd]
    destroy .abc
    set x
} {.abcd}

test button-4.1 {ButtonWidgetCmd - too few arguments} {
    list [catch {.b} msg] $msg
} {1 {wrong # args: should be ".b option ?arg arg ...?"}}
test button-4.2 {ButtonWidgetCmd - bad option name} {
    list [catch {.b c} msg] $msg
} {1 {ambiguous option "c": must be cget, configure, flash, or invoke}}
test button-4.3 {ButtonWidgetCmd - bad option name} {
    list [catch {.b bogus} msg] $msg
} {1 {bad option "bogus": must be cget, configure, flash, or invoke}}
test button-4.4 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.b cget a b} msg] $msg
} {1 {wrong # args: should be ".b cget option"}}
test button-4.5 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.b cget -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
test button-4.6 {ButtonWidgetCmd procedure, "cget" option} {
    .b configure -highlightthickness 3
    .b cget -highlightthickness
} {3}
test button-4.7 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.l cget -disabledforeground} msg] $msg
} {1 {unknown option "-disabledforeground"}}
test button-4.8 {ButtonWidgetCmd procedure, "cget" option} {
    catch {.b cget -disabledforeground}
} {0}
test button-4.9 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.b cget -variable} msg] $msg
} {1 {unknown option "-variable"}}
test button-4.10 {ButtonWidgetCmd procedure, "cget" option} {
    catch {.c cget -variable}
} {0}
test button-4.11 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.c cget -value} msg] $msg
} {1 {unknown option "-value"}}
test button-4.12 {ButtonWidgetCmd procedure, "cget" option} {
    catch {.r cget -value}
} {0}
test button-4.13 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.r cget -onvalue} msg] $msg
} {1 {unknown option "-onvalue"}}
test button-4.14 {ButtonWidgetCmd procedure, "configure" option} {
    llength [.c configure]
} {36}
test button-4.15 {ButtonWidgetCmd procedure, "configure" option} {
    list [catch {.b configure -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
test button-4.16 {ButtonWidgetCmd procedure, "configure" option} {
    list [catch {.b co -bg #ffffff -fg} msg] $msg
} {1 {value for "-fg" missing}}
test button-4.17 {ButtonWidgetCmd procedure, "configure" option} {
    .b configure -fg #123456
    .b configure -bg #654321
    lindex [.b configure -fg] 4
} {#123456}
.c configure -variable value -onvalue 1 -offvalue 0
.r configure -variable value2 -value red
test button-4.18 {ButtonWidgetCmd procedure, "deselect" option} {
    list [catch {.c deselect foo} msg] $msg
} {1 {wrong # args: should be ".c deselect"}}
test button-4.19 {ButtonWidgetCmd procedure, "deselect" option} {
    list [catch {.l deselect} msg] $msg
} {1 {bad option "deselect": must be cget or configure}}
test button-4.20 {ButtonWidgetCmd procedure, "deselect" option} {
    list [catch {.b deselect} msg] $msg
} {1 {bad option "deselect": must be cget, configure, flash, or invoke}}
test button-4.21 {ButtonWidgetCmd procedure, "deselect" option} {
    set value 1
    .c d
    set value
} {0}
test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} {
    set value2 green
    .r deselect
    set value2
} {green}
test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} {
    set value2 red
    .r deselect
    set value2
} {}
test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} {
    set value 1
    trace variable value w bogusTrace
    set result [list [catch {.c deselect} msg] $msg $errorInfo $value]
    trace vdelete value w bogusTrace
    set result
} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
    while executing
".c deselect"} 0}
test button-4.25 {ButtonWidgetCmd procedure, "deselect" option} {
    set value2 red
    trace variable value2 w bogusTrace
    set result [list [catch {.r deselect} msg] $msg $errorInfo $value2]
    trace vdelete value2 w bogusTrace
    set result
} {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
    while executing
".r deselect"} {}}
test button-4.26 {ButtonWidgetCmd procedure, "flash" option} {
    list [catch {.b flash foo} msg] $msg
} {1 {wrong # args: should be ".b flash"}}
test button-4.27 {ButtonWidgetCmd procedure, "flash" option} {
    list [catch {.l flash} msg] $msg
} {1 {bad option "flash": must be cget or configure}}
test button-4.28 {ButtonWidgetCmd procedure, "flash" option} {
    list [catch {.b flash} msg] $msg
} {0 {}}
test button-4.29 {ButtonWidgetCmd procedure, "flash" option} {
    list [catch {.c flash} msg] $msg
} {0 {}}
test button-4.30 {ButtonWidgetCmd procedure, "flash" option} {
    list [catch {.r f} msg] $msg
} {0 {}}
test button-4.31 {ButtonWidgetCmd procedure, "invoke" option} {
    list [catch {.b invoke foo} msg] $msg
} {1 {wrong # args: should be ".b invoke"}}
test button-4.32 {ButtonWidgetCmd procedure, "invoke" option} {
    list [catch {.l invoke} msg] $msg
} {1 {bad option "invoke": must be cget or configure}}
test button-4.33 {ButtonWidgetCmd procedure, "invoke" option} {
    .b configure -command {set x invoked}
    set x "not invoked"
    .b invoke
    set x
} {invoked}
test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} {
    .b configure -command {set x invoked} -state disabled
    set x "not invoked"
    .b invoke
    set x
} {not invoked}
test button-4.35 {ButtonWidgetCmd procedure, "invoke" option} {
    set value bogus
    .c configure -command {set x invoked} -variable value -onvalue 1 \
	    -offvalue 0
    set x "not invoked"
    .c invoke
    list $x $value
} {invoked 1}
test button-4.36 {ButtonWidgetCmd procedure, "invoke" option} {
    set value2 green
    .r configure -command {set x invoked} -variable value2 -value red
    set x "not invoked"
    .r i
    list $x $value2
} {invoked red}
test button-4.37 {ButtonWidgetCmd procedure, "select" option} {
    list [catch {.l select} msg] $msg
} {1 {bad option "select": must be cget or configure}}
test button-4.38 {ButtonWidgetCmd procedure, "select" option} {
    list [catch {.b select} msg] $msg
} {1 {bad option "select": must be cget, configure, flash, or invoke}}
test button-4.39 {ButtonWidgetCmd procedure, "select" option} {
    list [catch {.c select foo} msg] $msg
} {1 {wrong # args: should be ".c select"}}
test button-4.40 {ButtonWidgetCmd procedure, "select" option} {
    set value bogus
    .c configure -command {} -variable value -onvalue lovely -offvalue 0
    .c s
    set value
} {lovely}
test button-4.41 {ButtonWidgetCmd procedure, "select" option} {
    set value2 green
    .r configure -command {} -variable value2 -value red
    .r select
    set value2
} {red}
test button-4.42 {ButtonWidgetCmd procedure, "select" option} {
    set value2 yellow
    trace variable value2 w bogusTrace
    set result [list [catch {.r select} msg] $msg $errorInfo $value2]
    trace vdelete value2 w bogusTrace
    set result
} {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
    while executing
".r select"} red}
test button-4.43 {ButtonWidgetCmd procedure, "toggle" option} {
    list [catch {.l toggle} msg] $msg
} {1 {bad option "toggle": must be cget or configure}}
test button-4.44 {ButtonWidgetCmd procedure, "toggle" option} {
    list [catch {.b toggle} msg] $msg
} {1 {bad option "toggle": must be cget, configure, flash, or invoke}}
test button-4.45 {ButtonWidgetCmd procedure, "toggle" option} {
    list [catch {.r toggle} msg] $msg
} {1 {bad option "toggle": must be cget, configure, deselect, flash, invoke, or select}}
test button-4.46 {ButtonWidgetCmd procedure, "toggle" option} {
    list [catch {.c toggle foo} msg] $msg
} {1 {wrong # args: should be ".c toggle"}}
test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} {
    set value bogus
    .c configure -command {} -variable value -onvalue sunshine -offvalue rain
    .c toggle
    set result $value
    .c toggle
    lappend result $value
    .c toggle
    lappend result $value
} {sunshine rain sunshine}
test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} {
    .c configure -onvalue xyz -offvalue abc
    set value xyz
    trace variable value w bogusTrace
    set result [list [catch {.c toggle} msg] $msg $errorInfo $value]
    trace vdelete value w bogusTrace
    set result
} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
    while executing
".c toggle"} abc}
test button-4.49 {ButtonWidgetCmd procedure, "toggle" option} {
    .c configure -onvalue xyz -offvalue abc
    set value abc
    trace variable value w bogusTrace
    set result [list [catch {.c toggle} msg] $msg $errorInfo $value]
    trace vdelete value w bogusTrace
    set result
} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
    while executing
".c toggle"} xyz}



test button-4.50 {ButtonWidgetCmd procedure, "toggle" option} {
    catch {unset value}; set value(1) 1;
    set result [list [catch {.c toggle} msg] $msg $errorInfo]
    unset value;
    set result
} {1 {can't set "value": variable is array} {can't set "value": variable is array
    while executing
458
459
460
461
462
463
464
465







466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
    checkbutton .b5 -variable x -text "Checkbutton 5"
    set x 1
    pack .b1 .b2 .b3 .b4 .b5
    update
    eval destroy [winfo children .]
} {}

test button-6.1 {ConfigureButton procedure} {







    catch {destroy .b1}
    set x From-x
    set y From-y
    button .b1 -textvariable x
    .b1 configure -textvariable y
    set x New
    lindex [.b1 configure -text] 4
} {From-y}
test button-6.2 {ConfigureButton procedure} {
    catch {destroy .b1}
    catch {unset x}
    checkbutton .b1 -variable x
    set x 1
    set y 1
    .b1 configure -textvariable y
    set x 0
    .b1 toggle
    set y
} {1}
test button-6.3 {ConfigureButton procedure} {
    catch {destroy .b1}
    eval image delete [image names]
    image create test image1
    image create test image2
    button .b1 -image image1
    image delete image1
    .b1 configure -image image2
    image names
} {image2}
test button-6.4 {ConfigureButton procedure} {
    catch {destroy .b1}
    button .b1 -text "Test" -state disabled
    list [catch {.b1 configure -state bogus} msg] $msg \
	    [lindex [.b1 configure -state] 4]
} {1 {bad state value "bogus": must be normal, active, or disabled} normal}
test button-6.5 {ConfigureButton procedure} {
    catch {destroy .b1}
    checkbutton .b1
    .b1 cget -variable
} {b1}
test button-6.6 {ConfigureButton procedure} {
    catch {destroy .b1}
    set x 0
    set y Shiny
    checkbutton .b1 -variable x
    .b1 configure -variable y -onvalue Shiny
    .b1 toggle
    set y
} 0
test button-6.7 {ConfigureButton procedure} {
    catch {destroy .b1}
    catch {unset x}
    checkbutton .b1 -variable x -offvalue Bogus
    set x
} Bogus
test button-6.8 {ConfigureButton procedure} {
    catch {destroy .b1}
    catch {unset x}
    radiobutton .b1 -variable x
    set x
} {}
test button-6.9 {ConfigureButton procedure} {
    catch {destroy .b1}
    catch {unset x}
    trace variable x w bogusTrace
    set result [list [catch {radiobutton .b1 -variable x} msg] $msg]
    trace vdelete x w bogusTrace
    set result
} {1 {can't set "x": trace aborted}}
test button-6.10 {ConfigureButton procedure} {
    catch {destroy .b1}
    list [catch {button .b1 -image bogus} msg] $msg
} {1 {image "bogus" doesn't exist}}
test button-6.11 {ConfigureButton procedure} {
    catch {destroy .b1}
    catch {unset x}
    button .b1 -textvariable x -text "Button 1"
    set x
} {Button 1}
test button-6.12 {ConfigureButton procedure} {
    catch {destroy .b1}
    set x Override
    button .b1 -textvariable x -text "Button 1"
    set x
} {Override}
test button-6.13 {ConfigureButton procedure} {
    catch {destroy .b1}
    catch {unset x}
    trace variable x w bogusTrace
    set result [list [catch {radiobutton .b1 -text foo -textvariable x} msg] \
	    $msg $x]
    trace vdelete x w bogusTrace
    set result
} {1 {can't set "x": trace aborted} foo}
test button-6.14 {ConfigureButton procedure} {
    catch {destroy .b1}
    button .b1 -text "Button 1"
    list [catch {.b1 configure -width 1i} msg] $msg $errorInfo
} {1 {expected integer but got "1i"} {expected integer but got "1i"
    (processing -width option)
    invoked from within
".b1 configure -width 1i"}}
test button-6.15 {ConfigureButton procedure} {
    catch {destroy .b1}
    button .b1 -text "Button 1"
    list [catch {.b1 configure -height 0.5c} msg] $msg $errorInfo
} {1 {expected integer but got "0.5c"} {expected integer but got "0.5c"
    (processing -height option)
    invoked from within
".b1 configure -height 0.5c"}}
test button-6.16 {ConfigureButton procedure} {
    catch {destroy .b1}
    button .b1 -bitmap questhead
    list [catch {.b1 configure -width abc} msg] $msg $errorInfo
} {1 {bad screen distance "abc"} {bad screen distance "abc"
    (processing -width option)
    invoked from within
".b1 configure -width abc"}}
test button-6.17 {ConfigureButton procedure} {
    catch {destroy .b1}
    eval image delete [image names]
    image create test image1
    button .b1 -image image1
    list [catch {.b1 configure -height 0.5x} msg] $msg $errorInfo
} {1 {bad screen distance "0.5x"} {bad screen distance "0.5x"
    (processing -height option)
    invoked from within
".b1 configure -height 0.5x"}}
test button-6.18 {ConfigureButton procedure} {nonPortable fonts} {
    catch {destroy .b1}
    button .b1 -text "Sample text" -width 10 -height 2
    pack .b1
    set result "[winfo reqwidth .b1] [winfo reqheight .b1]"
    .b1 configure -bitmap questhead
    lappend result [winfo reqwidth .b1] [winfo reqheight .b1]
} {102 46 20 12}
test button-6.19 {ConfigureButton procedure} {
    catch {destroy .b1}
    button .b1 -text "Button 1"
    set old [winfo reqwidth .b1]
    .b1 configure -text "Much longer text"
    set new [winfo reqwidth .b1]
    expr $old == $new
} {0}







|
>
>
>
>
>
>
>








|










|









<
<
<
<
<
<
|




|








|





|





|







|



|





|





|








|







|







|







|









|







|







417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460






461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
    checkbutton .b5 -variable x -text "Checkbutton 5"
    set x 1
    pack .b1 .b2 .b3 .b4 .b5
    update
    eval destroy [winfo children .]
} {}

test button-6.1 {ConfigureButton - textvariable trace} {
    catch {destroy .b1}
    button .b1 -bd 4 -bg green
    catch {.b1 configure -bd 7 -bg green -fg bogus}
    list [catch {.b1 configure -bd 7 -bg red -fg bogus} msg] \
	    $msg [.b1 cget -bd] [.b1 cget -bg]
} {1 {unknown color name "bogus"} 4 green}
test button-6.2 {ConfigureButton - textvariable trace} {
    catch {destroy .b1}
    set x From-x
    set y From-y
    button .b1 -textvariable x
    .b1 configure -textvariable y
    set x New
    lindex [.b1 configure -text] 4
} {From-y}
test button-6.2 {ConfigureButton - variable traces} {
    catch {destroy .b1}
    catch {unset x}
    checkbutton .b1 -variable x
    set x 1
    set y 1
    .b1 configure -textvariable y
    set x 0
    .b1 toggle
    set y
} {1}
test button-6.3 {ConfigureButton - image handling} {
    catch {destroy .b1}
    eval image delete [image names]
    image create test image1
    image create test image2
    button .b1 -image image1
    image delete image1
    .b1 configure -image image2
    image names
} {image2}






test button-6.5 {ConfigureButton - default value for variable} {
    catch {destroy .b1}
    checkbutton .b1
    .b1 cget -variable
} {b1}
test button-6.6 {ConfigureButton - setting selected state from variable} {
    catch {destroy .b1}
    set x 0
    set y Shiny
    checkbutton .b1 -variable x
    .b1 configure -variable y -onvalue Shiny
    .b1 toggle
    set y
} 0
test button-6.7 {ConfigureButton - setting selected state from variable} {
    catch {destroy .b1}
    catch {unset x}
    checkbutton .b1 -variable x -offvalue Bogus
    set x
} Bogus
test button-6.8 {ConfigureButton - setting selected state from variable} {
    catch {destroy .b1}
    catch {unset x}
    radiobutton .b1 -variable x
    set x
} {}
test button-6.9 {ConfigureButton - error in setting variable} {
    catch {destroy .b1}
    catch {unset x}
    trace variable x w bogusTrace
    set result [list [catch {radiobutton .b1 -variable x} msg] $msg]
    trace vdelete x w bogusTrace
    set result
} {1 {can't set "x": trace aborted}}
test button-6.10 {ConfigureButton - bad image name} {
    catch {destroy .b1}
    list [catch {button .b1 -image bogus} msg] $msg
} {1 {image "bogus" doesn't exist}}
test button-6.11 {ConfigureButton - setting variable from current text value} {
    catch {destroy .b1}
    catch {unset x}
    button .b1 -textvariable x -text "Button 1"
    set x
} {Button 1}
test button-6.12 {ConfigureButton - using current value of variable} {
    catch {destroy .b1}
    set x Override
    button .b1 -textvariable x -text "Button 1"
    set x
} {Override}
test button-6.13 {ConfigureButton - variable handling} {
    catch {destroy .b1}
    catch {unset x}
    trace variable x w bogusTrace
    set result [list [catch {radiobutton .b1 -text foo -textvariable x} msg] \
	    $msg $x]
    trace vdelete x w bogusTrace
    set result
} {1 {can't set "x": trace aborted} foo}
test button-6.14 {ConfigureButton - -width option} {
    catch {destroy .b1}
    button .b1 -text "Button 1"
    list [catch {.b1 configure -width 1i} msg] $msg $errorInfo
} {1 {expected integer but got "1i"} {expected integer but got "1i"
    (processing -width option)
    invoked from within
".b1 configure -width 1i"}}
test button-6.15 {ConfigureButton - -height option} {
    catch {destroy .b1}
    button .b1 -text "Button 1"
    list [catch {.b1 configure -height 0.5c} msg] $msg $errorInfo
} {1 {expected integer but got "0.5c"} {expected integer but got "0.5c"
    (processing -height option)
    invoked from within
".b1 configure -height 0.5c"}}
test button-6.16 {ConfigureButton - -width option} {
    catch {destroy .b1}
    button .b1 -bitmap questhead
    list [catch {.b1 configure -width abc} msg] $msg $errorInfo
} {1 {bad screen distance "abc"} {bad screen distance "abc"
    (processing -width option)
    invoked from within
".b1 configure -width abc"}}
test button-6.17 {ConfigureButton - -height option} {
    catch {destroy .b1}
    eval image delete [image names]
    image create test image1
    button .b1 -image image1
    list [catch {.b1 configure -height 0.5x} msg] $msg $errorInfo
} {1 {bad screen distance "0.5x"} {bad screen distance "0.5x"
    (processing -height option)
    invoked from within
".b1 configure -height 0.5x"}}
test button-6.18 {ConfigureButton - computing geometry} {nonPortable fonts} {
    catch {destroy .b1}
    button .b1 -text "Sample text" -width 10 -height 2
    pack .b1
    set result "[winfo reqwidth .b1] [winfo reqheight .b1]"
    .b1 configure -bitmap questhead
    lappend result [winfo reqwidth .b1] [winfo reqheight .b1]
} {102 46 20 12}
test button-6.19 {ConfigureButton - computing geometry} {
    catch {destroy .b1}
    button .b1 -text "Button 1"
    set old [winfo reqwidth .b1]
    .b1 configure -text "Much longer text"
    set new [winfo reqwidth .b1]
    expr $old == $new
} {0}
815
816
817
818
819
820
821
822
















    destroy .b
    list [winfo children .] [interp hidden]
} [list {} $l]

eval destroy [winfo children .]

option clear

























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
    destroy .b
    list [winfo children .] [interp hidden]
} [list {} $l]

eval destroy [winfo children .]

option clear

# cleanup
::tcltest::cleanupTests
return













Changes to tests/canvImg.test.

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
# This file is a Tcl script to test out the procedures in tkCanvImg.c,
# which implement canvas "image" items.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) canvImg.test 1.17 97/07/02 11:28:26




if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"

    return
}

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

eval image delete [image names]






>
>

<
<
>
|
<
>
>
>





>



<
<
<
<







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
# This file is a Tcl script to test out the procedures in tkCanvImg.c,
# which implement canvas "image" items.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: canvImg.test,v 1.1.4.5 1999/03/26 00:07:51 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    ::tcltest::cleanupTests
    return
}





foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

eval image delete [image names]
391
392
393
394
395
396
397

















    .c create image 70 110 -image foo2 -anchor nw
    update
    set y {}
    image create test foo -variable x
    update
    set y
} {{foo2 display 0 0 20 40 50 40}}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
    .c create image 70 110 -image foo2 -anchor nw
    update
    set y {}
    image create test foo -variable x
    update
    set y
} {{foo2 display 0 0 20 40 50 40}}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/canvPs.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out procedures to write postscript
# for canvases to files and channels. It exercises the procedure
# TkCanvPostscriptCmd in generic/tkCanvPs.c
#
# Copyright (c) 1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) canvPs.test 1.5 97/06/10 15:49:35

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .





|
|
<

|

|
|







1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18
19
# This file is a Tcl script to test out procedures to write postscript
# for canvases to files and channels. It exercises the procedure
# TkCanvPostscriptCmd in generic/tkCanvPs.c
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: canvPs.test,v 1.1.4.4 1999/03/24 02:54:28 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105















    set status ok
    if {[file size foo.ps] != [file size bar.ps]} {
	set status broken
    }
    set status
} ok

# Clean-up

removeFile foo.ps
removeFile bar.ps

foreach i [winfo children .] {
    destroy $i
}






















|
<


<



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
    set status ok
    if {[file size foo.ps] != [file size bar.ps]} {
	set status broken
    }
    set status
} ok

# cleanup

removeFile foo.ps
removeFile bar.ps

foreach i [winfo children .] {
    destroy $i
}
::tcltest::cleanupTests
return













Changes to tests/canvPsArc.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# This file creates a screen to exercise Postscript generation
# for bitmaps in canvases.  It is part of the Tk visual test suite,
# which is invoked via the "visual" script.
#
# SCCS: @(#) canvPsArc.tcl 1.3 96/02/16 10:55:43

catch {destroy .t}
toplevel .t
wm title .t "Postscript Tests for Canvases"
wm iconname .t "Postscript"
wm geom .t +0+0
wm minsize .t 1 1




|







1
2
3
4
5
6
7
8
9
10
11
12
# This file creates a screen to exercise Postscript generation
# for bitmaps in canvases.  It is part of the Tk visual test suite,
# which is invoked via the "visual" script.
#
# RCS: @(#) $Id: canvPsArc.tcl,v 1.1.4.3 1999/03/24 02:54:28 hershey Exp $

catch {destroy .t}
toplevel .t
wm title .t "Postscript Tests for Canvases"
wm iconname .t "Postscript"
wm geom .t +0+0
wm minsize .t 1 1
39
40
41
42
43
44
45













$c create arc 4i 2.5i 8i 4.5i -style chord -start 60 -extent 60 \
    -fill {} -outline black

$c create arc .5i 4.5i 2i 6i -style arc -start 135 -extent 315 -width 3m \
    -outline black -outlinestipple gray25
$c create arc 3.5i 4.5i 5.5i 5.5i -style arc -start 45 -extent -90 -width 1m \
    -outline black




















>
>
>
>
>
>
>
>
>
>
>
>
>
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
$c create arc 4i 2.5i 8i 4.5i -style chord -start 60 -extent 60 \
    -fill {} -outline black

$c create arc .5i 4.5i 2i 6i -style arc -start 135 -extent 315 -width 3m \
    -outline black -outlinestipple gray25
$c create arc 3.5i 4.5i 5.5i 5.5i -style arc -start 45 -extent -90 -width 1m \
    -outline black













Changes to tests/canvPsBmap.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# This file creates a screen to exercise Postscript generation
# for bitmaps in canvases.  It is part of the Tk visual test suite,
# which is invoked via the "visual" script.
#
# SCCS: @(#) canvPsBmap.tcl 1.5 96/07/25 15:54:14

catch {destroy .t}
toplevel .t
wm title .t "Postscript Tests for Canvases"
wm iconname .t "Postscript"
wm geom .t +0+0
wm minsize .t 1 1




|







1
2
3
4
5
6
7
8
9
10
11
12
# This file creates a screen to exercise Postscript generation
# for bitmaps in canvases.  It is part of the Tk visual test suite,
# which is invoked via the "visual" script.
#
# RCS: @(#) $Id: canvPsBmap.tcl,v 1.1.4.3 1999/03/24 02:54:29 hershey Exp $

catch {destroy .t}
toplevel .t
wm title .t "Postscript Tests for Canvases"
wm iconname .t "Postscript"
wm geom .t +0+0
wm minsize .t 1 1
65
66
67
68
69
70
71













    -background green -foreground white -anchor s
$c create rect 2.97i 5.47i 3.03i 5.53i -fill {} -outline black

$c create bitmap 5.5i 5.5i \
    -bitmap @[file join $tk_library demos/images/flagup.bmp] \
    -background {} -foreground black -anchor se
$c create rect 5.47i 5.47i 5.53i 5.53i -fill {} -outline black




















>
>
>
>
>
>
>
>
>
>
>
>
>
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
    -background green -foreground white -anchor s
$c create rect 2.97i 5.47i 3.03i 5.53i -fill {} -outline black

$c create bitmap 5.5i 5.5i \
    -bitmap @[file join $tk_library demos/images/flagup.bmp] \
    -background {} -foreground black -anchor se
$c create rect 5.47i 5.47i 5.53i 5.53i -fill {} -outline black













Changes to tests/canvPsGrph.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# This file creates a screen to exercise Postscript generation
# for some of the graphical objects in canvases.  It is part of the Tk
# visual test suite, which is invoked via the "visual" script.
#
# SCCS: @(#) canvPsGrph.tcl 1.3 96/02/16 10:56:07

catch {destroy .t}
toplevel .t
wm title .t "Postscript Tests for Canvases"
wm iconname .t "Postscript"
wm geom .t +0+0
wm minsize .t 1 1




|







1
2
3
4
5
6
7
8
9
10
11
12
# This file creates a screen to exercise Postscript generation
# for some of the graphical objects in canvases.  It is part of the Tk
# visual test suite, which is invoked via the "visual" script.
#
# RCS: @(#) $Id: canvPsGrph.tcl,v 1.1.4.3 1999/03/24 02:54:29 hershey Exp $

catch {destroy .t}
toplevel .t
wm title .t "Postscript Tests for Canvases"
wm iconname .t "Postscript"
wm geom .t +0+0
wm minsize .t 1 1
81
82
83
84
85
86
87













		-width 10
	$c create line 300 20 380 20 300 150 380 150 -join miter -cap butt \
		-width 10 -stipple gray25
    }
}

mkObjs $c




















>
>
>
>
>
>
>
>
>
>
>
>
>
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
		-width 10
	$c create line 300 20 380 20 300 150 380 150 -join miter -cap butt \
		-width 10 -stipple gray25
    }
}

mkObjs $c













Changes to tests/canvPsText.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# This file creates a screen to exercise Postscript generation
# for text in canvases.  It is part of the Tk visual test suite,
# which is invoked via the "visual" script.
#
# SCCS: @(#) canvPsText.tcl 1.3 96/06/24 16:49:12

catch {destroy .t}
toplevel .t
wm title .t "Postscript Tests for Canvases"
wm iconname .t "Postscript"
wm geom .t +0+0
wm minsize .t 1 1




|







1
2
3
4
5
6
7
8
9
10
11
12
# This file creates a screen to exercise Postscript generation
# for text in canvases.  It is part of the Tk visual test suite,
# which is invoked via the "visual" script.
#
# RCS: @(#) $Id: canvPsText.tcl,v 1.1.4.3 1999/03/24 02:54:30 hershey Exp $

catch {destroy .t}
toplevel .t
wm title .t "Postscript Tests for Canvases"
wm iconname .t "Postscript"
wm geom .t +0+0
wm minsize .t 1 1
77
78
79
80
81
82
83













	justified as well."
$c create rect 0.5i 6.0i 5.5i 6.9i -fill {} -outline black

proc setStipple c {
    global stipple
    $c itemconfigure text -stipple $stipple
}




















>
>
>
>
>
>
>
>
>
>
>
>
>
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
	justified as well."
$c create rect 0.5i 6.0i 5.5i 6.9i -fill {} -outline black

proc setStipple c {
    global stipple
    $c itemconfigure text -stipple $stipple
}













Changes to tests/canvRect.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out the procedures in tkRectOval.c,
# which implement canvas "rectangle" and "oval" items.  It is organized
# in the standard fashion for Tcl tests.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) canvRect.test 1.18 97/08/06 15:33:39

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .





|
|
<

|

|
|







1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18
19
# This file is a Tcl script to test out the procedures in tkRectOval.c,
# which implement canvas "rectangle" and "oval" items.  It is organized
# in the standard fashion for Tcl tests.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: canvRect.test,v 1.1.4.5 1999/03/26 00:07:52 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
    .c move x 100 -10
    .c coords x
} {200.0 290.0 300.0 340.0}

# This test is non-portable because different color information
# will get generated on different displays (e.g. mono displays
# vs. color).
test canvRect-11.1 {RectOvalToPostscript procedure} {nonPortable win32sCrash macCrash} {
    # Crashes on Mac because the XGetImage() call isn't implemented, causing a
    # dereference of NULL.
    
    .c configure -bd 0 -highlightthickness 0
    .c delete withtag all
    .c create rect 50 60 90 80 -fill black -stipple gray50 -outline {}
    .c create oval 100 150 200 200 -fill {} -outline #ff0000 -width 5







|







289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
    .c move x 100 -10
    .c coords x
} {200.0 290.0 300.0 340.0}

# This test is non-portable because different color information
# will get generated on different displays (e.g. mono displays
# vs. color).
test canvRect-11.1 {RectOvalToPostscript procedure} {nonPortable macCrash} {
    # Crashes on Mac because the XGetImage() call isn't implemented, causing a
    # dereference of NULL.
    
    .c configure -bd 0 -highlightthickness 0
    .c delete withtag all
    .c create rect 50 60 90 80 -fill black -stipple gray50 -outline {}
    .c create oval 100 150 200 200 -fill {} -outline #ff0000 -width 5
323
324
325
326
327
328
329

















grestore
restore showpage

%%Trailer
end
%%EOF
}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
grestore
restore showpage

%%Trailer
end
%%EOF
}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/canvText.test.

1
2
3
4
5


6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out the procedures in tkCanvText.c,
# which implement canvas "text" items.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) canvText.test 1.8 97/06/24 13:34:16

if {"[info procs test]" != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .





>
>

<
<
>
|
<
|
<
|







1
2
3
4
5
6
7
8


9
10

11

12
13
14
15
16
17
18
19
# This file is a Tcl script to test out the procedures in tkCanvText.c,
# which implement canvas "text" items.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: canvText.test,v 1.1.4.7 1999/03/26 19:14:46 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {

    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
30
31
32
33
34
35
36

37
38
39
40
41
42
43
set ay [font metrics $font -linespace]
set ax [font measure $font 0]


foreach test {
    {-anchor nw nw xyz {bad anchor position "xyz": must be n, ne, e, se, s, sw, w, nw, or center}}
    {-fill #ff0000 #ff0000 xyz {unknown color name "xyz"}}

    {-font {Times 40} {Times 40} {} {font "" doesn't exist}}
    {-justify left left xyz {bad justification "xyz": must be left, right, or center}}
    {-stipple gray50 gray50 xyz {bitmap "xyz" not defined}}
    {-tags {test a b c} {test a b c} {} {}}
    {-text xyz xyz {} {}}
    {-width 6 6 xyz {bad screen distance "xyz"}}
} {







>







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
set ay [font metrics $font -linespace]
set ax [font measure $font 0]


foreach test {
    {-anchor nw nw xyz {bad anchor position "xyz": must be n, ne, e, se, s, sw, w, nw, or center}}
    {-fill #ff0000 #ff0000 xyz {unknown color name "xyz"}}
    {-fill {} {} {} {}}
    {-font {Times 40} {Times 40} {} {font "" doesn't exist}}
    {-justify left left xyz {bad justification "xyz": must be left, right, or center}}
    {-stipple gray50 gray50 xyz {bitmap "xyz" not defined}}
    {-tags {test a b c} {test a b c} {} {}}
    {-text xyz xyz {} {}}
    {-width 6 6 xyz {bad screen distance "xyz"}}
} {
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
} {4}

test canvText-5.1 {ConfigureText procedure: adjust cursor} {
    .c create text 10 10 -tag x -fill blue -font "times 40" -stipple gray50 -text "xyz"
    .c delete x
} {}

test canvText-6.1 {ComputeTextBbox procedure} {fonts} {
    .c itemconfig test -font $font -text 0
    .c coords test 0 0
    set x {}
    lappend x [.c itemconfig test -anchor n; .c bbox test]
    lappend x [.c itemconfig test -anchor nw; .c bbox test]
    lappend x [.c itemconfig test -anchor w; .c bbox test]
    lappend x [.c itemconfig test -anchor sw; .c bbox test]







|







169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
} {4}

test canvText-5.1 {ConfigureText procedure: adjust cursor} {
    .c create text 10 10 -tag x -fill blue -font "times 40" -stipple gray50 -text "xyz"
    .c delete x
} {}

test canvText-6.1 {ComputeTextBbox procedure} {fonts nonPortable} {
    .c itemconfig test -font $font -text 0
    .c coords test 0 0
    set x {}
    lappend x [.c itemconfig test -anchor n; .c bbox test]
    lappend x [.c itemconfig test -anchor nw; .c bbox test]
    lappend x [.c itemconfig test -anchor w; .c bbox test]
    lappend x [.c itemconfig test -anchor sw; .c bbox test]
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
{[expr -$ax-1] [expr -$ay/2] 1 [expr $ay/2]}\
{[expr -$ax-1] 0 1 $ay}\
{[expr -$ax/2-1] [expr -$ay/2] [expr $ax/2+1] [expr $ay/2]}"

focus .c
.c focus test
.c itemconfig test -text "abcd\nefghi\njklmnopq"
test canvText-7.1 {DisplayText procedure: stippling} {
    .c itemconfig test -stipple gray50
    update
    .c itemconfig test -stipple {}
    update
} {}
test canvText-7.2 {DisplayText procedure: draw selection} {
    .c select from test 0







|







195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
{[expr -$ax-1] [expr -$ay/2] 1 [expr $ay/2]}\
{[expr -$ax-1] 0 1 $ay}\
{[expr -$ax/2-1] [expr -$ay/2] [expr $ax/2+1] [expr $ay/2]}"

focus .c
.c focus test
.c itemconfig test -text "abcd\nefghi\njklmnopq"
test canvText-7.0 {DisplayText procedure: stippling} {
    .c itemconfig test -stipple gray50
    update
    .c itemconfig test -stipple {}
    update
} {}
test canvText-7.2 {DisplayText procedure: draw selection} {
    .c select from test 0
486
487
488
489
490
491
492
















grestore
restore showpage

%%Trailer
end
%%EOF
"























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
grestore
restore showpage

%%Trailer
end
%%EOF
"
# cleanup
::tcltest::cleanupTests
return













Changes to tests/canvWind.test.

1
2
3
4
5


6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out the procedures in tkCanvWind.c,
# which implement canvas "window" items.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) canvWind.test 1.2 97/11/06 13:49:14

if {"[info procs test]" != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .





>
>

<
<
>
|
<
|
<
|







1
2
3
4
5
6
7
8


9
10

11

12
13
14
15
16
17
18
19
# This file is a Tcl script to test out the procedures in tkCanvWind.c,
# which implement canvas "window" items.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: canvWind.test,v 1.1.4.5 1999/03/24 02:54:32 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {

    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
127
128
129
130
131
132
133


















    .t.c xview scroll -335 units
    update
    lappend x [list [winfo ismapped $f] [winfo x $f]]
    .t.c xview scroll -1 units
    update
    lappend x [list [winfo ismapped $f] [winfo x $f]]
} {{1 3} {1 -79} {0 -79} {1 255} {0 255}}

























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
    .t.c xview scroll -335 units
    update
    lappend x [list [winfo ismapped $f] [winfo x $f]]
    .t.c xview scroll -1 units
    update
    lappend x [list [winfo ismapped $f] [winfo x $f]]
} {{1 3} {1 -79} {0 -79} {1 255} {0 255}}
catch {destroy .t}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/canvas.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out the procedures in tkCanvas.c,
# which implements generic code for canvases.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) canvas.test 1.10 97/07/31 10:22:48

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .





|
|
<

|

|
|







1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18
19
# This file is a Tcl script to test out the procedures in tkCanvas.c,
# which implements generic code for canvases.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: canvas.test,v 1.1.4.6 1999/03/24 02:54:33 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
70
71
72
73
74
75
76

77








78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93


catch {destroy .c}
canvas .c -width 60 -height 40 -scrollregion {0 0 200 150} -bd 0 \
	-highlightthickness 0
pack .c
update

test canvas-2.1 {CanvasWidgetCmd, xview option} {








    .c configure -xscrollincrement 40 -yscrollincrement 5
    .c xview moveto 0
    update
    set x [list [.c xview]]
    .c xview scroll 2 units
    update
    lappend x [.c xview]
} {{0 0.3} {0.4 0.7}}
test canvas-2.2 {CanvasWidgetCmd, xview option} {nonPortable} {
    # This test gives slightly different results on platforms such
    # as NetBSD.  I don't know why...
    .c configure -xscrollincrement 0 -yscrollincrement 5
    .c xview moveto 0.6
    update
    set x [list [.c xview]]
    .c xview scroll 2 units







>
|
>
>
>
>
>
>
>
>








|







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


catch {destroy .c}
canvas .c -width 60 -height 40 -scrollregion {0 0 200 150} -bd 0 \
	-highlightthickness 0
pack .c
update

test canvas-2.1 {CanvasWidgetCmd, bind option} {
    set i [.c create rect 10 10 100 100]
    list [catch {.c bind $i <a>} msg] $msg
} {0 {}}
test canvas-2.2 {CanvasWidgetCmd, bind option} {
    set i [.c create rect 10 10 100 100]
    list [catch {.c bind $i <} msg] $msg
} {1 {no event type or button # or keysym}}
test canvas-2.3 {CanvasWidgetCmd, xview option} {
    .c configure -xscrollincrement 40 -yscrollincrement 5
    .c xview moveto 0
    update
    set x [list [.c xview]]
    .c xview scroll 2 units
    update
    lappend x [.c xview]
} {{0 0.3} {0.4 0.7}}
test canvas-2.4 {CanvasWidgetCmd, xview option} {nonPortable} {
    # This test gives slightly different results on platforms such
    # as NetBSD.  I don't know why...
    .c configure -xscrollincrement 0 -yscrollincrement 5
    .c xview moveto 0.6
    update
    set x [list [.c xview]]
    .c xview scroll 2 units
186
187
188
189
190
191
192






























































test canvas-7.1 {canvas widget vs hidden commands} {
    catch {destroy .c}
    canvas .c
    interp hide {} .c
    destroy .c
    list [winfo children .] [interp hidden]
} [list {} $l]





































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
test canvas-7.1 {canvas widget vs hidden commands} {
    catch {destroy .c}
    canvas .c
    interp hide {} .c
    destroy .c
    list [winfo children .] [interp hidden]
} [list {} $l]

test canvas-8.1 {canvas arc bbox} {
    catch {destroy .c}
    canvas .c
    .c create arc -100 10 100 210 -start 10 -extent 50 -style arc -tags arc1
    set arcBox [.c bbox arc1]
    .c create arc 100 10 300 210 -start 10 -extent 50 -style chord -tags arc2
    set coordBox [.c bbox arc2]
    .c create arc 300 10 500 210 -start 10 -extent 50 -style pieslice -tags arc3
    set pieBox [.c bbox arc3]
    list $arcBox $coordBox $pieBox
} {{48 21 100 94} {248 21 300 94} {398 21 500 112}}
test canvas-9.1 {canvas id creation and deletion} {
    # With Tk 8.0.4 the ids are now stored in a hash table.  You
    # can use this test as a performance test with older versions
    # by changing the value of size.
    set size 15

    catch {destroy .c}
    set c [canvas .c]
    for {set i 0} {$i < $size} {incr i} {
	set x [expr {-10 + 3*$i}]
	for {set j 0; set y -10} {$j < 10} {incr j; incr y 3} {
	    $c create rect ${x}c ${y}c [expr $x+2]c [expr $y+2]c \
		    -outline black -fill blue -tags rect
	    $c create text [expr $x+1]c [expr $y+1]c -text "$i,$j" \
		    -anchor center -tags text
	}
    }

    # The actual bench mark - this code also exercises all the hash
    # table changes.

    set time [lindex [time {
	foreach id [$c find withtag all] {
	    $c lower $id
	    $c raise $id
	    $c find withtag $id
	    $c bind <Return> $id {}
	    $c delete $id
	}
    }] 0]
	
    set x ""
} {}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/clipboard.test.

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
# This file is a Tcl script to test out Tk's clipboard management code,
# especially the "clipboard" command.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) clipboard.test 1.15 96/12/09 17:26:02

#
# Note: Multiple display clipboard handling will only be tested if the
# environment variable TK_ALT_DISPLAY is set to an alternate display.
#

if {[string compare test [info procs test]] == 1} {
    source defs
}

eval destroy [winfo child .]

# set up a very large buffer to test INCR retrievals
set longValue ""
foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} {





|
|
<

|






|
|







1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
# This file is a Tcl script to test out Tk's clipboard management code,
# especially the "clipboard" command.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: clipboard.test,v 1.1.4.4 1999/03/24 02:54:34 hershey Exp $

#
# Note: Multiple display clipboard handling will only be tested if the
# environment variable TK_ALT_DISPLAY is set to an alternate display.
#

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

eval destroy [winfo child .]

# set up a very large buffer to test INCR retrievals
set longValue ""
foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} {
228
229
230
231
232
233
234

















test clipboard-7.13 {Tk_ClipboardCmd procedure} {
    list [catch {clipboard clear -displayof foo} msg] $msg
} {1 {bad window path name "foo"}}

test clipboard-7.14 {Tk_ClipboardCmd procedure} {
    list [catch {clipboard error} msg] $msg
} {1 {bad option "error": must be clear or append}}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
test clipboard-7.13 {Tk_ClipboardCmd procedure} {
    list [catch {clipboard clear -displayof foo} msg] $msg
} {1 {bad window path name "foo"}}

test clipboard-7.14 {Tk_ClipboardCmd procedure} {
    list [catch {clipboard error} msg] $msg
} {1 {bad option "error": must be clear or append}}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/clrpick.test.

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
# This file is a Tcl script to test out Tk's "tk_chooseColor" command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# @(#) clrpick.test 1.9 97/10/21 11:29:53
#



if {[string compare test [info procs test]] == 1} {
    source defs

}




test clrpick-1.1 {tk_chooseColor command} {
    list [catch {tk_chooseColor -foo} msg] $msg
} {1 {unknown option "-foo", must be -initialcolor, -parent or -title}}

catch {tk_chooseColor -foo} msg
regsub -all ,      $msg "" options
regsub \"-foo\" $options "" options

foreach option $options {
    if {[string index $option 0] == "-"} {
	test clrpick-1.2 {tk_chooseColor command} {
	    list [catch {tk_chooseColor $option} msg] $msg
	} [list 1 "value for \"$option\" missing"]
    }
}

test clrpick-1.3 {tk_chooseColor command} {
    list [catch {tk_chooseColor -foo bar} msg] $msg
} {1 {unknown option "-foo", must be -initialcolor, -parent or -title}}

test clrpick-1.4 {tk_chooseColor command} {
    list [catch {tk_chooseColor -initialcolor} msg] $msg
} {1 {value for "-initialcolor" missing}}

test clrpick-1.5 {tk_chooseColor command} {
    list [catch {tk_chooseColor -parent foo.bar} msg] $msg




>
>

<
<
>

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



|

|













|







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
# This file is a Tcl script to test out Tk's "tk_chooseColor" command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: clrpick.test,v 1.1.4.6 1999/03/26 00:07:52 hershey Exp $
#


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}


# Some tests require user interaction on non-unix platform

set ::tcltest::testConfig(nonUnixUserInteraction) \
    [expr {$::tcltest::testConfig(userInteraction) || \
	$::tcltest::testConfig(unixOnly)}]

test clrpick-1.1 {tk_chooseColor command} {
    list [catch {tk_chooseColor -foo} msg] $msg
} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}}

catch {tk_chooseColor -foo 1} msg
regsub -all ,      $msg "" options
regsub \"-foo\" $options "" options

foreach option $options {
    if {[string index $option 0] == "-"} {
	test clrpick-1.2 {tk_chooseColor command} {
	    list [catch {tk_chooseColor $option} msg] $msg
	} [list 1 "value for \"$option\" missing"]
    }
}

test clrpick-1.3 {tk_chooseColor command} {
    list [catch {tk_chooseColor -foo bar} msg] $msg
} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}}

test clrpick-1.4 {tk_chooseColor command} {
    list [catch {tk_chooseColor -initialcolor} msg] $msg
} {1 {value for "-initialcolor" missing}}

test clrpick-1.5 {tk_chooseColor command} {
    list [catch {tk_chooseColor -parent foo.bar} msg] $msg
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

if {[info commands tkColorDialog] == ""} {
    set isNative 1
} else {
    set isNative 0
}

if {$isNative && ![info exists INTERACTIVE]} {
    puts " Some tests were skipped because they could not be performed"
    puts " automatically on this platform. If you wish to execute them"
    puts " interactively, set the TCL variable INTERACTIVE and re-run"
    puts " the test."
    return
}

proc ToPressButton {parent btn} {
    global isNative
    if {!$isNative} {
	after 200 "SendButtonPress $parent $btn mouse"
    }
}








<
<
<
<
<
<
<
<







56
57
58
59
60
61
62








63
64
65
66
67
68
69

if {[info commands tkColorDialog] == ""} {
    set isNative 1
} else {
    set isNative 0
}









proc ToPressButton {parent btn} {
    global isNative
    if {!$isNative} {
	after 200 "SendButtonPress $parent $btn mouse"
    }
}

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

















#set verylongstring $verylongstring$verylongstring
#set verylongstring $verylongstring$verylongstring
#set verylongstring $verylongstring$verylongstring
#set verylongstring $verylongstring$verylongstring

# let's soak up a bunch of colors...so that
# machines with small color palettes still fail.

set numcolors 32
set nomorecolors 0
set i 0
canvas .c
pack .c -expand 1 -fill both
while {$i<$numcolors} {
    set color \#[format "%02x%02x%02x" $i [expr $i+1] [expr $i+3]]
    .c create rectangle [expr 10+$i] [expr 10+$i] [expr 50+$i] [expr 50+$i] -fill $color -outline $color
    incr i
}
set i 0
while {$i<$numcolors} {
    set color [.c itemcget $i -fill]
    if {$color != ""} {
	foreach {r g b} [winfo rgb . $color] {}
	set r [expr $r/256]
	set g [expr $g/256]
	set b [expr $b/256]
	if {"$color" != "#[format %02x%02x%02x $r $g $b]"} {
	    set nomorecolors 1
	}
    }
    .c delete $i
    incr i
}

destroy .c

if {!$nomorecolors} {
    set color #404040
    test clrpick-2.1 {tk_chooseColor command} {

	ToPressButton $parent ok
	tk_chooseColor -title "Press Ok $verylongstring" -initialcolor $color -parent $parent

    } "$color"
    
    set color #808040
    test clrpick-2.2 {tk_chooseColor command} {

	if {$tcl_platform(platform) == "macintosh"} {
	    set colors "32768 32768 16384"
	} else {
	    set colors "128 128 64"
	}
	ToChooseColorByKey $parent 128 128 64
	tk_chooseColor -parent $parent -title "choose $colors"
    } "$color"
    
    test clrpick-2.3 {tk_chooseColor command} {

	ToPressButton $parent ok
	tk_chooseColor -parent $parent -title "Press OK"
    } "$color"
} else {
    puts "Skipped tests clrpick2.1, clrpick2.2 and clrpick2.3 because"
    puts "you ran out of colors in your color palette, and this would"
    puts "have caused the tests to generate errors."
}
    
test clrpick-2.4 {tk_chooseColor command} {
    ToPressButton $parent cancel
    tk_chooseColor -parent $parent -title "Press Cancel"
} ""

set color #000000
test clrpick-3.1 {tk_chooseColor: background events} {
    after 1 {set x 53}
    ToPressButton $parent ok
    tk_chooseColor -parent $parent -title "Press OK" -initialcolor $color
} "#000000"
test clrpick-3.2 {tk_chooseColor: background events} {
    after 1 {set x 53}
    ToPressButton $parent cancel
    tk_chooseColor -parent $parent -title "Press Cancel"
} ""
























>

|

















|








<
|
|
>
|
|
>
|

|
|
>
|
|
|
|
|
|
|
|

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





|




|




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169

170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194




195

196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
#set verylongstring $verylongstring$verylongstring
#set verylongstring $verylongstring$verylongstring
#set verylongstring $verylongstring$verylongstring
#set verylongstring $verylongstring$verylongstring

# let's soak up a bunch of colors...so that
# machines with small color palettes still fail.
# some tests will be skipped if there are no more colors
set numcolors 32
set ::tcltest::testConfig(colorsLeftover) 1
set i 0
canvas .c
pack .c -expand 1 -fill both
while {$i<$numcolors} {
    set color \#[format "%02x%02x%02x" $i [expr $i+1] [expr $i+3]]
    .c create rectangle [expr 10+$i] [expr 10+$i] [expr 50+$i] [expr 50+$i] -fill $color -outline $color
    incr i
}
set i 0
while {$i<$numcolors} {
    set color [.c itemcget $i -fill]
    if {$color != ""} {
	foreach {r g b} [winfo rgb . $color] {}
	set r [expr $r/256]
	set g [expr $g/256]
	set b [expr $b/256]
	if {"$color" != "#[format %02x%02x%02x $r $g $b]"} {
	    set ::tcltest::testConfig(colorsLeftover) 0
	}
    }
    .c delete $i
    incr i
}

destroy .c


set color #404040
test clrpick-2.1 {tk_chooseColor command} \
	{nonUnixUserInteraction colorsLeftover} {
    ToPressButton $parent ok
    tk_chooseColor -title "Press Ok $verylongstring" -initialcolor $color \
	    -parent $parent
} "$color"
    
set color #808040
test clrpick-2.2 {tk_chooseColor command} \
	{nonUnixUserInteraction colorsLeftover} {
    if {$tcl_platform(platform) == "macintosh"} {
	set colors "32768 32768 16384"
    } else {
	set colors "128 128 64"
    }
    ToChooseColorByKey $parent 128 128 64
    tk_chooseColor -parent $parent -title "choose $colors"
} "$color"
    
test clrpick-2.3 {tk_chooseColor command} \
	{nonUnixUserInteraction colorsLeftover} {
    ToPressButton $parent ok
    tk_chooseColor -parent $parent -title "Press OK"
} "$color"




    

test clrpick-2.4 {tk_chooseColor command} {nonUnixUserInteraction} {
    ToPressButton $parent cancel
    tk_chooseColor -parent $parent -title "Press Cancel"
} ""

set color #000000
test clrpick-3.1 {tk_chooseColor: background events} {nonUnixUserInteraction} {
    after 1 {set x 53}
    ToPressButton $parent ok
    tk_chooseColor -parent $parent -title "Press OK" -initialcolor $color
} "#000000"
test clrpick-3.2 {tk_chooseColor: background events} {nonUnixUserInteraction} {
    after 1 {set x 53}
    ToPressButton $parent cancel
    tk_chooseColor -parent $parent -title "Press Cancel"
} ""

# cleanup
::tcltest::cleanupTests
return













Changes to tests/cmap.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
# This file creates a visual test for colormaps and the WM_COLORMAP_WINDOWS
# property.  It is part of the Tk visual test suite, which is invoked
# via the "visual" script.
#
# SCCS: @(#) cmap.tcl 1.2 96/02/16 10:55:47

catch {destroy .t}
toplevel .t -colormap new
wm title .t "Visual Test for Colormaps"
wm iconname .t "Colormaps"
wm geom .t +0+0





|







1
2
3
4
5
6
7
8
9
10
11
12
# This file creates a visual test for colormaps and the WM_COLORMAP_WINDOWS
# property.  It is part of the Tk visual test suite, which is invoked
# via the "visual" script.
#
# RCS: @(#) $Id: cmap.tcl,v 1.1.4.3 1999/03/24 02:54:35 hershey Exp $

catch {destroy .t}
toplevel .t -colormap new
wm title .t "Visual Test for Colormaps"
wm iconname .t "Colormaps"
wm geom .t +0+0

55
56
57
58
59
60
61














button .t2.quit -text Quit -command {destroy .t2}
pack .t2.quit -side bottom -pady 3 -ipadx 4 -ipady 2

frame .t2.f -height 320 -width 320
pack .t2.f -side bottom
colors .t2.f 0 0 4




















>
>
>
>
>
>
>
>
>
>
>
>
>
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74

button .t2.quit -text Quit -command {destroy .t2}
pack .t2.quit -side bottom -pady 3 -ipadx 4 -ipady 2

frame .t2.f -height 320 -width 320
pack .t2.f -side bottom
colors .t2.f 0 0 4













Changes to tests/cmds.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
# This file is a Tcl script to test the procedures in the file
# tkCmds.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) cmds.test 1.1 96/03/14 13:25:24

if {[string compare test [info procs test]] == 1} {
    source defs
}

eval destroy [winfo child .]
wm geometry . {}
update

test cmds-1.1 {tkwait visibility, argument errors} {




|
|
<

|

|
|







1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
# This file is a Tcl script to test the procedures in the file
# tkCmds.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: cmds.test,v 1.1.4.4 1999/03/24 02:54:35 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

eval destroy [winfo child .]
wm geometry . {}
update

test cmds-1.1 {tkwait visibility, argument errors} {
37
38
39
40
41
42
43

















    frame .f
    button .f.b -text "Test"
    pack .f.b
    set x init
    after 100 {set x deleted; destroy .f}
    list [catch {tkwait visibility .f.b} msg] $msg $x
} {1 {window ".f.b" was deleted before its visibility changed} deleted}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
    frame .f
    button .f.b -text "Test"
    pack .f.b
    set x init
    after 100 {set x deleted; destroy .f}
    list [catch {tkwait visibility .f.b} msg] $msg $x
} {1 {window ".f.b" was deleted before its visibility changed} deleted}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/color.test.

1
2
3
4


5
6
7

8
9


10
11



12
13
14
15
16
17
18
19
# This file is a Tcl script to test out the procedures in the file
# tkColor.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) color.test 1.5 96/02/16 10:56:05



if {[info procs test] != "test"} {



    source defs
}

eval destroy [winfo children .]
wm geometry . {}
raise .

# cname --



|
>
>

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







1
2
3
4
5
6
7


8
9

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
# This file is a Tcl script to test out the procedures in the file
# tkColor.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995-1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: color.test,v 1.1.4.7 1999/04/06 05:20:12 rjohnson Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[info commands testcolor] != "testcolor"} {
    puts "testcolor command not available; skipping tests"
    ::tcltest::cleanupTests
    return
}

eval destroy [winfo children .]
wm geometry . {}
raise .

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


















# Create a top-level with its own colormap (so we can test under
# controlled conditions), then check to make sure that the visual
# is color-mapped with 256 colors.  If not, just skip this whole
# test file.

if [catch {toplevel .t -visual {pseudocolor 8} -colormap new}] {

    return
}
wm geom .t +0+0
if {[winfo depth .t] != 8} {
    destroy .t

    return
}
mkColors .t.c 40 6 0 0 0 0 6 0 0 0 40
pack .t.c
update
if ![colorsFree .t.c 101 233 17] {
    destroy .t

    return
}
mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
pack .t.c2
if [colorsFree .t.c] {
    destroy .t

    return
}
destroy .t.c .t.c2












































test color-1.1 {Tk_GetColor procedure} {
    c255 [winfo rgb .t red]
} {255 0 0}
test color-1.2 {Tk_GetColor procedure} {
    list [catch {winfo rgb .t noname} msg] $msg
} {1 {unknown color name "noname"}}

test color-1.3 {Tk_GetColor procedure} {
    c255 [winfo rgb .t #123456]
} {18 52 86}
test color-1.4 {Tk_GetColor procedure} {
    list [catch {winfo rgb .t #xyz} msg] $msg
} {1 {invalid color name "#xyz"}}

test color-2.1 {Tk_FreeColor procedure, reference counting} {
    eval destroy [winfo child .t]
    mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40
    pack .t.c
    mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
    pack .t.c2
    update
    set last [.t.c2 create rectangle 50 50 70 60 -outline {} \
	    -fill [cname 0 240 240]]
    .t.c delete 1
    set result [colorsFree .t]
    .t.c2 delete $last
    lappend result [colorsFree .t]
} {0 1}
test color-2.2 {Tk_FreeColor procedure, flushing stressed cmap information} {
    eval destroy [winfo child .t]
    mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40
    pack .t.c
    mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
    mkColors .t.c2 20 1 250 250 0 -10 -10 0 0 0 0
    pack .t.c2
    update
    closest .t 241 241 1
} {240 240 0}

































































destroy .t
























>





>







>






>




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

|


<
|


|



|













|









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

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

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185

186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299

# Create a top-level with its own colormap (so we can test under
# controlled conditions), then check to make sure that the visual
# is color-mapped with 256 colors.  If not, just skip this whole
# test file.

if [catch {toplevel .t -visual {pseudocolor 8} -colormap new}] {
    ::tcltest::cleanupTests
    return
}
wm geom .t +0+0
if {[winfo depth .t] != 8} {
    destroy .t
    ::tcltest::cleanupTests
    return
}
mkColors .t.c 40 6 0 0 0 0 6 0 0 0 40
pack .t.c
update
if ![colorsFree .t.c 101 233 17] {
    destroy .t
    ::tcltest::cleanupTests
    return
}
mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
pack .t.c2
if [colorsFree .t.c] {
    destroy .t
    ::tcltest::cleanupTests
    return
}
destroy .t.c .t.c2

test color-1.1 {Tk_AllocColorFromObj - converting internal reps} {
    set x green
    lindex $x 0
    destroy .b1
    button .b1 -foreground $x -text .b1
    lindex $x 0
    testcolor green
} {{1 0}}
test color-1.2 {Tk_AllocColorFromObj - discard stale color} {
    set x green
    destroy .b1 .b2
    button .b1 -foreground $x -text First
    destroy .b1
    set result {}
    lappend result [testcolor green]
    button .b2 -foreground $x -text Second
    lappend result [testcolor green]
} {{} {{1 1}}}
test color-1.3 {Tk_AllocColorFromObj - reuse existing color} {
    set x green
    destroy .b1 .b2
    button .b1 -foreground $x -text First
    set result {}
    lappend result [testcolor green]
    button .b2 -foreground $x -text Second
    pack .b1 .b2 -side top
    lappend result [testcolor green]
} {{{1 1}} {{2 1}}}
test color-1.4 {Tk_AllocColorFromObj - try other colors in list} {
    set x purple
    destroy .b1 .b2 .t.b
    button .b1 -foreground $x -text First
    pack .b1 -side top
    set result {}
    lappend result [testcolor purple]
    button .t.b -foreground $x -text Second
    pack .t.b -side top
    lappend result [testcolor purple]
    button .b2 -foreground $x -text Third
    pack .b2 -side top
    lappend result [testcolor purple]
} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}}

test color-2.1 {Tk_GetColor procedure} {
    c255 [winfo rgb .t #FF0000]
} {255 0 0}
test color-2.2 {Tk_GetColor procedure} {
    list [catch {winfo rgb .t noname} msg] $msg
} {1 {unknown color name "noname"}}

test color-2.3 {Tk_GetColor procedure} {
    c255 [winfo rgb .t #123456]
} {18 52 86}
test color-2.4 {Tk_GetColor procedure} {
    list [catch {winfo rgb .t #xyz} msg] $msg
} {1 {invalid color name "#xyz"}}

test color-3.1 {Tk_FreeColor procedure, reference counting} {
    eval destroy [winfo child .t]
    mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40
    pack .t.c
    mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
    pack .t.c2
    update
    set last [.t.c2 create rectangle 50 50 70 60 -outline {} \
	    -fill [cname 0 240 240]]
    .t.c delete 1
    set result [colorsFree .t]
    .t.c2 delete $last
    lappend result [colorsFree .t]
} {0 1}
test color-3.2 {Tk_FreeColor procedure, flushing stressed cmap information} {
    eval destroy [winfo child .t]
    mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40
    pack .t.c
    mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
    mkColors .t.c2 20 1 250 250 0 -10 -10 0 0 0 0
    pack .t.c2
    update
    closest .t 241 241 1
} {240 240 0}
test color-3.3 {Tk_FreeColorFromObj - reference counts} {
    set x purple
    destroy .b1 .b2 .t.b
    button .b1 -foreground $x -text First
    pack .b1 -side top
    button .t.b -foreground $x -text Second
    pack .t.b -side top
    button .b2 -foreground $x -text Third
    pack .b2 -side top
    set result {}
    lappend result [testcolor purple]
    destroy .b1
    lappend result [testcolor purple]
    destroy .b2
    lappend result [testcolor purple]
    destroy .t.b
    lappend result [testcolor purple]
} {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}}
test color-3.4 {Tk_FreeColorFromObj - unlinking from list} {
    destroy .b .t.b .t2 .t3
    toplevel .t2 -visual {pseudocolor 8} -colormap new
    toplevel .t3 -visual {pseudocolor 8} -colormap new
    set x purple
    button .b -foreground $x -text .b1
    button .t.b1 -foreground $x -text .t.b1
    button .t.b2 -foreground $x -text .t.b2
    button .t2.b1 -foreground $x -text .t2.b1
    button .t2.b2 -foreground $x -text .t2.b2
    button .t2.b3 -foreground $x -text .t2.b3
    button .t3.b1 -foreground $x -text .t3.b1
    button .t3.b2 -foreground $x -text .t3.b2
    button .t3.b3 -foreground $x -text .t3.b3
    button .t3.b4 -foreground $x -text .t3.b4
    set result {}
    lappend result [testcolor purple]
    destroy .t2
    lappend result [testcolor purple]
    destroy .b
    lappend result [testcolor purple]
    destroy .t3
    lappend result [testcolor purple]
    destroy .t
    lappend result [testcolor purple]
} {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}

test color-4.1 {FreeColorObjProc} {
    destroy .b
    set x [format purple]
    button .b -foreground $x -text .b1
    set y [format purple]
    .b configure -foreground $y
    set z [format purple]
    .b configure -foreground $z
    set result {}
    lappend result [testcolor purple]
    set x red
    lappend result [testcolor purple]
    set z 32
    lappend result [testcolor purple]
    destroy .b
    lappend result [testcolor purple]
    set y bogus
    set result
} {{{1 3}} {{1 2}} {{1 1}} {}}

destroy .t

# cleanup
::tcltest::cleanupTests
return













Added tests/config.test.















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
# This file is a Tcl script to test the procedures in tkConfig.c,
# which comprise the new new option configuration system.  It is
# organized in the standard "white-box" fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: config.test,v 1.1.2.7 1999/03/26 19:14:47 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[info command testobjconfig] != "testobjconfig"} {
    puts "This application hasn't been compiled with the \"testobjconfig\""
    puts "command, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    ::tcltest::cleanupTests
    return
}

proc killTables {} {
    # Note: it's important to delete chain2 before chain1, because
    # chain2 depends on chain1.  If chain1 is deleted first, the
    # delete of chain2 will crash.

    foreach t {alltypes chain2 chain1 configerror internal new notenoughparams
	    twowindows} {
	while {[testobjconfig info $t] != ""} {
	    testobjconfig delete $t
	}
    }
}

foreach i [winfo children .] {
    destroy $i
}
killTables
wm geometry . {}
raise .

test config-1.1 {Tk_CreateOptionTable - reference counts} {
    eval destroy [winfo children .]
    killTables
    set x {}
    testobjconfig alltypes .a
    lappend x [testobjconfig info alltypes]
    testobjconfig alltypes .b
    lappend x [testobjconfig info alltypes]
    eval destroy [winfo children .]
    set x
} {{1 15 -boolean} {2 15 -boolean}}
test config-1.2 {Tk_CreateOptionTable - synonym initialization} {
    eval destroy [winfo children .]
    testobjconfig alltypes .a -synonym green
    .a cget -color
} {green}
test config-1.3 {Tk_CreateOptionTable - option database initialization} {
    eval destroy [winfo children .]
    option clear
    testobjconfig alltypes .a
    option add *b.string different
    testobjconfig alltypes .b
    list [.a cget -string] [.b cget -string]
} {foo different}
test config-1.4 {Tk_CreateOptionTable - option database initialization} {
    eval destroy [winfo children .]
    option clear
    testobjconfig alltypes .a
    option add *b.String bar
    testobjconfig alltypes .b
    list [.a cget -string] [.b cget -string]
} {foo bar}
test config-1.5 {Tk_CreateOptionTable - default initialization} {
    eval destroy [winfo children .]
    testobjconfig alltypes .a
    .a cget -relief
} {raised}
test config-1.6 {Tk_CreateOptionTable - chained tables} {
    eval destroy [winfo children .]
    killTables
    testobjconfig chain1 .a
    testobjconfig chain2 .b
    testobjconfig info chain2
} {1 4 -three 2 2 -one}
test config-1.7 {Tk_CreateOptionTable - chained tables} {
    eval destroy [winfo children .]
    killTables
    testobjconfig chain2 .b
    testobjconfig chain1 .a
    testobjconfig info chain2
} {1 4 -three 2 2 -one}
test config-1.8 {Tk_CreateOptionTable - chained tables} {
    eval destroy [winfo children .]
    testobjconfig chain1 .a
    testobjconfig chain2 .b
    list [catch {.a cget -four} msg] $msg [.a cget -one] \
	    [.b cget -four] [.b cget -one]
} {1 {unknown option "-four"} one four one}

test config-2.1 {Tk_DeleteOptionTable - reference counts} {
    eval destroy [winfo children .]
    killTables
    testobjconfig chain1 .a
    testobjconfig chain2 .b
    testobjconfig chain2 .c
    eval destroy [winfo children .]
    set x {}
    testobjconfig delete chain2
    lappend x [testobjconfig info chain2] [testobjconfig info chain1]
    testobjconfig delete chain2
    lappend x [testobjconfig info chain2] [testobjconfig info chain1]
} {{1 4 -three 2 2 -one} {2 2 -one} {} {1 2 -one}}

# No tests for DestroyOptionHashTable; couldn't figure out how to test.

test config-3.1 {Tk_InitOptions - priority of chained tables} {
    eval destroy [winfo children .]
    testobjconfig chain1 .a
    testobjconfig chain2 .b
    list [.a cget -two] [.b cget -two]
} {two {two and a half}}
test config-3.2 {Tk_InitOptions - initialize from database} {
    eval destroy [winfo children .]
    option clear
    option add *a.color blue
    testobjconfig alltypes .a
    list [.a cget -color]
} {blue}
test config-3.3 {Tk_InitOptions - initialize from database} {
    eval destroy [winfo children .]
    option clear
    option add *a.justify bogus
    testobjconfig alltypes .a
    list [.a cget -justify]
} {left}
test config-3.4 {Tk_InitOptions - initialize from widget class} {
    eval destroy [winfo children .]
    testobjconfig alltypes .a
    list [.a cget -color]
} {red}
test config-3.5 {Tk_InitOptions - no initial value} {
    eval destroy [winfo children .]
    testobjconfig alltypes .a
    .a cget -anchor
} {}
test config-3.6 {Tk_InitOptions - bad initial value} {
    eval destroy [winfo children .]
    option clear
    option add *a.color non-existent
    list [catch {testobjconfig alltypes .a} msg] $msg $errorInfo
} {1 {unknown color name "non-existent"} {unknown color name "non-existent"
    (database entry for "-color" in widget ".a")
    invoked from within
"testobjconfig alltypes .a"}}
option clear
test config-3.7 {Tk_InitOptions - bad initial value} {
    eval destroy [winfo children .]
    list [catch {testobjconfig configerror} msg] $msg $errorInfo
} {1 {expected integer but got "bogus"} {expected integer but got "bogus"
    (default value for "-int")
    invoked from within
"testobjconfig configerror"}}
option clear

test config-4.1 {DoObjConfig - boolean} {
    catch {rename .foo {}}
    list [catch {testobjconfig alltypes .foo -boolean 0} msg] $msg [catch {.foo cget -boolean} result] $result [catch {rename .foo {}}]
} {0 .foo 0 0 0}
test config-4.2 {DoObjConfig - boolean} {
    catch {rename .foo {}}
    list [catch {testobjconfig alltypes .foo -boolean 1} msg] $msg [catch {.foo cget -boolean} result] $result [catch {rename .foo {}}]
} {0 .foo 0 1 0}
test config-4.3 {DoObjConfig - invalid boolean} {
    catch {rename .foo {}}
    list [catch {testobjconfig alltypes .foo -boolean {}} msg] $msg
} {1 {expected boolean value but got ""}}
test config-4.4 {DoObjConfig - boolean internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -boolean 0
    .foo cget -boolean
} {0}
test config-4.5 {DoObjConfig - integer} {
    catch {rename .foo {}}
    list [catch {testobjconfig alltypes .foo -integer 3} msg] $msg [catch {.foo cget -integer} result] $result [catch {rename .foo {}}]
} {0 .foo 0 3 0}
test config-4.6 {DoObjConfig - invalid integer} {
    catch {rename .foo {}}
    list [catch {testobjconfig alltypes .foo -integer bar} msg] $msg
} {1 {expected integer but got "bar"}}
test config-4.7 {DoObjConfig - integer internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -integer 421
    .foo cget -integer
} {421}
test config-4.8 {DoObjConfig - double} {
    catch {rename .foo {}}
    list [catch {testobjconfig alltypes .foo -double 3.14} msg] $msg [catch {.foo cget -double} result] $result [catch {rename .foo {}}]
} {0 .foo 0 3.14 0}
test config-4.9 {DoObjConfig - invalid double} {
    catch {rename .foo {}}
    list [catch {testobjconfig alltypes .foo -double bar} msg] $msg
} {1 {expected floating-point number but got "bar"}}
test config-4.10 {DoObjConfig - double internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -double 62.75
    .foo cget -double
} {62.75}
test config-4.11 {DoObjConfig - string} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -string test} msg] $msg [catch {.foo cget -string} result] $result [destroy .foo]
} {0 .foo 0 test {}}
test config-4.12 {DoObjConfig - null string} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -string {}} msg] $msg [catch {.foo cget -string} result] $result [destroy .foo]
} {0 .foo 0 {} {}}
test config-4.13 {DoObjConfig - string internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -string "this is a test"
    .foo cget -string
} {this is a test}
test config-4.14 {DoObjConfig - string table} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -stringtable two} msg] $msg [catch {.foo cget -stringtable} result] $result [destroy .foo]
} {0 .foo 0 two {}}
test config-4.15 {DoObjConfig - invalid string table} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -stringtable foo} msg] $msg
} {1 {bad stringtable "foo": must be one, two, three, or four}}
test config-4.16 {DoObjConfig - new string table} {
    catch {destroy .foo}
    testobjconfig alltypes .foo -stringtable two
    list [catch {.foo configure -stringtable three} msg] $msg [catch {.foo cget -stringtable} result] $result [destroy .foo]
} {0 16 0 three {}}
test config-4.17 {DoObjConfig - stringtable internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -stringtable "four"
    .foo cget -stringtable
} {four}
test config-4.18 {DoObjConfig - color} {
    catch {rename .foo {}}
    list [catch {testobjconfig alltypes .foo -color blue} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo]
} {0 .foo 0 blue {}}
test config-4.19 {DoObjConfig - invalid color} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -color xxx} msg] $msg
} {1 {unknown color name "xxx"}}
test config-4.20 {DoObjConfig - color internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -color purple
    .foo cget -color
} {purple}
test config-4.21 {DoObjConfig - null color} {
    catch {rename .foo {}}
    list [catch {testobjconfig alltypes .foo -color {}} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo]
} {0 .foo 0 {} {}}
test config-4.22 {DoObjConfig - getting rid of old color} {
    catch {destroy .foo}
    testobjconfig alltypes .foo -color #333333
    list [catch {.foo configure -color #444444} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo]
} {0 32 0 #444444 {}}
test config-4.23 {DoObjConfig - font} {
    catch {rename .foo {}}
    list [catch {testobjconfig alltypes .foo -font {Helvetica 72}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo]
} {0 .foo 0 {Helvetica 72} {}}
test config-4.24 {DoObjConfig - new font} {
    catch {rename .foo {}}
    testobjconfig alltypes .foo -font {Courier 12}
    list [catch {.foo configure -font {Helvetica 72}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo]
} {0 64 0 {Helvetica 72} {}}
test config-4.25 {DoObjConfig - invalid font} {
    catch {rename .foo {}}
    list [catch {testobjconfig alltypes .foo -font {Helvetica 12 foo}} msg] $msg
} {1 {unknown font style "foo"}}
test config-4.26 {DoObjConfig - null font} {
    catch {rename .foo {}}
    list [catch {testobjconfig alltypes .foo -font {}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo]
} {0 .foo 0 {} {}}
test config-4.27 {DoObjConfig - font internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -font {Times 16}
    .foo cget -font
} {Times 16}
test config-4.28 {DoObjConfig - bitmap} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -bitmap gray75} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo]
} {0 .foo 0 gray75 {}}
test config-4.29 {DoObjConfig - new bitmap} {
    catch {destroy .foo}
    testobjconfig alltypes .foo -bitmap gray75
    list [catch {.foo configure -bitmap gray50} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo]
} {0 128 0 gray50 {}}
test config-4.30 {DoObjConfig - invalid bitmap} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -bitmap foo} msg] $msg
} {1 {bitmap "foo" not defined}}
test config-4.31 {DoObjConfig - null bitmap} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -bitmap {}} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo]
} {0 .foo 0 {} {}}
test config-4.32 {DoObjConfig - bitmap internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -bitmap gray25
    .foo cget -bitmap
} {gray25}
test config-4.33 {DoObjConfig - border} {
    catch {rename .foo {}}
    list [catch {testobjconfig alltypes .foo -border green} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo]
} {0 .foo 0 green {}}
test config-4.34 {DoObjConfig - invalid border} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -border xxx} msg] $msg
} {1 {unknown color name "xxx"}}
test config-4.35 {DoObjConfig - null border} {
    catch {rename .foo {}}
    list [catch {testobjconfig alltypes .foo -border {}} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo]
} {0 .foo 0 {} {}}
test config-4.36 {DoObjConfig - border internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -border #123456
    .foo cget -border
} {#123456}
test config-4.37 {DoObjConfig - getting rid of old border} {
    catch {destroy .foo}
    testobjconfig alltypes .foo -border #333333
    list [catch {.foo configure -border #444444} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo]
} {0 256 0 #444444 {}}
test config-4.38 {DoObjConfig - relief} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -relief flat} msg] $msg [catch {.foo cget -relief} result] $result [destroy .foo]
} {0 .foo 0 flat {}}
test config-4.39 {DoObjConfig - invalid relief} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -relief foo} msg] $msg
} {1 {bad relief "foo": must be flat, groove, raised, ridge, solid, or sunken}}
test config-4.40 {DoObjConfig - new relief} {
    catch {destroy .foo}
    testobjconfig alltypes .foo -relief raised
    list [catch {.foo configure -relief flat} msg] $msg [catch {.foo cget -relief} result] $result [destroy .foo]
} {0 512 0 flat {}}
test config-4.41 {DoObjConfig - relief internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -relief ridge
    .foo cget -relief
} {ridge}
test config-4.42 {DoObjConfig - cursor} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -cursor arrow} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo]
} {0 .foo 0 arrow {}}
test config-4.43 {DoObjConfig - invalid cursor} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -cursor foo} msg] $msg
} {1 {bad cursor spec "foo"}}
test config-4.44 {DoObjConfig - null cursor} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -cursor {}} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo]
} {0 .foo 0 {} {}}
test config-4.45 {DoObjConfig - new cursor} {
    catch {destroy .foo}
    testobjconfig alltypes .foo -cursor xterm
    list [catch {.foo configure -cursor arrow} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo]
} {0 1024 0 arrow {}}
test config-4.46 {DoObjConfig - cursor internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -cursor watch
    .foo cget -cursor
} {watch}
test config-4.47 {DoObjConfig - justify} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -justify center} msg] $msg [catch {.foo cget -justify} result] $result [destroy .foo]
} {0 .foo 0 center {}}
test config-4.48 {DoObjConfig - invalid justify} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -justify foo} msg] $msg
} {1 {bad justification "foo": must be left, right, or center}}
test config-4.49 {DoObjConfig - new justify} {
    catch {destroy .foo}
    testobjconfig alltypes .foo -justify left
    list [catch {.foo configure -justify right} msg] $msg [catch {.foo cget -justify} result] $result [destroy .foo]
} {0 2048 0 right {}}
test config-4.50 {DoObjConfig - justify internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -justify center
    .foo cget -justify
} {center}
test config-4.51 {DoObjConfig - anchor} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -anchor center} msg] $msg [catch {.foo cget -anchor} result] $result [destroy .foo]
} {0 .foo 0 center {}}
test config-4.52 {DoObjConfig - invalid anchor} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -anchor foo} msg] $msg
} {1 {bad anchor "foo": must be n, ne, e, se, s, sw, w, nw, or center}}
test config-4.53 {DoObjConfig - new anchor} {
    catch {destroy .foo}
    testobjconfig alltypes .foo -anchor e
    list [catch {.foo configure -anchor n} msg] $msg [catch {.foo cget -anchor} result] $result [destroy .foo]
} {0 4096 0 n {}}
test config-4.54 {DoObjConfig - anchor internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -anchor sw
    .foo cget -anchor
} {sw}
test config-4.55 {DoObjConfig - pixel} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -pixel 42} msg] $msg [catch {.foo cget -pixel} result] $result [destroy .foo]
} {0 .foo 0 42 {}}
test config-4.56 {DoObjConfig - invalid pixel} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -pixel foo} msg] $msg
} {1 {bad screen distance "foo"}}
test config-4.57 {DoObjConfig - new pixel} {
    catch {destroy .foo}
    testobjconfig alltypes .foo -pixel 42m
    list [catch {.foo configure -pixel 3c} msg] $msg [catch {.foo cget -pixel} result] $result [destroy .foo]
} {0 8192 0 3c {}}
test config-4.58 {DoObjConfig - pixel internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -pixel [winfo screenmmwidth .]m
    .foo cget -pixel
} [winfo screenwidth .]
test config-4.59 {DoObjConfig - window} {
    catch {destroy .foo}
    catch {destroy .bar}
    toplevel .bar
    list [catch {testobjconfig twowindows .foo -window .bar} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo] [destroy .bar]
} {0 .foo 0 .bar {} {}}
test config-4.60 {DoObjConfig - invalid window} {
    catch {destroy .foo}
    toplevel .bar
    list [catch {testobjconfig twowindows .foo -window foo} msg] $msg [destroy .bar]
} {1 {bad window path name "foo"} {}}
test config-4.61 {DoObjConfig - null window} {
    catch {destroy .foo}
    catch {destroy .bar}
    toplevel .bar
    list [catch {testobjconfig twowindows .foo -window {}} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo]
} {0 .foo 0 {} {}}
test config-4.62 {DoObjConfig - new window} {
    catch {destroy .foo}
    catch {destroy .bar}
    catch {destroy .blamph}
    toplevel .bar
    toplevel .blamph
    testobjconfig twowindows .foo -window .bar
    list [catch {.foo configure -window .blamph} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo] [destroy .bar] [destroy .blamph]
} {0 0 0 .blamph {} {} {}}
test config-4.63 {DoObjConfig - window internal value} {
    catch {rename .foo {}}
    testobjconfig internal .foo -window .
    .foo cget -window
} {.}
test config-4.64 {DoObjConfig - releasing old values} {
    # This test doesn't generate a useful value to check; if an
    # error occurs, it will be detected only by memory checking software
    # such as Purify or Tcl's built-in checker.

    catch {rename .foo {}}
    testobjconfig alltypes .foo -string {Test string} -color yellow \
	    -font {Courier 18} -bitmap questhead -border green -cursor cross
    .foo configure -string {new string} -color brown \
	    -font {Times 8} -bitmap gray75 -border pink -cursor watch
    concat {}
} {}
test config-4.65 {DoObjConfig - releasing old values} {
    # This test doesn't generate a useful value to check; if an
    # error occurs, it will be detected only by memory checking software
    # such as Purify or Tcl's built-in checker.

    catch {rename .foo {}}
    testobjconfig internal .foo -string {Test string} -color yellow \
	    -font {Courier 18} -bitmap questhead -border green -cursor cross
    .foo configure -string {new string} -color brown \
	    -font {Times 8} -bitmap gray75 -border pink -cursor watch
    concat {}
} {}

test config-5.1 {ObjectIsEmpty - object is already string} {
    catch {destroy .foo}
    testobjconfig alltypes .foo -color [format ""]
    .foo cget -color
} {}
test config-5.2 {ObjectIsEmpty - object is already string} {
    catch {destroy .foo}
    list [catch {testobjconfig alltypes .foo -color [format " "]} msg] $msg
} {1 {unknown color name " "}}
test config-5.3 {ObjectIsEmpty - must convert back to string} {
    catch {destroy .foo}
    testobjconfig alltypes .foo -color [list]
    .foo cget -color
} {}

eval destroy [winfo children .]
testobjconfig chain2 .a
testobjconfig alltypes .b
test config-6.1 {GetOptionFromObj - cached answer} {
    list [.a cget -three] [.a cget -three]
} {three three}
test config-6.2 {GetOptionFromObj - exact match} {
    .a cget -one
} {one}
test config-6.3 {GetOptionFromObj - abbreviation} {
    .a cget -fo
} {four}
test config-6.4 {GetOptionFromObj - ambiguous abbreviation} {
    list [catch {.a cget -on} msg] $msg
} {1 {unknown option "-on"}}
test config-6.5 {GetOptionFromObj - duplicate options in different tables} {
    .a cget -tw
} {two and a half}
test config-6.6 {GetOptionFromObj - synonym} {
    .b cget -synonym
} {red}

eval destroy [winfo children .]
testobjconfig alltypes .a
test config-7.1 {Tk_SetOptions - basics} {
    .a configure -color green -rel sunken
     list [.a cget -color] [.a cget -relief]
} {green sunken}
test config-7.2 {Tk_SetOptions - bogus option name} {
    list [catch {.a configure -bogus} msg] $msg
} {1 {unknown option "-bogus"}}
test config-7.3 {Tk_SetOptions - synonym} {
    .a configure -synonym blue
    .a cget -color
} {blue}
test config-7.4 {Tk_SetOptions - missing value} {
    list [catch {.a configure -color green -relief} msg] $msg [.a cget -color]
} {1 {value for "-relief" missing} green}
test config-7.5 {Tk_SetOptions - saving old values} {
    .a configure -color red -int 7 -relief raised -double 3.14159
    list [catch {.a csave -color green -int 432 -relief sunken \
	    -double 2.0 -color bogus} msg] $msg [.a cget -color] \
	    [.a cget -int] [.a cget -relief] [.a cget -double]
} {1 {unknown color name "bogus"} red 7 raised 3.14159}
test config-7.6 {Tk_SetOptions - error in DoObjConfig call} {
    list [catch {.a configure -color bogus} msg] $msg $errorInfo
} {1 {unknown color name "bogus"} {unknown color name "bogus"
    (processing "-color" option)
    invoked from within
".a configure -color bogus"}}
test config-7.7 {Tk_SetOptions - synonym name in error message} {
    list [catch {.a configure -synonym bogus} msg] $msg $errorInfo
} {1 {unknown color name "bogus"} {unknown color name "bogus"
    (processing "-synonym" option)
    invoked from within
".a configure -synonym bogus"}}
test config-7.8 {Tk_SetOptions - returning mask} {
    format %x [.a configure -color red -int 7 -relief raised -double 3.14159]
} {226}

test config-8.1 {Tk_RestoreSavedOptions - restore in proper order} {
    eval destroy [winfo children .]
    testobjconfig alltypes .a
    list [catch {.a csave -color green -color black -color blue \
	    -color #ffff00 -color #ff00ff -color bogus} msg] $msg \
	    [.a cget -color]
} {1 {unknown color name "bogus"} red}
test config-8.2 {Tk_RestoreSavedOptions - freeing object memory} {
    eval destroy [winfo children .]
    testobjconfig alltypes .a
    .a csave -color green -color black -color blue -color #ffff00 \
	    -color #ff00ff
} {32}
test config-8.3 {Tk_RestoreSavedOptions - boolean internal form} {
    eval destroy [winfo children .]
    testobjconfig internal .a
    list [catch {.a csave -boolean 0 -color bogus}] [.a cget -boolean]
} {1 1}
test config-8.4 {Tk_RestoreSavedOptions - integer internal form} {
    eval destroy [winfo children .]
    testobjconfig internal .a
    list [catch {.a csave -integer 24 -color bogus}] [.a cget -integer]
} {1 148962237}
test config-8.5 {Tk_RestoreSavedOptions - double internal form} {
    eval destroy [winfo children .]
    testobjconfig internal .a
    list [catch {.a csave -double 62.4 -color bogus}] [.a cget -double]
} {1 3.14159}
test config-8.6 {Tk_RestoreSavedOptions - string internal form} {
    eval destroy [winfo children .]
    testobjconfig internal .a
    list [catch {.a csave -string "A long string" -color bogus}] \
	    [.a cget -string]
} {1 foo}
test config-8.7 {Tk_RestoreSavedOptions - string table internal form} {
    eval destroy [winfo children .]
    testobjconfig internal .a
    list [catch {.a csave -stringtable three -color bogus}] \
	    [.a cget -stringtable]
} {1 one}
test config-8.8 {Tk_RestoreSavedOptions - color internal form} {
    eval destroy [winfo children .]
    testobjconfig internal .a
    list [catch {.a csave -color green -color bogus}] [.a cget -color]
} {1 red}
test config-8.9 {Tk_RestoreSavedOptions - font internal form} {nonPortable} {
    eval destroy [winfo children .]
    testobjconfig internal .a
    list [catch {.a csave -font {Times 12} -color bogus}] [.a cget -font]
} {1 {Helvetica 12}}
test config-8.10 {Tk_RestoreSavedOptions - bitmap internal form} {
    eval destroy [winfo children .]
    testobjconfig internal .a
    list [catch {.a csave -bitmap questhead -color bogus}] [.a cget -bitmap]
} {1 gray50}
test config-8.11 {Tk_RestoreSavedOptions - border internal form} {
    eval destroy [winfo children .]
    testobjconfig internal .a
    list [catch {.a csave -border brown -color bogus}] [.a cget -border]
} {1 blue}
test config-8.12 {Tk_RestoreSavedOptions - relief internal form} {
    eval destroy [winfo children .]
    testobjconfig internal .a
    list [catch {.a csave -relief sunken -color bogus}] [.a cget -relief]
} {1 raised}
test config-8.13 {Tk_RestoreSavedOptions - cursor internal form} {
    eval destroy [winfo children .]
    testobjconfig internal .a
    list [catch {.a csave -cursor watch -color bogus}] [.a cget -cursor]
} {1 xterm}
test config-8.14 {Tk_RestoreSavedOptions - justify internal form} {
    eval destroy [winfo children .]
    testobjconfig internal .a
    list [catch {.a csave -justify right -color bogus}] [.a cget -justify]
} {1 left}
test config-8.15 {Tk_RestoreSavedOptions - anchor internal form} {
    eval destroy [winfo children .]
    testobjconfig internal .a
    list [catch {.a csave -anchor center -color bogus}] [.a cget -anchor]
} {1 n}
test config-8.16 {Tk_RestoreSavedOptions - window internal form} {
    eval destroy [winfo children .]
    testobjconfig internal .a -window .a
    list [catch {.a csave -window .a -color bogus}] [.a cget -window]
} {1 .a}

# Most of the tests below will cause memory leakage if there is a
# problem.  This may not be evident unless the tests are run in
# conjunction with a memory usage analyzer such as Purify.

test config-9.1 {Tk_FreeConfigOptions/FreeResources - string internal form} {
    catch {destroy .foo}
    testobjconfig internal .foo
    .foo configure -string "two words"
    destroy .foo
} {}
test config-9.2 {Tk_FreeConfigOptions/FreeResources - color internal form} {
    catch {destroy .foo}
    testobjconfig internal .foo
    .foo configure -color yellow
    destroy .foo
} {}
test config-9.3 {Tk_FreeConfigOptions/FreeResources - color} {
    catch {destroy .foo}
    testobjconfig alltypes .foo
    .foo configure -color [format blue]
    destroy .foo
} {}
test config-9.4 {Tk_FreeConfigOptions/FreeResources - font internal form} {
    catch {destroy .foo}
    testobjconfig internal .foo
    .foo configure -font {Courier 20}
    destroy .foo
} {}
test config-9.5 {Tk_FreeConfigOptions/FreeResources - font} {
    catch {destroy .foo}
    testobjconfig alltypes .foo
    .foo configure -font [format {Courier 24}]
    destroy .foo
} {}
test config-9.6 {Tk_FreeConfigOptions/FreeResources - bitmap internal form} {
    catch {destroy .foo}
    testobjconfig internal .foo
    .foo configure -bitmap gray75
    destroy .foo
} {}
test config-9.7 {Tk_FreeConfigOptions/FreeResources - bitmap} {
    catch {destroy .foo}
    testobjconfig alltypes .foo
    .foo configure -bitmap [format gray75]
    destroy .foo
} {}
test config-9.8 {Tk_FreeConfigOptions/FreeResources - border internal form} {
    catch {destroy .foo}
    testobjconfig internal .foo
    .foo configure -border orange
    destroy .foo
} {}
test config-9.9 {Tk_FreeConfigOptions/FreeResources - border} {
    catch {destroy .foo}
    testobjconfig alltypes .foo
    .foo configure -border [format blue]
    destroy .foo
} {}
test config-9.10 {Tk_FreeConfigOptions/FreeResources - cursor internal form} {
    catch {destroy .foo}
    testobjconfig internal .foo
    .foo configure -cursor cross
    destroy .foo
} {}
test config-9.11 {Tk_FreeConfigOptions/FreeResources - cursor} {
    catch {destroy .foo}
    testobjconfig alltypes .foo
    .foo configure -cursor [format watch]
    destroy .foo
} {}
test config-9.12 {Tk_FreeConfigOptions/FreeResources - not special} {
    catch {destroy .foo}
    testobjconfig alltypes .foo
    .foo configure -integer [format 27]
    destroy .foo
} {}

test config-10.1 {Tk_GetOptionInfo - one item} {
    catch {destroy .foo}
    testobjconfig alltypes .foo
    .foo configure -relief groove
    .foo configure -relief
} {-relief relief Relief raised groove}
test config-10.2 {Tk_GetOptionInfo - one item, synonym} {
    catch {destroy .foo}
    testobjconfig alltypes .foo
    .foo configure -color black
    .foo configure -synonym
} {-color color Color red black}
test config-10.3 {Tk_GetOptionInfo - all items} {
    catch {destroy .foo}
    testobjconfig alltypes .foo -font {Helvetica 18} -integer 13563
    .foo configure
} {{-boolean boolean Boolean 1 1} {-integer integer Integer 7 13563} {-double double Double 3.14159 3.14159} {-string string String foo foo} {-stringtable StringTable stringTable one one} {-color color Color red red} {-font font Font {Helvetica 12} {Helvetica 18}} {-bitmap bitmap Bitmap gray50 gray50} {-border border Border blue blue} {-relief relief Relief raised raised} {-cursor cursor Cursor xterm xterm} {-justify {} {} left left} {-anchor anchor Anchor {} {}} {-pixel pixel Pixel 1 1} {-synonym -color}}
test config-10.4 {Tk_GetOptionInfo - chaining through tables} {
    catch {destroy .foo}
    testobjconfig chain2 .foo -one asdf -three xyzzy
    .foo configure
} {{-three three Three three xyzzy} {-four four Four four four} {-two two Two {two and a half} {two and a half}} {-oneAgain oneAgain OneAgain {one again} {one again}} {-one one One one asdf} {-two two Two two {two and a half}}}

eval destroy [winfo children .]
testobjconfig alltypes .a
test config-11.1 {GetConfigList - synonym} {
    lindex [.a configure] end
} {-synonym -color}
test config-11.2 {GetConfigList - null database names} {
    .a configure -justify
} {-justify {} {} left left}
test config-11.3 {GetConfigList - null default and current value} {
    .a configure -anchor
} {-anchor anchor Anchor {} {}}

eval destroy [winfo children .]
testobjconfig internal .a
test config-12.1 {GetObjectForOption - boolean} {
    .a configure -boolean 0
    .a cget -boolean
} {0}
test config-12.2 {GetObjectForOption - integer} {
    .a configure -integer 1247
    .a cget -integer
} {1247}
test config-12.3 {GetObjectForOption - double} {
    .a configure -double -88.82
    .a cget -double
} {-88.82}
test config-12.4 {GetObjectForOption - string} {
    .a configure -string "test value"
    .a cget -string
} {test value}
test config-12.5 {GetObjectForOption - stringTable} {
    .a configure -stringtable "two"
    .a cget -stringtable
} {two}
test config-12.6 {GetObjectForOption - color} {
    .a configure -color "green"
    .a cget -color
} {green}
test config-12.7 {GetObjectForOption - font} {
    .a configure -font {Times 36}
    .a cget -font
} {Times 36}
test config-12.8 {GetObjectForOption - bitmap} {
    .a configure -bitmap "questhead"
    .a cget -bitmap
} {questhead}
test config-12.9 {GetObjectForOption - border} {
    .a configure -border #33217c
    .a cget -border
} {#33217c}
test config-12.10 {GetObjectForOption - relief} {
    .a configure -relief groove
    .a cget -relief
} {groove}
test config-12.11 {GetObjectForOption - cursor} {
    .a configure -cursor watch
    .a cget -cursor
} {watch}
test config-12.12 {GetObjectForOption - justify} {
    .a configure -justify right
    .a cget -justify
} {right}
test config-12.13 {GetObjectForOption - anchor} {
    .a configure -anchor e
    .a cget -anchor
} {e}
test config-12.14 {GetObjectForOption - pixels} {
    .a configure -pixel 193.2
    .a cget -pixel
} {193}
test config-12.15 {GetObjectForOption - window} {
    .a configure -window .a
    .a cget -window
} {.a}
test config-12.16 {GetObjectForOption - null values} {
    .a configure -string {} -color {} -font {} -bitmap {} -border {} \
	    -cursor {} -window {}
    list [.a cget -string] [.a cget -color] [.a cget -font] \
	    [.a cget -string] [.a cget -bitmap] [.a cget -border] \
	    [.a cget -cursor] [.a cget -window]
} {{} {} {} {} {} {} {} {}}

# cleanup
eval destroy [winfo children .]
killTables
::tcltest::cleanupTests
return













Added tests/cursor.test.









































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
# This file is a Tcl script to test out the procedures in the file
# tkCursor.c.  It is organized in the standard white-box fashion for
# Tcl tests.
#
# Copyright (c) 1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: cursor.test,v 1.1.2.6 1999/03/26 00:07:54 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[info commands testcursor] != "testcursor"} {
    puts "testcursor command not available; skipping tests"
    ::tcltest::cleanupTests
    return
}

eval destroy [winfo children .]
wm geometry . {}
raise .

test cursor-1.1 {Tk_AllocCursorFromObj - converting internal reps} {
    set x watch
    lindex $x 0
    destroy .b1
    button .b1 -cursor $x
    lindex $x 0
    testcursor watch
} {{1 0}}
test cursor-1.2 {Tk_AllocCursorFromObj - discard stale cursor} {
    set x watch
    destroy .b1 .b2
    button .b1 -cursor $x
    destroy .b1
    set result {}
    lappend result [testcursor watch]
    button .b2 -cursor $x
    lappend result [testcursor watch]
} {{} {{1 1}}}
test cursor-1.3 {Tk_AllocCursorFromObj - reuse existing cursor} {
    set x watch
    destroy .b1 .b2
    button .b1 -cursor $x
    set result {}
    lappend result [testcursor watch]
    button .b2 -cursor $x
    pack .b1 .b2 -side top
    lappend result [testcursor watch]
} {{{1 1}} {{2 1}}}

test cursor-2.1 {Tk_GetCursor procedure} {
    destroy .b1
    list [catch {button .b1 -cursor bad_name} msg] $msg
} {1 {bad cursor spec "bad_name"}}
test cursor-2.2 {Tk_GetCursor procedure} {
    destroy .b1
    list [catch {button .b1 -cursor @xyzzy} msg] $msg
} {1 {bad cursor spec "@xyzzy"}}

test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} {
    set x arrow
    destroy .b1 .b2 .b3
    button .b1 -cursor $x
    button .b3 -cursor $x
    button .b2 -cursor $x
    set result {}
    lappend result [testcursor arrow]
    destroy .b1
    lappend result [testcursor arrow]
    destroy .b2
    lappend result [testcursor arrow]
    destroy .b3
    lappend result [testcursor arrow]
} {{{3 1}} {{2 1}} {{1 1}} {}}

test cursor-4.1 {FreeCursorObjProc} {
    destroy .b
    set x [format arrow]
    button .b -cursor $x
    set y [format arrow]
    .b configure -cursor $y
    set z [format arrow]
    .b configure -cursor $z
    set result {}
    lappend result [testcursor arrow]
    set x red
    lappend result [testcursor arrow]
    set z 32
    lappend result [testcursor arrow]
    destroy .b
    lappend result [testcursor arrow]
    set y bogus
    set result
} {{{1 3}} {{1 2}} {{1 1}} {}}

destroy .t

# cleanup
::tcltest::cleanupTests
return













Deleted tests/defs.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
# This file contains support code for the Tcl test suite.  It is
# normally sourced by the individual files in the test suite before
# they run their tests.  This improved approach to testing was designed
# and initially implemented by Mary Ann May-Pumphrey of Sun Microsystems.
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) defs 1.39 97/08/06 15:32:02

if ![info exists VERBOSE] {
    set VERBOSE 0
}
if ![info exists TESTS] {
    set TESTS {}
}

tk appname tktest
wm title . tktest

# Check configuration information that will determine which tests
# to run.  To do this, create an array testConfig.  Each element
# has a 0 or 1 value, and the following elements are defined:
#	unixOnly -	1 means this is a UNIX platform, so it's OK
#			to run tests that only work under UNIX.
#	macOnly -	1 means this is a Mac platform, so it's OK
#			to run tests that only work on Macs.
#	pcOnly -	1 means this is a PC platform, so it's OK to
#			run tests that only work on PCs.
#	unixOrPc -	1 means this is a UNIX or PC platform.
#	macOrPc -	1 means this is a Mac or PC platform.
#	macOrUnix -	1 means this is a Mac or UNIX platform.
#	nonPortable -	1 means this the tests are being running in
#			the master Tcl/Tk development environment;
#			Some tests are inherently non-portable because
#			they depend on things like word length, file system
#			configuration, window manager, etc.  These tests
#			are only run in the main Tcl development directory
#			where the configuration is well known.  The presence
#			of the file "doAllTests" in this directory indicates
#			that it is safe to run non-portable tests.
#	fonts -		1 means that this platform uses fonts with
#			well-know geometries, so it is safe to run
#			tests that depend on particular font sizes.

catch {unset testConfig}

set testConfig(unixOnly) 	[expr {$tcl_platform(platform) == "unix"}]
set testConfig(macOnly) 	[expr {$tcl_platform(platform) == "macintosh"}]
set testConfig(pcOnly)		[expr {$tcl_platform(platform) == "windows"}]

set testConfig(unix)		$testConfig(unixOnly)
set testConfig(mac)		$testConfig(macOnly)
set testConfig(pc)		$testConfig(pcOnly)

set testConfig(unixOrPc) [expr $testConfig(unixOnly) || $testConfig(pcOnly)]
set testConfig(macOrPc) [expr $testConfig(macOnly) || $testConfig(pcOnly)]
set testConfig(macOrUnix) [expr $testConfig(macOnly) || $testConfig(unixOnly)]

set testConfig(nonPortable) 	[expr [file exists doAllTests] || [file exists DOALLT~1]]

set testConfig(nt)		[expr {$tcl_platform(os) == "Windows NT"}]
set testConfig(95)		[expr {$tcl_platform(os) == "Windows 95"}]
set testConfig(win32s)		[expr {$tcl_platform(os) == "Win32s"}]

# The following config switches are used to mark tests that should work,
# but have been temporarily disabled on certain platforms because they don't.

set testConfig(tempNotPc) 	[expr !$testConfig(pc)]
set testConfig(tempNotMac) 	[expr !$testConfig(mac)]
set testConfig(tempNotUnix)	[expr !$testConfig(unix)]

# The following config switches are used to mark tests that crash on
# certain platforms, so that they can be reactivated again when the
# underlying problem is fixed.

set testConfig(pcCrash) 	[expr !$testConfig(pc)]
set testConfig(win32sCrash) 	[expr !$testConfig(win32s)]
set testConfig(macCrash) 	[expr !$testConfig(mac)]
set testConfig(unixCrash) 	[expr !$testConfig(unix)]

set testConfig(fonts) 1
catch {destroy .e}
entry .e -width 0 -font {Helvetica -12} -bd 1
.e insert end "a.bcd"
if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} {
    set testConfig(fonts) 0
}
destroy .e .t
text .t -width 80 -height 20 -font {Times -14} -bd 1
pack .t
.t insert end "This is\na dot."
update
set x [list [.t bbox 1.3] [.t bbox 2.5]]
destroy .t
if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} {
    set testConfig(fonts) 0
}

if {$testConfig(nonPortable) == 0} {
    puts "(will skip non-portable tests)"
}
if {$testConfig(fonts) == 0} {
    puts "(will skip font-sensitive tests: this system has unexpected font geometries)"
}

trace variable testConfig r safeFetch

proc safeFetch {n1 n2 op} {
    global testConfig 

    if {($n2 != {}) && ([info exists testConfig($n2)] == 0)} {
	set testConfig($n2) 0
    }
}

# If there is no "memory" command (because memory debugging isn't
# enabled), generate a dummy command that does nothing.

if {[info commands memory] == ""} {
    proc memory args {}
}

proc print_verbose {name description script code answer} {
    puts stdout "\n"
    puts stdout "==== $name $description"
    puts stdout "==== Contents of test case:"
    puts stdout "$script"
    if {$code != 0} {
	if {$code == 1} {
	    puts stdout "==== Test generated error:"
	    puts stdout $answer
	} elseif {$code == 2} {
	    puts stdout "==== Test generated return exception;  result was:"
	    puts stdout $answer
	} elseif {$code == 3} {
	    puts stdout "==== Test generated break exception"
	} elseif {$code == 4} {
	    puts stdout "==== Test generated continue exception"
	} else {
	    puts stdout "==== Test generated exception $code;  message was:"
	    puts stdout $answer
	}
    } else {
	puts stdout "==== Result was:"
	puts stdout "$answer"
    }
}

# test --
# This procedure runs a test and prints an error message if the
# test fails.  If VERBOSE has been set, it also prints a message
# even if the test succeeds.  The test will be skipped if it
# doesn't match the TESTS variable, or if one of the elements
# of "constraints" turns out not to be true.
#
# Arguments:
# name -		Name of test, in the form foo-1.2.
# description -		Short textual description of the test, to
#			help humans understand what it does.
# constraints -		A list of one or more keywords, each of
#			which must be the name of an element in
#			the array "testConfig".  If any of these
#			elements is zero, the test is skipped.
#			This argument may be omitted.
# script -		Script to run to carry out the test.  It must
#			return a result that can be checked for
#			correctness.
# answer -		Expected result from script.

proc test {name description script answer args} {
    global VERBOSE TESTS testConfig
    if {[string compare $TESTS ""] != 0} {
	set ok 0
	foreach test $TESTS {
	    if {[string match $test $name]} {
		set ok 1
		break
	    }
        }
	if {!$ok} {
	    return
	}
    }
    set i [llength $args]
    if {$i == 0} {
	# Empty body
    } elseif {$i == 1} {
	# "constraints" argument exists;  shuffle arguments down, then
	# make sure that the constraints are satisfied.

	set constraints $script
	set script $answer
	set answer [lindex $args 0]
	set doTest 0
	if {[string match {*[$\[]*} $constraints] != 0} {
	    # full expression, e.g. {$foo > [info tclversion]}

	    catch {set doTest [uplevel #0 expr $constraints]}
	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
	    # something like {a || b} should be turned into 
	    # $testConfig(a) || $testConfig(b).

 	    regsub -all {[.a-zA-Z0-9]+} $constraints {$testConfig(&)} c
	    catch {set doTest [eval expr $c]}
	} else {
	    # just simple constraints such as {unixOnly fonts}.

	    set doTest 1
	    foreach constraint $constraints {
		if {![info exists testConfig($constraint)]
			|| !$testConfig($constraint)} {
		    set doTest 0
		    break
		}
	    }
	}
	if {$doTest == 0} {
	    if {$VERBOSE} {
		puts stdout "++++ $name SKIPPED: $constraints"
	    }
	    return	
	}
    } else {
	error "wrong # args: must be \"test name description ?constraints? script answer\""
    }
    memory tag $name
    set code [catch {uplevel $script} result]
    if {$code != 0} {
	print_verbose $name $description $script $code $result
    } elseif {[string compare $result $answer] == 0} { 
	if {$VERBOSE} then {
	    if {$VERBOSE > 0} {
		print_verbose $name $description $script $code $result
	    }
	    if {$VERBOSE != -2} {
		puts stdout "++++ $name PASSED"
	    }
	}
    } else { 
	print_verbose $name $description $script $code $result 
	puts stdout "---- Result should have been:"
	puts stdout "$answer"
	puts stdout "---- $name FAILED" 
    }
}

proc dotests {file args} {
    global TESTS
    set savedTests $TESTS
    set TESTS $args
    source $file
    set TESTS $savedTests
}

# If the main window isn't already mapped (e.g. because the tests are
# being run automatically) , specify a precise size for it so that the
# user won't have to position it manually.

if {![winfo ismapped .]} {
    wm geometry . +0+0
    update
}

# The following code can be used to perform tests involving a second
# process running in the background.

# Locate tktest executable

set tktest [info nameofexecutable]
if {$tktest == "{}"} {
    set tktest {}
    puts "Unable to find tktest executable, skipping multiple process tests."
}

# Create background process

proc setupbg {{args ""}} {
    global tktest fd bgData
    if {$tktest == ""} {
        error "you're not running tktest so setupbg should not have been called"
    }
    if {[info exists fd] && ($fd != "")} {
	cleanupbg
    }
    set fd [open "|[list $tktest -geometry +0+0 -name tktest] $args" r+]
    puts $fd "puts foo; flush stdout"
    flush $fd
    if {[gets $fd data] < 0} {
        error "unexpected EOF from \"$tktest\""
    }
    if [string compare $data foo] {
        error "unexpected output from background process \"$data\""
    }
    fileevent $fd readable bgReady
}

# Send a command to the background process, catching errors and
# flushing I/O channels
proc dobg {command} {
    global fd bgData bgDone
    puts $fd "catch [list $command] msg; update; puts \$msg; puts **DONE**; flush stdout"
    flush $fd
    set bgDone 0
    set bgData {}
    tkwait variable bgDone
    set bgData
}

# Data arrived from background process.  Check for special marker
# indicating end of data for this command, and make data available
# to dobg procedure.
proc bgReady {} {
    global fd bgData bgDone
    set x [gets $fd]
    if [eof $fd] {
	fileevent $fd readable {}
	set bgDone 1
    } elseif {$x == "**DONE**"} {
	set bgDone 1
    } else {
	append bgData $x
    }
}

# Exit the background process, and close the pipes
proc cleanupbg {} {
    global fd
    catch {
	puts $fd "exit"
	close $fd
    }
    set fd ""
}

# Clean up focus after using generate event, which
# can leave the window manager with the wrong impression
# about who thinks they have the focus. (BW)

proc fixfocus {} {
    catch {destroy .focus}
    toplevel .focus
    wm geometry .focus +0+0
    entry .focus.e
    .focus.e insert 0 "fixfocus"
    pack .focus.e
    update
    focus -force .focus.e
    destroy .focus
}

proc makeFile {contents name} {
    set fd [open $name w]
    fconfigure $fd -translation lf
    if {[string index $contents [expr [string length $contents] - 1]] == "\n"} {
	puts -nonewline $fd $contents
    } else {
	puts $fd $contents
    }
    close $fd
}

proc removeFile {name} {
    file delete -- $name
}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<






























































































































































































































































































































































































































































































































































































































































































































































Added tests/defs.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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
# defs.tcl --
#
#	This file contains support code for the Tcl/Tk test suite.It is
#	It is normally sourced by the individual files in the test suite
#	before they run their tests.  This improved approach to testing
#	was designed and initially implemented by Mary Ann May-Pumphrey
#	of Sun Microsystems.
#
# Copyright (c) 1990-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
# 
# RCS: @(#) $Id: defs.tcl,v 1.1.2.11 1999/04/07 01:59:49 hershey Exp $

# Initialize wish shell
if {[info exists tk_version]} {
    tk appname tktest
    wm title . tktest
} else {
    # Ensure that we have a minimal auto_path so we don't pick up extra junk.
    set auto_path [list [info library]]
}

# create the "tcltest" namespace for all testing variables and procedures
namespace eval tcltest {
    set procList [list test cleanupTests dotests saveState restoreState \
	    normalizeMsg makeFile removeFile makeDirectory removeDirectory \
	    viewFile bytestring set_iso8859_1_locale restore_locale \
	    safeFetch]
    if {[info exists tk_version]} {
	lappend procList setupbg dobg bgReady cleanupbg fixfocus
    }
    foreach proc $procList {
	namespace export $proc
    }

    # ::tcltest::verbose defaults to "b"
    variable verbose "b"

    # match defaults to the empty list
    variable match {}

    # skip defaults to the empty list
    variable skip {}

    # Tests should not rely on the current working directory.
    # Files that are part of the test suite should be accessed relative to
    # ::tcltest::testsDir.

    set originalDir [pwd]
    set tDir [file join $originalDir [file dirname [info script]]]
    cd $tDir
    variable testsDir [pwd]
    cd $originalDir

    # Count the number of files tested (0 if all.tcl wasn't called).
    # The all.tcl file will set testSingleFile to false, so stats will
    # not be printed until all.tcl calls the cleanupTests proc.
    # The currentFailure var stores the boolean value of whether the
    # current test file has had any failures.  The failFiles list
    # stores the names of test files that had failures.

    variable numTestFiles 0
    variable testSingleFile true
    variable currentFailure false
    variable failFiles {}

    # Tests should remove all files they create.  The test suite will
    # check the current working dir for files created by the tests.
    # ::tcltest::filesMade keeps track of such files created using the
    # ::tcltest::makeFile and ::tcltest::makeDirectory procedures.
    # ::tcltest::filesExisted stores the names of pre-existing files.

    variable filesMade {}
    variable filesExisted {}

    # ::tcltest::numTests will store test files as indices and the list
    # of files (that should not have been) left behind by the test files.
    array set ::tcltest::createdNewFiles {}

    # initialize ::tcltest::numTests array to keep track fo the number of
    # tests that pass, fial, and are skipped.
    array set numTests [list Total 0 Passed 0 Skipped 0 Failed 0]

    # initialize ::tcltest::skippedBecause array to keep track of
    # constraints that kept tests from running
    array set ::tcltest::skippedBecause {}
}

# If there is no "memory" command (because memory debugging isn't
# enabled), generate a dummy command that does nothing.

if {[info commands memory] == ""} {
    proc memory args {}
}

# ::tcltest::initConfig --
#
# Check configuration information that will determine which tests
# to run.  To do this, create an array ::tcltest::testConfig.  Each
# element has a 0 or 1 value.  If the element is "true" then tests
# with that constraint will be run, otherwise tests with that constraint
# will be skipped.  See the README file for the list of built-in
# constraints defined in this procedure.
#
# Arguments:
#	none
#
# Results:
#	The ::tcltest::testConfig array is reset to have an index for
#	each built-in test constraint.

proc ::tcltest::initConfig {} {

    global tcl_platform tcl_interactive tk_version

    catch {unset ::tcltest::testConfig}

    # The following trace procedure makes it so that we can safely refer to
    # non-existent members of the ::tcltest::testConfig array without causing an
    # error.  Instead, reading a non-existent member will return 0.  This is
    # necessary because tests are allowed to use constraint "X" without ensuring
    # that ::tcltest::testConfig("X") is defined.

    trace variable ::tcltest::testConfig r ::tcltest::safeFetch

    proc ::tcltest::safeFetch {n1 n2 op} {
	if {($n2 != {}) && ([info exists ::tcltest::testConfig($n2)] == 0)} {
	    set ::tcltest::testConfig($n2) 0
	}
    }

    set ::tcltest::testConfig(unixOnly) \
	    [expr {$tcl_platform(platform) == "unix"}]
    set ::tcltest::testConfig(macOnly) \
	    [expr {$tcl_platform(platform) == "macintosh"}]
    set ::tcltest::testConfig(pcOnly) \
	    [expr {$tcl_platform(platform) == "windows"}]

    set ::tcltest::testConfig(unix) $::tcltest::testConfig(unixOnly)
    set ::tcltest::testConfig(mac) $::tcltest::testConfig(macOnly)
    set ::tcltest::testConfig(pc) $::tcltest::testConfig(pcOnly)

    set ::tcltest::testConfig(unixOrPc) \
	    [expr {$::tcltest::testConfig(unix) || $::tcltest::testConfig(pc)}]
    set ::tcltest::testConfig(macOrPc) \
	    [expr {$::tcltest::testConfig(mac) || $::tcltest::testConfig(pc)}]
    set ::tcltest::testConfig(macOrUnix) \
	    [expr {$::tcltest::testConfig(mac) || $::tcltest::testConfig(unix)}]

    set ::tcltest::testConfig(nt) [expr {$tcl_platform(os) == "Windows NT"}]
    set ::tcltest::testConfig(95) [expr {$tcl_platform(os) == "Windows 95"}]

    # The following config switches are used to mark tests that should work,
    # but have been temporarily disabled on certain platforms because they don't
    # and we haven't gotten around to fixing the underlying problem.

    set ::tcltest::testConfig(tempNotPc) [expr {!$::tcltest::testConfig(pc)}]
    set ::tcltest::testConfig(tempNotMac) [expr {!$::tcltest::testConfig(mac)}]
    set ::tcltest::testConfig(tempNotUnix) [expr {!$::tcltest::testConfig(unix)}]

    # The following config switches are used to mark tests that crash on
    # certain platforms, so that they can be reactivated again when the
    # underlying problem is fixed.

    set ::tcltest::testConfig(pcCrash) [expr {!$::tcltest::testConfig(pc)}]
    set ::tcltest::testConfig(macCrash) [expr {!$::tcltest::testConfig(mac)}]
    set ::tcltest::testConfig(unixCrash) [expr {!$::tcltest::testConfig(unix)}]

    # Set the "fonts" constraint for wish apps
    if {[info exists tk_version]} {
	set ::tcltest::testConfig(fonts) 1
	catch {destroy .e}
	entry .e -width 0 -font {Helvetica -12} -bd 1
	.e insert end "a.bcd"
	if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} {
	    set ::tcltest::testConfig(fonts) 0
	}
	destroy .e
	catch {destroy .t}
	text .t -width 80 -height 20 -font {Times -14} -bd 1
	pack .t
	.t insert end "This is\na dot."
	update
	set x [list [.t bbox 1.3] [.t bbox 2.5]]
	destroy .t
	if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} {
	    set ::tcltest::testConfig(fonts) 0
	}
    }

    # Skip empty tests
    set ::tcltest::testConfig(emptyTest) 0

    # By default, tests that expost known bugs are skipped.
    set ::tcltest::testConfig(knownBug) 0

    # By default, non-portable tests are skipped.
    set ::tcltest::testConfig(nonPortable) 0

    # Some tests require user interaction.
    set ::tcltest::testConfig(userInteraction) 0

    # Some tests must be skipped if the interpreter is not in interactive mode
    set ::tcltest::testConfig(interactive) $tcl_interactive

    # Some tests must be skipped if you are running as root on Unix.
    # Other tests can only be run if you are running as root on Unix.
    set ::tcltest::testConfig(root) 0
    set ::tcltest::testConfig(notRoot) 1
    set user {}
    if {$tcl_platform(platform) == "unix"} {
	catch {set user [exec whoami]}
	if {$user == ""} {
	    catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
	}
	if {($user == "root") || ($user == "")} {
	    set ::tcltest::testConfig(root) 1
	    set ::tcltest::testConfig(notRoot) 0
	}
    }

    # Set nonBlockFiles constraint: 1 means this platform supports
    # setting files into nonblocking mode.
    if {[catch {set f [open defs r]}]} {
	set ::tcltest::testConfig(nonBlockFiles) 1
    } else {
	if {[catch {fconfigure $f -blocking off}] == 0} {
	    set ::tcltest::testConfig(nonBlockFiles) 1
	} else {
	    set ::tcltest::testConfig(nonBlockFiles) 0
	}
	close $f
    }

    # Set asyncPipeClose constraint: 1 means this platform supports
    # async flush and async close on a pipe.
    #
    # Test for SCO Unix - cannot run async flushing tests because a
    # potential problem with select is apparently interfering.
    # (Mark Diekhans).
    if {$tcl_platform(platform) == "unix"} {
	if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} {
	    set ::tcltest::testConfig(asyncPipeClose) 0
	} else {
	    set ::tcltest::testConfig(asyncPipeClose) 1
	}
    } else {
	set ::tcltest::testConfig(asyncPipeClose) 1
    }

    # Test to see if we have a broken version of sprintf with respect
    # to the "e" format of floating-point numbers.
    set ::tcltest::testConfig(eformat) 1
    if {[string compare "[format %g 5e-5]" "5e-05"] != 0} {
	set ::tcltest::testConfig(eformat) 0
    }

    # Test to see if execed commands such as cat, echo, rm and so forth are
    # present on this machine.
    set ::tcltest::testConfig(unixExecs) 1
    if {$tcl_platform(platform) == "macintosh"} {
	set ::tcltest::testConfig(unixExecs) 0
    }
    if {($::tcltest::testConfig(unixExecs) == 1) && \
	    ($tcl_platform(platform) == "windows")} {
	if {[catch {exec cat defs}] == 1} {
	    set ::tcltest::testConfig(unixExecs) 0
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec echo hello}] == 1)} {
	    set ::tcltest::testConfig(unixExecs) 0
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec sh -c echo hello}] == 1)} {
	    set ::tcltest::testConfig(unixExecs) 0
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec wc defs}] == 1)} {
	    set ::tcltest::testConfig(unixExecs) 0
	}
	if {$::tcltest::testConfig(unixExecs) == 1} {
	    exec echo hello > removeMe
	    if {[catch {exec rm removeMe}] == 1} {
		set ::tcltest::testConfig(unixExecs) 0
	    }
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec sleep 1}] == 1)} {
	    set ::tcltest::testConfig(unixExecs) 0
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec fgrep unixExecs defs}] == 1)} {
	    set ::tcltest::testConfig(unixExecs) 0
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec ps}] == 1)} {
	    set ::tcltest::testConfig(unixExecs) 0
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec echo abc > removeMe}] == 0) && \
		([catch {exec chmod 644 removeMe}] == 1) && \
		([catch {exec rm removeMe}] == 0)} {
	    set ::tcltest::testConfig(unixExecs) 0
	} else {
	    catch {exec rm -f removeMe}
	}
	if {($::tcltest::testConfig(unixExecs) == 1) && \
		([catch {exec mkdir removeMe}] == 1)} {
	    set ::tcltest::testConfig(unixExecs) 0
	} else {
	    catch {exec rm -r removeMe}
	}
    }
}

::tcltest::initConfig


# ::tcltest::processCmdLineArgs --
#
#	Use command line args to set the verbose, skip, and
#	match variables.  This procedure must be run after
#	constraints are initialized, because some constraints can be
#	overridden.
#
# Arguments:
#	none
#
# Results:
#	::tcltest::verbose is set to <value>

proc ::tcltest::processCmdLineArgs {} {
    global argv

    # The "argv" var doesn't exist in some cases, so use {}
    # The "argv" var doesn't exist in some cases.
    if {(![info exists argv]) || ([llength $argv] < 2)} {
	set flagArray {}
    } else {
	set flagArray $argv
    }

    if {[catch {array set flag $flagArray}]} {
	puts stderr "Error:  odd number of command line args specified:"
	puts stderr "        $argv"
	exit
    }
    
    # Allow for 1-char abbreviations, where applicable (e.g., -match == -m).
    # Note that -verbose cannot be abbreviated to -v in wish because it
    # conflicts with the wish option -visual.
    foreach arg {-verbose -match -skip -constraints} {
	set abbrev [string range $arg 0 1]
	if {([info exists flag($abbrev)]) && \
		([lsearch -exact $flagArray $arg] < \
		[lsearch -exact $flagArray $abbrev])} {
	    set flag($arg) $flag($abbrev)
	}
    }

    # Set ::tcltest::workingDir to [pwd].
    # Save the names of files that already exist in ::tcltest::workingDir.
    set ::tcltest::workingDir [pwd]
    foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] {
	lappend ::tcltest::filesExisted [file tail $file]
    }

    # Set ::tcltest::verbose to the arg of the -verbose flag, if given
    if {[info exists flag(-verbose)]} {
	set ::tcltest::verbose $flag(-verbose)
    }

    # Set ::tcltest::match to the arg of the -match flag, if given
    if {[info exists flag(-match)]} {
	set ::tcltest::match $flag(-match)
    }

    # Set ::tcltest::skip to the arg of the -skip flag, if given
    if {[info exists flag(-skip)]} {
	set ::tcltest::skip $flag(-skip)
    }

    # Use the -constraints flag, if given, to turn on constraints that are
    # turned off by default: userInteractive knownBug nonPortable.  This
    # code fragment must be run after constraints are initialized.
    if {[info exists flag(-constraints)]} {
	foreach elt $flag(-constraints) {
	    set ::tcltest::testConfig($elt) 1
	}
    }
}

::tcltest::processCmdLineArgs


# ::tcltest::cleanupTests --
#
# Remove files and dirs created using the makeFile and makeDirectory
# commands since the last time this proc was invoked.
#
# Print the names of the files created without the makeFile command
# since the tests were invoked.
#
# Print the number tests (total, passed, failed, and skipped) since the
# tests were invoked.
#

proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
    set tail [file tail [info script]]

    # Remove files and directories created by the :tcltest::makeFile and
    # ::tcltest::makeDirectory procedures.
    # Record the names of files in ::tcltest::workingDir that were not
    # pre-existing, and associate them with the test file that created them.
    if {!$calledFromAllFile} {

	foreach file $::tcltest::filesMade {
	    if {[file exists $file]} {
		catch {file delete -force $file}
	    }
	}
	set currentFiles {}
	foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] {
	    lappend currentFiles [file tail $file]
	}
	set newFiles {}
	foreach file $currentFiles {
	    if {[lsearch -exact $::tcltest::filesExisted $file] == -1} {
		lappend newFiles $file
	    }
	}
	set ::tcltest::filesExisted $currentFiles
	if {[llength $newFiles] > 0} {
	    set ::tcltest::createdNewFiles($tail) $newFiles
	}
    }

    if {$calledFromAllFile || $::tcltest::testSingleFile} {
	# print stats
	puts -nonewline stdout "$tail:"
	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
	    puts -nonewline stdout "\t$index\t$::tcltest::numTests($index)"
	}
	puts stdout ""

	# print number test files sourced
	# print names of files that ran tests which failed
	if {$calledFromAllFile} {
	    puts stdout "Sourced $::tcltest::numTestFiles Test Files."
	    set ::tcltest::numTestFiles 0
	    if {[llength $::tcltest::failFiles] > 0} {
		puts stdout "Files with failing tests: $::tcltest::failFiles"
		set ::tcltest::failFiles {}
	    }
	}

	# if any tests were skipped, print the constraints that kept them
	# from running.
	set constraintList [array names ::tcltest::skippedBecause]
	if {[llength $constraintList] > 0} {
	    puts stdout "Number of tests skipped for each constraint:"
	    foreach constraint [lsort $constraintList] {
		puts stdout \
			"\t$::tcltest::skippedBecause($constraint)\t$constraint"
		unset ::tcltest::skippedBecause($constraint)
	    }
	}

	# report the names of test files in ::tcltest::createdNewFiles, and
	# reset the array to be empty.
	set testFilesThatTurded [lsort [array names ::tcltest::createdNewFiles]]
	if {[llength $testFilesThatTurded] > 0} {
	    puts stdout "Warning: test files left files behind:"
	    foreach testFile $testFilesThatTurded {
		puts "\t$testFile:\t$::tcltest::createdNewFiles($testFile)"
		unset ::tcltest::createdNewFiles($testFile)
	    }
	}

	# reset filesMade, filesExisted, and numTests
	set ::tcltest::filesMade {}
	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
	    set ::tcltest::numTests($index) 0
	}

	# exit only if running Tk in non-interactive mode
	global tk_version tcl_interactive
	if {[info exists tk_version] && !$tcl_interactive} {
	    exit
	}
    } else {
	# if we're deferring stat-reporting until all files are sourced,
	# then add current file to failFile list if any tests in this file
	# failed
	incr ::tcltest::numTestFiles
	if {($::tcltest::currentFailure) && \
		([lsearch -exact $::tcltest::failFiles $tail] == -1)} {
	    lappend ::tcltest::failFiles $tail
	}
	set ::tcltest::currentFailure false
    }
}


# test --
#
# This procedure runs a test and prints an error message if the test fails.
# If ::tcltest::verbose has been set, it also prints a message even if the
# test succeeds.  The test will be skipped if it doesn't match the
# ::tcltest::match variable, if it matches an element in
# ::tcltest::skip, or if one of the elements of "constraints" turns
# out not to be true.
#
# Arguments:
# name -		Name of test, in the form foo-1.2.
# description -		Short textual description of the test, to
#			help humans understand what it does.
# constraints -		A list of one or more keywords, each of
#			which must be the name of an element in
#			the array "::tcltest::testConfig".  If any of these
#			elements is zero, the test is skipped.
#			This argument may be omitted.
# script -		Script to run to carry out the test.  It must
#			return a result that can be checked for
#			correctness.
# expectedAnswer -	Expected result from script.

proc ::tcltest::test {name description script expectedAnswer args} {
    incr ::tcltest::numTests(Total)

    # skip the test if it's name matches an element of skip
    foreach pattern $::tcltest::skip {
	if {[string match $pattern $name]} {
	    incr ::tcltest::numTests(Skipped)
	    return
	}
    }
    # skip the test if it's name doesn't match any element of match
    if {[llength $::tcltest::match] > 0} {
	set ok 0
	foreach pattern $::tcltest::match {
	    if {[string match $pattern $name]} {
		set ok 1
		break
	    }
        }
	if {!$ok} {
	    incr ::tcltest::numTests(Skipped)
	    return
	}
    }
    set i [llength $args]
    if {$i == 0} {
	set constraints {}
    } elseif {$i == 1} {
	# "constraints" argument exists;  shuffle arguments down, then
	# make sure that the constraints are satisfied.

	set constraints $script
	set script $expectedAnswer
	set expectedAnswer [lindex $args 0]
	set doTest 0
	if {[string match {*[$\[]*} $constraints] != 0} {
	    # full expression, e.g. {$foo > [info tclversion]}

	    catch {set doTest [uplevel #0 expr $constraints]}
	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
	    # something like {a || b} should be turned into 
	    # $::tcltest::testConfig(a) || $::tcltest::testConfig(b).

 	    regsub -all {[.a-zA-Z0-9]+} $constraints \
		    {$::tcltest::testConfig(&)} c
	    catch {set doTest [eval expr $c]}
	} else {
	    # just simple constraints such as {unixOnly fonts}.

	    set doTest 1
	    foreach constraint $constraints {
		if {![info exists ::tcltest::testConfig($constraint)]
			|| !$::tcltest::testConfig($constraint)} {
		    set doTest 0
		    # store the constraint that kept the test from running
		    set constraints $constraint
		    break
		}
	    }
	}
	if {$doTest == 0} {
	    incr ::tcltest::numTests(Skipped)
	    if {[string first s $::tcltest::verbose] != -1} {
		puts stdout "++++ $name SKIPPED: $constraints"
	    }
	    # add the constraint to the list of constraints the kept tests
	    # from running
	    if {[info exists ::tcltest::skippedBecause($constraints)]} {
		incr ::tcltest::skippedBecause($constraints)
	    } else {
		set ::tcltest::skippedBecause($constraints) 1
	    }
	    return	
	}
    } else {
	error "wrong # args: must be \"test name description ?constraints? script expectedAnswer\""
    }
    memory tag $name
    set code [catch {uplevel $script} actualAnswer]
    if {$code != 0 || [string compare $actualAnswer $expectedAnswer] != 0} {
	incr ::tcltest::numTests(Failed)
	set ::tcltest::currentFailure true
	if {[string first b $::tcltest::verbose] == -1} {
	    set script ""
	}
	puts stdout "\n==== $name $description FAILED"
	if {$script != ""} {
	    puts stdout "==== Contents of test case:"
	    puts stdout $script
	}
	if {$code != 0} {
	    if {$code == 1} {
		puts stdout "==== Test generated error:"
		puts stdout $actualAnswer
	    } elseif {$code == 2} {
		puts stdout "==== Test generated return exception;  result was:"
		puts stdout $actualAnswer
	    } elseif {$code == 3} {
		puts stdout "==== Test generated break exception"
	    } elseif {$code == 4} {
		puts stdout "==== Test generated continue exception"
	    } else {
		puts stdout "==== Test generated exception $code;  message was:"
		puts stdout $actualAnswer
	    }
	} else {
	    puts stdout "---- Result was:\n$actualAnswer"
	}
	puts stdout "---- Result should have been:\n$expectedAnswer"
	puts stdout "==== $name FAILED\n" 
    } else { 
	incr ::tcltest::numTests(Passed)
	if {[string first p $::tcltest::verbose] != -1} {
	    puts stdout "++++ $name PASSED"
	}
    }
}

# ::tcltest::dotests --
#
#	takes two arguments--the name of the test file (such
#	as "parse.test"), and a pattern selecting the tests you want to
#	execute.  It sets ::tcltest::matching to the second argument, calls
#	"source" on the file specified in the first argument, and restores
#	::tcltest::matching to its pre-call value at the end.
#
# Arguments:
#	file    name of tests file to source
#	args    pattern selecting the tests you want to execute
#
# Results:
#	none

proc ::tcltest::dotests {file args} {
    set savedTests $::tcltest::match
    set ::tcltest::match $args
    source $file
    set ::tcltest::match $savedTests
}

proc ::tcltest::openfiles {} {
    if {[catch {testchannel open} result]} {
	return {}
    }
    return $result
}

proc ::tcltest::leakfiles {old} {
    if {[catch {testchannel open} new]} {
        return {}
    }
    set leak {}
    foreach p $new {
    	if {[lsearch $old $p] < 0} {
	    lappend leak $p
	}
    }
    return $leak
}

set ::tcltest::saveState {}

proc ::tcltest::saveState {} {
    uplevel #0 {set ::tcltest::saveState [list [info procs] [info vars]]}
}

proc ::tcltest::restoreState {} {
    foreach p [info procs] {
	if {[lsearch [lindex $::tcltest::saveState 0] $p] < 0} {
	    rename $p {}
	}
    }
    foreach p [uplevel #0 {info vars}] {
	if {[lsearch [lindex $::tcltest::saveState 1] $p] < 0} {
	    uplevel #0 "unset $p"
	}
    }
}

proc ::tcltest::normalizeMsg {msg} {
    regsub "\n$" [string tolower $msg] "" msg
    regsub -all "\n\n" $msg "\n" msg
    regsub -all "\n\}" $msg "\}" msg
    return $msg
}

# makeFile --
#
# Create a new file with the name <name>, and write <contents> to it.
#
# If this file hasn't been created via makeFile since the last time
# cleanupTests was called, add it to the $filesMade list, so it will
# be removed by the next call to cleanupTests.
#
proc ::tcltest::makeFile {contents name} {
    set fd [open $name w]
    fconfigure $fd -translation lf
    if {[string index $contents [expr {[string length $contents] - 1}]] == "\n"} {
	puts -nonewline $fd $contents
    } else {
	puts $fd $contents
    }
    close $fd

    set fullName [file join [pwd] $name]
    if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
	lappend ::tcltest::filesMade $fullName
    }
}

proc ::tcltest::removeFile {name} {
    file delete $name
}

# makeDirectory --
#
# Create a new dir with the name <name>.
#
# If this dir hasn't been created via makeDirectory since the last time
# cleanupTests was called, add it to the $directoriesMade list, so it will
# be removed by the next call to cleanupTests.
#
proc ::tcltest::makeDirectory {name} {
    file mkdir $name

    set fullName [file join [pwd] $name]
    if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
	lappend ::tcltest::filesMade $fullName
    }
}

proc ::tcltest::removeDirectory {name} {
    file delete -force $name
}

proc ::tcltest::viewFile {name} {
    global tcl_platform
    if {($tcl_platform(platform) == "macintosh") || \
		($::tcltest::testConfig(unixExecs) == 0)} {
	set f [open $name]
	set data [read -nonewline $f]
	close $f
	return $data
    } else {
	exec cat $name
    }
}

#
# Construct a string that consists of the requested sequence of bytes,
# as opposed to a string of properly formed UTF-8 characters.  
# This allows the tester to 
# 1. Create denormalized or improperly formed strings to pass to C procedures 
#    that are supposed to accept strings with embedded NULL bytes.
# 2. Confirm that a string result has a certain pattern of bytes, for instance
#    to confirm that "\xe0\0" in a Tcl script is stored internally in 
#    UTF-8 as the sequence of bytes "\xc3\xa0\xc0\x80".
#
# Generally, it's a bad idea to examine the bytes in a Tcl string or to
# construct improperly formed strings in this manner, because it involves
# exposing that Tcl uses UTF-8 internally.

proc ::tcltest::bytestring {string} {
    encoding convertfrom identity $string
}

# Locate tcltest executable

if {![info exists tk_version]} {
    set tcltest [info nameofexecutable]

    if {$tcltest == "{}"} {
	set tcltest {}
    }
}

set ::tcltest::testConfig(stdio) 0
catch {
    catch {file delete -force tmp}
    set f [open tmp w]
    puts $f {
	exit
    }
    close $f

    set f [open "|[list $tcltest tmp]" r]
    close $f
    
    set ::tcltest::testConfig(stdio) 1
}
catch {file delete -force tmp}

# Deliberately call the socket with the wrong number of arguments.  The error
# message you get will indicate whether sockets are available on this system.
catch {socket} msg
set ::tcltest::testConfig(socket) \
	[expr {$msg != "sockets are not available on this system"}]

#
# Internationalization / ISO support procs     -- dl
#
if {[info commands testlocale]==""} {
    # No testlocale command, no tests...
    # (it could be that we are a sub interp and we could just load
    # the Tcltest package but that would interfere with tests
    # that tests packages/loading in slaves...)
    set ::tcltest::testConfig(hasIsoLocale) 0
} else {
    proc ::tcltest::set_iso8859_1_locale {} {
	set ::tcltest::previousLocale [testlocale ctype]
	testlocale ctype $::tcltest::isoLocale
    }

    proc ::tcltest::restore_locale {} {
	testlocale ctype $::tcltest::previousLocale
    }

    if {![info exists ::tcltest::isoLocale]} {
	set ::tcltest::isoLocale fr
        switch $tcl_platform(platform) {
	    "unix" {
		# Try some 'known' values for some platforms:
		switch -exact -- $tcl_platform(os) {
		    "FreeBSD" {
			set ::tcltest::isoLocale fr_FR.ISO_8859-1
		    }
		    HP-UX {
			set ::tcltest::isoLocale fr_FR.iso88591
		    }
		    Linux -
		    IRIX {
			set ::tcltest::isoLocale fr
		    }
		    default {
			# Works on SunOS 4 and Solaris, and maybe others...
			# define it to something else on your system
			#if you want to test those.
			set ::tcltest::isoLocale iso_8859_1
		    }
		}
	    }
	    "windows" {
		set ::tcltest::isoLocale French
	    }
	}
    }

    set ::tcltest::testConfig(hasIsoLocale) \
	    [string length [::tcltest::set_iso8859_1_locale]]
    ::tcltest::restore_locale
} 

#
# procedures that are Tk specific
#
if {[info exists tk_version]} {
    # If the main window isn't already mapped (e.g. because the tests are
    # being run automatically) , specify a precise size for it so that the
    # user won't have to position it manually.

    if {![winfo ismapped .]} {
	wm geometry . +0+0
	update
    }

    # The following code can be used to perform tests involving a second
    # process running in the background.
    
    # Locate the tktest executable

    set ::tcltest::tktest [info nameofexecutable]
    if {$::tcltest::tktest == "{}"} {
	set ::tcltest::tktest {}
	puts stdout \
		"Unable to find tktest executable, skipping multiple process tests."
    }

    # Create background process
    
    proc ::tcltest::setupbg args {
	if {$::tcltest::tktest == ""} {
	    error "you're not running tktest so setupbg should not have been called"
	}
	if {[info exists ::tcltest::fd] && ($::tcltest::fd != "")} {
	    cleanupbg
	}
	
	# The following code segment cannot be run on Windows in Tk8.1b2
	# This bug is logged as a pipe bug (bugID 1495).

	global tcl_platform
	if {$tcl_platform(platform) != "windows"} {
	    set ::tcltest::fd [open "|[list $::tcltest::tktest -geometry +0+0 -name tktest] $args" r+]
	    puts $::tcltest::fd "puts foo; flush stdout"
	    flush $::tcltest::fd
	    if {[gets $::tcltest::fd data] < 0} {
		error "unexpected EOF from \"$::tcltest::tktest\""
	    }
	    if {[string compare $data foo]} {
		error "unexpected output from background process \"$data\""
	    }
	    fileevent $::tcltest::fd readable bgReady
	}
    }
    
    # Send a command to the background process, catching errors and
    # flushing I/O channels
    proc ::tcltest::dobg {command} {
	puts $::tcltest::fd "catch [list $command] msg; update; puts \$msg; puts **DONE**; flush stdout"
	flush $::tcltest::fd
	set ::tcltest::bgDone 0
	set ::tcltest::bgData {}
	tkwait variable ::tcltest::bgDone
	set ::tcltest::bgData
    }

    # Data arrived from background process.  Check for special marker
    # indicating end of data for this command, and make data available
    # to dobg procedure.
    proc ::tcltest::bgReady {} {
	set x [gets $::tcltest::fd]
	if {[eof $::tcltest::fd]} {
	    fileevent $::tcltest::fd readable {}
	    set ::tcltest::bgDone 1
	} elseif {$x == "**DONE**"} {
	    set ::tcltest::bgDone 1
	} else {
	    append ::tcltest::bgData $x
	}
    }

    # Exit the background process, and close the pipes
    proc ::tcltest::cleanupbg {} {
	catch {
	    puts $::tcltest::fd "exit"
	    close $::tcltest::fd
	}
	set ::tcltest::fd ""
    }

    # Clean up focus after using generate event, which
    # can leave the window manager with the wrong impression
    # about who thinks they have the focus. (BW)
    
    proc ::tcltest::fixfocus {} {
	catch {destroy .focus}
	toplevel .focus
	wm geometry .focus +0+0
	entry .focus.e
	.focus.e insert 0 "fixfocus"
	pack .focus.e
	update
	focus -force .focus.e
	destroy .focus
    }
}

# Need to catch the import because it fails if defs.tcl is sourced
# more than once.
catch {namespace import ::tcltest::*}
return

Changes to tests/entry.test.

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
# This file is a Tcl script to test entry widgets in Tk.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) entry.test 1.49 97/11/07 09:34:31




if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\""
    puts "image, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"

    return
}

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

proc scroll args {





>
>

<
<
>
|
<
>
>
>





>



<
<
<
<







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
# This file is a Tcl script to test entry widgets in Tk.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: entry.test,v 1.1.4.8 1999/04/07 02:05:28 surles Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\""
    puts "image, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    ::tcltest::cleanupTests
    return
}





foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

proc scroll args {
47
48
49
50
51
52
53

54
55
56
57
58
59
60
option add *Entry.borderWidth 2
option add *Entry.highlightThickness 2
option add *Entry.font {Helvetica -12}

entry .e -bd 2 -relief sunken
pack .e
update

set i 1
foreach test {
    {-background #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-bd 4 4 badValue {bad screen distance "badValue"}}
    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}







>







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
option add *Entry.borderWidth 2
option add *Entry.highlightThickness 2
option add *Entry.font {Helvetica -12}

entry .e -bd 2 -relief sunken
pack .e
update

set i 1
foreach test {
    {-background #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-bd 4 4 badValue {bad screen distance "badValue"}}
    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
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
    {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
    {-highlightthickness -2 0 {} {}}
    {-insertbackground #110022 #110022 bogus {unknown color name "bogus"}}
    {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}}
    {-insertofftime 100 100 3.2 {expected integer but got "3.2"}}
    {-insertontime 100 100 3.2 {expected integer but got "3.2"}}
    {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
    {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
    {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
    {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
    {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
    {-show * * {} {}}
    {-state normal normal bogus {bad state value "bogus": must be normal or disabled}}
    {-takefocus "any string" "any string" {} {}}
    {-textvariable i i {} {}}
    {-width 402 402 3p {expected integer but got "3p"}}
    {-xscrollcommand {Some command} {Some command} {} {}}
} {
    set name [lindex $test 0]
    test entry-1.1 {configuration options} {
	.e configure $name [lindex $test 1]
	list [lindex [.e configure $name] 4] [.e cget $name]
    } [list [lindex $test 2] [lindex $test 2]]
    incr i
    if {[lindex $test 3] != ""} {
	test entry-1.2 {configuration options} {
	    list [catch {.e configure $name [lindex $test 3]} msg] $msg
	} [list 1 [lindex $test 4]]
    }
    .e configure $name [lindex [.e configure $name] 3]
    incr i
}








|




|






|





|







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
    {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
    {-highlightthickness -2 0 {} {}}
    {-insertbackground #110022 #110022 bogus {unknown color name "bogus"}}
    {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}}
    {-insertofftime 100 100 3.2 {expected integer but got "3.2"}}
    {-insertontime 100 100 3.2 {expected integer but got "3.2"}}
    {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
    {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
    {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
    {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
    {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
    {-show * * {} {}}
    {-state normal normal bogus {bad state "bogus": must be disabled or normal}}
    {-takefocus "any string" "any string" {} {}}
    {-textvariable i i {} {}}
    {-width 402 402 3p {expected integer but got "3p"}}
    {-xscrollcommand {Some command} {Some command} {} {}}
} {
    set name [lindex $test 0]
    test entry-1.$i {configuration options} {
	.e configure $name [lindex $test 1]
	list [lindex [.e configure $name] 4] [.e cget $name]
    } [list [lindex $test 2] [lindex $test 2]]
    incr i
    if {[lindex $test 3] != ""} {
	test entry-1.$i {configuration options} {
	    list [catch {.e configure $name [lindex $test 3]} msg] $msg
	} [list 1 [lindex $test 4]]
    }
    .e configure $name [lindex [.e configure $name] 3]
    incr i
}

124
125
126
127
128
129
130

131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148


149






















150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
















202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241






242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458














459
460
461
462
463
464
465
466
catch {destroy .e}
entry .e -font $fixed
pack .e
update

set cx [font measure $fixed a]
set cy [font metrics $fixed -linespace]


test entry-3.1 {EntryWidgetCmd procedure} {
    list [catch {.e} msg] $msg
} {1 {wrong # args: should be ".e option ?arg arg ...?"}}
test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} {
    list [catch {.e bbox} msg] $msg
} {1 {wrong # args: should be ".e bbox index"}}
test entry-3.3 {EntryWidgetCmd procedure, "bbox" widget command} {
    list [catch {.e bbox a b} msg] $msg
} {1 {wrong # args: should be ".e bbox index"}}
test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} {
    list [catch {.e bbox bogus} msg] $msg
} {1 {bad entry index "bogus"}}
test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} {
    .e delete 0 end
    .e bbox 0
} [list 5 5 0 $cy]
test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} {fonts} {


    .e delete 0 end






















    .e insert 0 "abcdefghijklmnop"
    list [.e bbox 0] [.e bbox 1] [.e bbox end]
} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+15*$cx] 5 $cx $cy"]
test entry-3.7 {EntryWidgetCmd procedure, "cget" widget command} {
    list [catch {.e cget} msg] $msg
} {1 {wrong # args: should be ".e cget option"}}
test entry-3.8 {EntryWidgetCmd procedure, "cget" widget command} {
    list [catch {.e cget a b} msg] $msg
} {1 {wrong # args: should be ".e cget option"}}
test entry-3.9 {EntryWidgetCmd procedure, "cget" widget command} {
    list [catch {.e cget -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
test entry-3.10 {EntryWidgetCmd procedure, "cget" widget command} {
    .e configure -bd 4
    .e cget -bd
} {4}
test entry-3.11 {EntryWidgetCmd procedure, "configure" widget command} {
    llength [.e configure]
} {28}
test entry-3.12 {EntryWidgetCmd procedure, "configure" widget command} {
    list [catch {.e configure -foo} msg] $msg
} {1 {unknown option "-foo"}}
test entry-3.13 {EntryWidgetCmd procedure, "configure" widget command} {
    .e configure -bd 4
    .e configure -bg #ffffff
    lindex [.e configure -bd] 4
} {4}
test entry-3.14 {EntryWidgetCmd procedure, "delete" widget command} {
    list [catch {.e delete} msg] $msg
} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
test entry-3.15 {EntryWidgetCmd procedure, "delete" widget command} {
    list [catch {.e delete a b c} msg] $msg
} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
test entry-3.16 {EntryWidgetCmd procedure, "delete" widget command} {
    list [catch {.e delete foo} msg] $msg
} {1 {bad entry index "foo"}}
test entry-3.17 {EntryWidgetCmd procedure, "delete" widget command} {
    list [catch {.e delete 0 bar} msg] $msg
} {1 {bad entry index "bar"}}
test entry-3.18 {EntryWidgetCmd procedure, "delete" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e delete 2 4
    .e get
} {014567890}
test entry-3.19 {EntryWidgetCmd procedure, "delete" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e delete 6
    .e get
} {0123457890}
test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} {
















    .e delete 0 end
    .e insert end "01234567890"
    .e delete 6 5
    .e get
} {01234567890}
test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e configure -state disabled
    .e delete 2 8
    .e configure -state normal
    .e get
} {01234567890}
test entry-3.22 {EntryWidgetCmd procedure, "get" widget command} {
    list [catch {.e get foo} msg] $msg
} {1 {wrong # args: should be ".e get"}}
test entry-3.23 {EntryWidgetCmd procedure, "icursor" widget command} {
    list [catch {.e icursor} msg] $msg
} {1 {wrong # args: should be ".e icursor pos"}}
test entry-3.24 {EntryWidgetCmd procedure, "icursor" widget command} {
    list [catch {.e icursor foo} msg] $msg
} {1 {bad entry index "foo"}}
test entry-3.25 {EntryWidgetCmd procedure, "icursor" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e icursor 4
    .e index insert
} {4}
test entry-3.26 {EntryWidgetCmd procedure, "index" widget command} {
    list [catch {.e in} msg] $msg
} {1 {bad option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}}
test entry-3.27 {EntryWidgetCmd procedure, "index" widget command} {
    list [catch {.e index} msg] $msg
} {1 {wrong # args: should be ".e index string"}}
test entry-3.28 {EntryWidgetCmd procedure, "index" widget command} {
    list [catch {.e index foo} msg] $msg
} {1 {bad entry index "foo"}}
test entry-3.29 {EntryWidgetCmd procedure, "index" widget command} {
    list [catch {.e index 0} msg] $msg
} {0 0}






test entry-3.30 {EntryWidgetCmd procedure, "insert" widget command} {
    list [catch {.e insert a} msg] $msg
} {1 {wrong # args: should be ".e insert index text"}}
test entry-3.31 {EntryWidgetCmd procedure, "insert" widget command} {
    list [catch {.e insert a b c} msg] $msg
} {1 {wrong # args: should be ".e insert index text"}}
test entry-3.32 {EntryWidgetCmd procedure, "insert" widget command} {
    list [catch {.e insert foo Text} msg] $msg
} {1 {bad entry index "foo"}}
test entry-3.33 {EntryWidgetCmd procedure, "insert" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e insert 3 xxx
    .e get
} {012xxx34567890}
test entry-3.34 {EntryWidgetCmd procedure, "insert" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e configure -state disabled
    .e insert 3 xxx
    .e configure -state normal
    .e get
} {01234567890}
test entry-3.35 {EntryWidgetCmd procedure, "insert" widget command} {
    list [catch {.e insert a b c} msg] $msg
} {1 {wrong # args: should be ".e insert index text"}}
test entry-3.36 {EntryWidgetCmd procedure, "scan" widget command} {
    list [catch {.e scan a} msg] $msg
} {1 {wrong # args: should be ".e scan mark|dragto x"}}
test entry-3.37 {EntryWidgetCmd procedure, "scan" widget command} {
    list [catch {.e scan a b c} msg] $msg
} {1 {wrong # args: should be ".e scan mark|dragto x"}}
test entry-3.38 {EntryWidgetCmd procedure, "scan" widget command} {
    list [catch {.e scan foobar 20} msg] $msg
} {1 {bad scan option "foobar": must be mark or dragto}}
test entry-3.39 {EntryWidgetCmd procedure, "scan" widget command} {
    list [catch {.e scan mark 20.1} msg] $msg
} {1 {expected integer but got "20.1"}}
# This test is non-portable because character sizes vary.

test entry-3.40 {EntryWidgetCmd procedure, "scan" widget command} {fonts} {
    .e delete 0 end
    update
    .e insert end "This is quite a long string, in fact a "
    .e insert end "very very long string"
    .e scan mark 30
    .e scan dragto 28
    .e index @0
} {2}
test entry-3.41 {EntryWidgetCmd procedure, "select" widget command} {
    list [catch {.e select} msg] $msg
} {1 {wrong # args: should be ".e select option ?index?"}}
test entry-3.42 {EntryWidgetCmd procedure, "select" widget command} {
    list [catch {.e select foo} msg] $msg
} {1 {bad selection option "foo": must be adjust, clear, from, present, range, or to}}
test entry-3.43 {EntryWidgetCmd procedure, "select clear" widget command} {
    list [catch {.e select clear gorp} msg] $msg
} {1 {wrong # args: should be ".e selection clear"}}
test entry-3.44 {EntryWidgetCmd procedure, "select clear" widget command} {
    .e delete 0 end
    .e insert end "0123456789"
    .e select from 1
    .e select to 4
    update
    .e select clear
    list [catch {selection get} msg] $msg [selection own]
} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e}
test entry-3.45 {EntryWidgetCmd procedure, "selection present" widget command} {
    list [catch {.e selection present foo} msg] $msg
} {1 {wrong # args: should be ".e selection present"}}
test entry-3.46 {EntryWidgetCmd procedure, "selection present" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 3
    .e select to 6
    .e selection present
} {1}
test entry-3.47 {EntryWidgetCmd procedure, "selection present" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 3
    .e select to 6
    .e configure -exportselection false
    .e selection present
} {1}
.e configure -exportselection true
test entry-3.48 {EntryWidgetCmd procedure, "selection present" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 3
    .e select to 6
    .e delete 0 end
    .e selection present
} {0}
test entry-3.49 {EntryWidgetCmd procedure, "selection adjust" widget command} {
    list [catch {.e select adjust x} msg] $msg
} {1 {bad entry index "x"}}
test entry-3.50 {EntryWidgetCmd procedure, "selection adjust" widget command} {
    list [catch {.e select adjust 2 3} msg] $msg
} {1 {wrong # args: should be ".e selection adjust index"}}
test entry-3.51 {EntryWidgetCmd procedure, "selection adjust" widget command} {
    .e delete 0 end
    .e insert end "0123456789"
    .e select from 1
    .e select to 5
    update
    .e select adjust 4
    selection get
} {123}
test entry-3.52 {EntryWidgetCmd procedure, "selection adjust" widget command} {
    .e delete 0 end
    .e insert end "0123456789"
    .e select from 1
    .e select to 5
    update
    .e select adjust 2
    selection get
} {234}
test entry-3.53 {EntryWidgetCmd procedure, "selection from" widget command} {
    list [catch {.e select from 2 3} msg] $msg
} {1 {wrong # args: should be ".e selection from index"}}
test entry-3.54 {EntryWidgetCmd procedure, "selection range" widget command} {
    list [catch {.e select range 2} msg] $msg
} {1 {wrong # args: should be ".e selection range start end"}}
test entry-3.55 {EntryWidgetCmd procedure, "selection range" widget command} {
    list [catch {.e selection range 2 3 4} msg] $msg
} {1 {wrong # args: should be ".e selection range start end"}}
test entry-3.56 {EntryWidgetCmd procedure, "selection range" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 1
    .e select to 5
    .e select range 4 4
    list [catch {.e index sel.first} msg] $msg
} {1 {selection isn't in entry}}
test entry-3.57 {EntryWidgetCmd procedure, "selection range" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 3
    .e select to 7
    .e select range 2 9
    list [.e index sel.first] [.e index sel.last] [.e index anchor]
} {2 9 3}
.e delete 0 end
.e insert end "This is quite a long text string, so long that it "
.e insert end "runs off the end of the window quite a bit."
test entry-3.58 {EntryWidgetCmd procedure, "selection to" widget command} {
    list [catch {.e select to 2 3} msg] $msg
} {1 {wrong # args: should be ".e selection to index"}}
test entry-3.59 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview 5
    .e xview
} {0.0537634 0.268817}
test entry-3.60 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview gorp} msg] $msg
} {1 {bad entry index "gorp"}}
test entry-3.61 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview 0
    .e icursor 10
    .e xview insert
    .e xview
} {0.107527 0.322581}
test entry-3.62 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview moveto foo bar} msg] $msg
} {1 {wrong # args: should be ".e xview moveto fraction"}}
test entry-3.63 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview moveto foo} msg] $msg
} {1 {expected floating-point number but got "foo"}}
test entry-3.64 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview moveto 0.5
    .e xview
} {0.505376 0.72043}
test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview scroll 24} msg] $msg
} {1 {wrong # args: should be ".e xview scroll number units|pages"}}
test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview scroll gorp units} msg] $msg
} {1 {expected integer but got "gorp"}}
test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview moveto 0
    .e xview scroll 1 pages
    .e xview
} {0.193548 0.408602}
test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview moveto .9
    update
    .e xview scroll -2 p
    .e xview
} {0.397849 0.612903}
test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview 30
    update
    .e xview scroll 2 units 
    .e index @0
} {32}
test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview 30
    update
    .e xview scroll -1 units 
    .e index @0
} {29}
test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview scroll 23 foobars} msg] $msg
} {1 {bad argument "foobars": must be units or pages}}
test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview eat 23 hamburgers} msg] $msg
} {1 {unknown option "eat": must be moveto or scroll}}
test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview 0
    update
    .e xview -4
    .e index @0
} {0}
test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview 300
    .e index @0
} {73}














test entry-3.75 {EntryWidgetCmd procedure} {
    list [catch {.e gorp} msg] $msg
} {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}}

# The test below doesn't actually check anything directly, but if run
# with Purify or some other memory-allocation-checking program it will
# ensure that resources get properly freed.








>

















|
>
>

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


|


|


|



|


|


|




|


|


|


|


|





|





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





|







|


|


|


|





|

|
|


|


|


>
>
>
>
>
>
|


|


|


|





|







|


|


|


|


|




|








|


|


|


|








|


|






|








|







|


|


|








|








|


|


|


|







|










|


|



|


|





|


|


|



|


|


|




|





|





|





|


|


|





|



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







125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
catch {destroy .e}
entry .e -font $fixed
pack .e
update

set cx [font measure $fixed a]
set cy [font metrics $fixed -linespace]
set ux [font measure $fixed \u4e4e]

test entry-3.1 {EntryWidgetCmd procedure} {
    list [catch {.e} msg] $msg
} {1 {wrong # args: should be ".e option ?arg arg ...?"}}
test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} {
    list [catch {.e bbox} msg] $msg
} {1 {wrong # args: should be ".e bbox index"}}
test entry-3.3 {EntryWidgetCmd procedure, "bbox" widget command} {
    list [catch {.e bbox a b} msg] $msg
} {1 {wrong # args: should be ".e bbox index"}}
test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} {
    list [catch {.e bbox bogus} msg] $msg
} {1 {bad entry index "bogus"}}
test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} {
    .e delete 0 end
    .e bbox 0
} [list 5 5 0 $cy]
test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} {
    # Tcl_UtfAtIndex(): no utf chars

    .e delete 0 end
    .e insert 0 "abc"
    list [.e bbox 3] [.e bbox end]
} [list "[expr 5+2*$cx] 5 $cx $cy" "[expr 5+2*$cx] 5 $cx $cy"]
test entry-3.7 {EntryWidgetCmd procedure, "bbox" widget command} {
    # Tcl_UtfAtIndex(): utf at end
    .e delete 0 end
    .e insert 0 "ab\u4e4e"
    .e bbox end
} "[expr 5+2*$cx] 5 $ux $cy"
test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} {
    # Tcl_UtfAtIndex(): utf before index
    .e delete 0 end
    .e insert 0 "ab\u4e4ec"
    .e bbox 3
} "[expr 5+2*$cx+$ux] 5 $cx $cy"
test entry-3.9 {EntryWidgetCmd procedure, "bbox" widget command} {
    # Tcl_UtfAtIndex(): no chars
    .e delete 0 end
    .e bbox end
} "5 5 0 $cy"
test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} {
    .e delete 0 end
    .e insert 0 "abcdefghij\u4e4eklmnop"
    list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end]
} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+10*$cx] 5 $ux $cy" "[expr 5+$ux+15*$cx] 5 $cx $cy"]
test entry-3.11 {EntryWidgetCmd procedure, "cget" widget command} {
    list [catch {.e cget} msg] $msg
} {1 {wrong # args: should be ".e cget option"}}
test entry-3.12 {EntryWidgetCmd procedure, "cget" widget command} {
    list [catch {.e cget a b} msg] $msg
} {1 {wrong # args: should be ".e cget option"}}
test entry-3.13 {EntryWidgetCmd procedure, "cget" widget command} {
    list [catch {.e cget -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} {
    .e configure -bd 4
    .e cget -bd
} {4}
test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} {
    llength [.e configure]
} {28}
test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} {
    list [catch {.e configure -foo} msg] $msg
} {1 {unknown option "-foo"}}
test entry-3.17 {EntryWidgetCmd procedure, "configure" widget command} {
    .e configure -bd 4
    .e configure -bg #ffffff
    lindex [.e configure -bd] 4
} {4}
test entry-3.18 {EntryWidgetCmd procedure, "delete" widget command} {
    list [catch {.e delete} msg] $msg
} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
test entry-3.19 {EntryWidgetCmd procedure, "delete" widget command} {
    list [catch {.e delete a b c} msg] $msg
} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} {
    list [catch {.e delete foo} msg] $msg
} {1 {bad entry index "foo"}}
test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} {
    list [catch {.e delete 0 bar} msg] $msg
} {1 {bad entry index "bar"}}
test entry-3.22 {EntryWidgetCmd procedure, "delete" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e delete 2 4
    .e get
} {014567890}
test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e delete 6
    .e get
} {0123457890}
test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} {
    # UTF
    set x {}
    .e delete 0 end
    .e insert end "01234\u4e4e67890"
    .e delete 6
    lappend x [.e get]
    .e delete 0 end
    .e insert end "012345\u4e4e7890"
    .e delete 6
    lappend x [.e get]
    .e delete 0 end
    .e insert end "0123456\u4e4e890"
    .e delete 6
    lappend x [.e get]
} [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"]
test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e delete 6 5
    .e get
} {01234567890}
test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e configure -state disabled
    .e delete 2 8
    .e configure -state normal
    .e get
} {01234567890}
test entry-3.27 {EntryWidgetCmd procedure, "get" widget command} {
    list [catch {.e get foo} msg] $msg
} {1 {wrong # args: should be ".e get"}}
test entry-3.28 {EntryWidgetCmd procedure, "icursor" widget command} {
    list [catch {.e icursor} msg] $msg
} {1 {wrong # args: should be ".e icursor pos"}}
test entry-3.29 {EntryWidgetCmd procedure, "icursor" widget command} {
    list [catch {.e icursor foo} msg] $msg
} {1 {bad entry index "foo"}}
test entry-3.30 {EntryWidgetCmd procedure, "icursor" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e icursor 4
    .e index insert
} {4}
test entry-3.31 {EntryWidgetCmd procedure, "index" widget command} {
    list [catch {.e in} msg] $msg
} {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}}
test entry-3.32 {EntryWidgetCmd procedure, "index" widget command} {
    list [catch {.e index} msg] $msg
} {1 {wrong # args: should be ".e index string"}}
test entry-3.33 {EntryWidgetCmd procedure, "index" widget command} {
    list [catch {.e index foo} msg] $msg
} {1 {bad entry index "foo"}}
test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} {
    list [catch {.e index 0} msg] $msg
} {0 0}
test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} {
    # UTF
    .e delete 0 end
    .e insert 0 abc\u4e4e\u0153def
    list [.e index 3] [.e index 4] [.e index end]
} {3 4 8}
test entry-3.36 {EntryWidgetCmd procedure, "insert" widget command} {
    list [catch {.e insert a} msg] $msg
} {1 {wrong # args: should be ".e insert index text"}}
test entry-3.37 {EntryWidgetCmd procedure, "insert" widget command} {
    list [catch {.e insert a b c} msg] $msg
} {1 {wrong # args: should be ".e insert index text"}}
test entry-3.38 {EntryWidgetCmd procedure, "insert" widget command} {
    list [catch {.e insert foo Text} msg] $msg
} {1 {bad entry index "foo"}}
test entry-3.39 {EntryWidgetCmd procedure, "insert" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e insert 3 xxx
    .e get
} {012xxx34567890}
test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} {
    .e delete 0 end
    .e insert end "01234567890"
    .e configure -state disabled
    .e insert 3 xxx
    .e configure -state normal
    .e get
} {01234567890}
test entry-3.41 {EntryWidgetCmd procedure, "insert" widget command} {
    list [catch {.e insert a b c} msg] $msg
} {1 {wrong # args: should be ".e insert index text"}}
test entry-3.42 {EntryWidgetCmd procedure, "scan" widget command} {
    list [catch {.e scan a} msg] $msg
} {1 {wrong # args: should be ".e scan mark|dragto x"}}
test entry-3.43 {EntryWidgetCmd procedure, "scan" widget command} {
    list [catch {.e scan a b c} msg] $msg
} {1 {wrong # args: should be ".e scan mark|dragto x"}}
test entry-3.44 {EntryWidgetCmd procedure, "scan" widget command} {
    list [catch {.e scan foobar 20} msg] $msg
} {1 {bad scan option "foobar": must be mark or dragto}}
test entry-3.45 {EntryWidgetCmd procedure, "scan" widget command} {
    list [catch {.e scan mark 20.1} msg] $msg
} {1 {expected integer but got "20.1"}}
# This test is non-portable because character sizes vary.

test entry-3.46 {EntryWidgetCmd procedure, "scan" widget command} {fonts} {
    .e delete 0 end
    update
    .e insert end "This is quite a long string, in fact a "
    .e insert end "very very long string"
    .e scan mark 30
    .e scan dragto 28
    .e index @0
} {2}
test entry-3.47 {EntryWidgetCmd procedure, "select" widget command} {
    list [catch {.e select} msg] $msg
} {1 {wrong # args: should be ".e select option ?index?"}}
test entry-3.48 {EntryWidgetCmd procedure, "select" widget command} {
    list [catch {.e select foo} msg] $msg
} {1 {bad selection option "foo": must be adjust, clear, from, present, range, or to}}
test entry-3.49 {EntryWidgetCmd procedure, "select clear" widget command} {
    list [catch {.e select clear gorp} msg] $msg
} {1 {wrong # args: should be ".e selection clear"}}
test entry-3.50 {EntryWidgetCmd procedure, "select clear" widget command} {
    .e delete 0 end
    .e insert end "0123456789"
    .e select from 1
    .e select to 4
    update
    .e select clear
    list [catch {selection get} msg] $msg [selection own]
} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e}
test entry-3.51 {EntryWidgetCmd procedure, "selection present" widget command} {
    list [catch {.e selection present foo} msg] $msg
} {1 {wrong # args: should be ".e selection present"}}
test entry-3.52 {EntryWidgetCmd procedure, "selection present" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 3
    .e select to 6
    .e selection present
} {1}
test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 3
    .e select to 6
    .e configure -exportselection false
    .e selection present
} {1}
.e configure -exportselection true
test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 3
    .e select to 6
    .e delete 0 end
    .e selection present
} {0}
test entry-3.55 {EntryWidgetCmd procedure, "selection adjust" widget command} {
    list [catch {.e select adjust x} msg] $msg
} {1 {bad entry index "x"}}
test entry-3.56 {EntryWidgetCmd procedure, "selection adjust" widget command} {
    list [catch {.e select adjust 2 3} msg] $msg
} {1 {wrong # args: should be ".e selection adjust index"}}
test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} {
    .e delete 0 end
    .e insert end "0123456789"
    .e select from 1
    .e select to 5
    update
    .e select adjust 4
    selection get
} {123}
test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} {
    .e delete 0 end
    .e insert end "0123456789"
    .e select from 1
    .e select to 5
    update
    .e select adjust 2
    selection get
} {234}
test entry-3.59 {EntryWidgetCmd procedure, "selection from" widget command} {
    list [catch {.e select from 2 3} msg] $msg
} {1 {wrong # args: should be ".e selection from index"}}
test entry-3.60 {EntryWidgetCmd procedure, "selection range" widget command} {
    list [catch {.e select range 2} msg] $msg
} {1 {wrong # args: should be ".e selection range start end"}}
test entry-3.61 {EntryWidgetCmd procedure, "selection range" widget command} {
    list [catch {.e selection range 2 3 4} msg] $msg
} {1 {wrong # args: should be ".e selection range start end"}}
test entry-3.62 {EntryWidgetCmd procedure, "selection range" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 1
    .e select to 5
    .e select range 4 4
    list [catch {.e index sel.first} msg] $msg
} {1 {selection isn't in entry}}
test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} {
    .e delete 0 end
    .e insert end 0123456789
    .e select from 3
    .e select to 7
    .e select range 2 9
    list [.e index sel.first] [.e index sel.last] [.e index anchor]
} {2 9 3}
.e delete 0 end
.e insert end "This is quite a long text string, so long that it "
.e insert end "runs off the end of the window quite a bit."
test entry-3.64 {EntryWidgetCmd procedure, "selection to" widget command} {
    list [catch {.e select to 2 3} msg] $msg
} {1 {wrong # args: should be ".e selection to index"}}
test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview 5
    .e xview
} {0.0537634 0.268817}
test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview gorp} msg] $msg
} {1 {bad entry index "gorp"}}
test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview 0
    .e icursor 10
    .e xview insert
    .e xview
} {0.107527 0.322581}
test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview moveto foo bar} msg] $msg
} {1 {wrong # args: should be ".e xview moveto fraction"}}
test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview moveto foo} msg] $msg
} {1 {expected floating-point number but got "foo"}}
test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview moveto 0.5
    .e xview
} {0.505376 0.72043}
test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview scroll 24} msg] $msg
} {1 {wrong # args: should be ".e xview scroll number units|pages"}}
test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview scroll gorp units} msg] $msg
} {1 {expected integer but got "gorp"}}
test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview moveto 0
    .e xview scroll 1 pages
    .e xview
} {0.193548 0.408602}
test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview moveto .9
    update
    .e xview scroll -2 p
    .e xview
} {0.397849 0.612903}
test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview 30
    update
    .e xview scroll 2 units 
    .e index @0
} {32}
test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview 30
    update
    .e xview scroll -1 units 
    .e index @0
} {29}
test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview scroll 23 foobars} msg] $msg
} {1 {bad argument "foobars": must be units or pages}}
test entry-3.78 {EntryWidgetCmd procedure, "xview" widget command} {
    list [catch {.e xview eat 23 hamburgers} msg] $msg
} {1 {unknown option "eat": must be moveto or scroll}}
test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview 0
    update
    .e xview -4
    .e index @0
} {0}
test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} {
    .e xview 300
    .e index @0
} {73}
.e insert 10 \u4e4e
test entry-3.81 {EntryWidgetCmd procedure, "xview" widget command} {
    # UTF
    # If Tcl_NumUtfChars wasn't used, wrong answer would be:
    # {0.106383 0.319149} {0.117021 0.351064} {0.117021 0.351064}

    set x {}
    .e xview moveto .1
    lappend x [.e xview]
    .e xview moveto .11
    lappend x [.e xview]
    .e xview moveto .12
    lappend x [.e xview]
} {{0.0957447 0.308511} {0.106383 0.319149} {0.117021 0.329787}}
test entry-3.82 {EntryWidgetCmd procedure} {
    list [catch {.e gorp} msg] $msg
} {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}}

# The test below doesn't actually check anything directly, but if run
# with Purify or some other memory-allocation-checking program it will
# ensure that resources get properly freed.

658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676















677
678
679
680
681
682
683
test entry-6.9 {EntryComputeGeometry procedure} {fonts} {
    catch {destroy .e}
    entry .e -font $big -bd 3 -relief raised -width 0 -highlightthickness 2
    pack .e
    update
    list [winfo reqwidth .e] [winfo reqheight .e]
} {25 39}
test entry-6.10 {EntryComputeGeometry procedure} {fonts} {
    catch {destroy .e}
    entry .e -bd 1 -relief raised -width 0 -show .
    .e insert 0 12345
    pack .e
    update
    set x [winfo reqwidth .e]
    .e configure -show X
    lappend x [winfo reqwidth .e]
    .e configure -show ""
    lappend x [winfo reqwidth .e]
} {23 53 43}
















catch {destroy .e}
entry .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll
pack .e
focus .e
test entry-7.1 {InsertChars procedure} {
    .e delete 0 end







|











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







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
test entry-6.9 {EntryComputeGeometry procedure} {fonts} {
    catch {destroy .e}
    entry .e -font $big -bd 3 -relief raised -width 0 -highlightthickness 2
    pack .e
    update
    list [winfo reqwidth .e] [winfo reqheight .e]
} {25 39}
test entry-6.10 {EntryComputeGeometry procedure} {unixOnly fonts} {
    catch {destroy .e}
    entry .e -bd 1 -relief raised -width 0 -show .
    .e insert 0 12345
    pack .e
    update
    set x [winfo reqwidth .e]
    .e configure -show X
    lappend x [winfo reqwidth .e]
    .e configure -show ""
    lappend x [winfo reqwidth .e]
} {23 53 43}
test entry-6.11 {EntryComputeGeometry procedure} {pcOnly} {
    catch {destroy .e}
    entry .e -bd 1 -relief raised -width 0 -show . -font {helvetica 12}
    .e insert 0 12345
    pack .e
    update
    set x [winfo reqwidth .e]
    .e configure -show X
    lappend x [winfo reqwidth .e]
    .e configure -show ""
    lappend x [winfo reqwidth .e]
} [list \
    [expr 8+5*[font measure {helvetica 12} .]] \
    [expr 8+5*[font measure {helvetica 12} X]] \
    [expr 8+[font measure {helvetica 12} 12345]]]

catch {destroy .e}
entry .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll
pack .e
focus .e
test entry-7.1 {InsertChars procedure} {
    .e delete 0 end
1085
1086
1087
1088
1089
1090
1091
1092



1093
1094
1095







1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
} {1 {bad entry index "ibogus"}}
test entry-13.9 {GetEntryIndex procedure} {
    .e select from 1
    .e select to 6
    list [.e index sel.first] [.e index sel.last]
} {1 6}
selection clear .e
test entry-13.10 {GetEntryIndex procedure} {pc} {



    .e index sel.first
} {1}
test entry-13.11 {GetEntryIndex procedure} {!pc} {







    list [catch {.e index sel.first} msg] $msg
} {1 {selection isn't in entry}}
test entry-13.12 {GetEntryIndex procedure} {pc} {
    list [catch {.e index sbogus} msg] $msg
} {1 {bad entry index "sbogus"}}
test entry-13.13 {GetEntryIndex procedure} {!pc} {
    list [catch {.e index sbogus} msg] $msg
} {1 {selection isn't in entry}}
test entry-13.14 {GetEntryIndex procedure} {
    list [catch {.e index @xyz} msg] $msg
} {1 {bad entry index "@xyz"}}
test entry-13.15 {GetEntryIndex procedure} {fonts} {
    .e index @4
} {4}
test entry-13.16 {GetEntryIndex procedure} {fonts} {
    .e index @11
} {4}
test entry-13.17 {GetEntryIndex procedure} {fonts} {
    .e index @12
} {5}
test entry-13.18 {GetEntryIndex procedure} {fonts} {
    .e index @[expr [winfo width .e] - 6]
} {8}
test entry-13.19 {GetEntryIndex procedure} {fonts} {
    .e index @[expr [winfo width .e] - 5]
} {9}
test entry-13.20 {GetEntryIndex procedure} {
    .e index @1000
} {9}
test entry-13.21 {GetEntryIndex procedure} {
    list [catch {.e index 1xyz} msg] $msg
} {1 {bad entry index "1xyz"}}
test entry-13.22 {GetEntryIndex procedure} {
    .e index -10
} {0}
test entry-13.23 {GetEntryIndex procedure} {
    .e index 12
} {12}
test entry-13.24 {GetEntryIndex procedure} {
    .e index 49
} {21}
test entry-13.25 {GetEntryIndex procedure} {fonts} {
    catch {destroy .e}
    entry .e -show .
    .e insert 0 XXXYZZY
    pack .e
    update
    list [.e index @7] [.e index @8]
} {0 1}







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

|


|
|
|
|


|


|


|


|


|


|


|


|


|


|


|







1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
} {1 {bad entry index "ibogus"}}
test entry-13.9 {GetEntryIndex procedure} {
    .e select from 1
    .e select to 6
    list [.e index sel.first] [.e index sel.last]
} {1 6}
selection clear .e
test entry-13.10 {GetEntryIndex procedure} {unixOnly} {
    # On unix, when selection is cleared, entry widget's internal 
    # selection range is reset.

    list [catch {.e index sel.first} msg] $msg
} {1 {selection isn't in entry}}
test entry-13.11 {GetEntryIndex procedure} {macOrPc} {
    # On mac and pc, when selection is cleared, entry widget remembers
    # last selected range.  When selection ownership is restored to 
    # entry, the old range will be rehighlighted.

    list [catch {selection get}] [.e index sel.first]
} {1 1}
test entry-13.12 {GetEntryIndex procedure} {unixOnly} {
    list [catch {.e index sbogus} msg] $msg
} {1 {selection isn't in entry}}
test entry-13.13 {GetEntryIndex procedure} {macOrPc} {
    list [catch {.e index sbogus} msg] $msg
} {1 {bad entry index "sbogus"}}
test entry-13.14 {GetEntryIndex procedure} {macOrPc} {
    list [catch {selection get}] [catch {.e index sbogus}]
} {1 1}
test entry-13.15 {GetEntryIndex procedure} {
    list [catch {.e index @xyz} msg] $msg
} {1 {bad entry index "@xyz"}}
test entry-13.16 {GetEntryIndex procedure} {fonts} {
    .e index @4
} {4}
test entry-13.17 {GetEntryIndex procedure} {fonts} {
    .e index @11
} {4}
test entry-13.18 {GetEntryIndex procedure} {fonts} {
    .e index @12
} {5}
test entry-13.19 {GetEntryIndex procedure} {fonts} {
    .e index @[expr [winfo width .e] - 6]
} {8}
test entry-13.20 {GetEntryIndex procedure} {fonts} {
    .e index @[expr [winfo width .e] - 5]
} {9}
test entry-13.21 {GetEntryIndex procedure} {
    .e index @1000
} {9}
test entry-13.22 {GetEntryIndex procedure} {
    list [catch {.e index 1xyz} msg] $msg
} {1 {bad entry index "1xyz"}}
test entry-13.23 {GetEntryIndex procedure} {
    .e index -10
} {0}
test entry-13.24 {GetEntryIndex procedure} {
    .e index 12
} {12}
test entry-13.25 {GetEntryIndex procedure} {
    .e index 49
} {21}
test entry-13.26 {GetEntryIndex procedure} {fonts} {
    catch {destroy .e}
    entry .e -show .
    .e insert 0 XXXYZZY
    pack .e
    update
    list [.e index @7] [.e index @8]
} {0 1}
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207






1208
1209
1210
1211
1212
1213
1214
1215
1216
update

test entry-16.1 {EntryVisibleRange procedure} {fonts} {
    .e delete 0 end
    .e insert 0 .............................
    .e xview
} {0 0.827586}
test entry-16.2 {EntryVisibleRange procedure} {fonts} {
    .e configure -show X
    .e delete 0 end
    .e insert 0 .............................
    .e xview
} {0 0.275862}






.e configure -show ""
test entry-16.3 {EntryVisibleRange procedure} {
    .e delete 0 end
    .e xview
} {0 1}

catch {destroy .e}
entry .e -width 10 -xscrollcommand scroll -font $fixed
pack .e







|





>
>
>
>
>
>

|







1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
update

test entry-16.1 {EntryVisibleRange procedure} {fonts} {
    .e delete 0 end
    .e insert 0 .............................
    .e xview
} {0 0.827586}
test entry-15.2 {EntryVisibleRange procedure} {unixOnly fonts} {
    .e configure -show X
    .e delete 0 end
    .e insert 0 .............................
    .e xview
} {0 0.275862}
test entry-15.3 {EntryVisibleRange procedure} {pcOnly} {
    .e configure -show .
    .e delete 0 end
    .e insert 0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    .e xview
} {0 0.827586}
.e configure -show ""
test entry-15.4 {EntryVisibleRange procedure} {
    .e delete 0 end
    .e xview
} {0 1}

catch {destroy .e}
entry .e -width 10 -xscrollcommand scroll -font $fixed
pack .e
1261
1262
1263
1264
1265
1266
1267

1268
1269















    destroy .e
    list [winfo children .] [interp hidden]
} [list {} $l]    
    
# XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
# and EntryTextVarProc.



option clear






















>

|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
    destroy .e
    list [winfo children .] [interp hidden]
} [list {} $l]    
    
# XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
# and EntryTextVarProc.

option clear

# cleanup
::tcltest::cleanupTests
return













Changes to tests/event.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test the code in tkEvent.c.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) event.test 1.6 96/09/12 09:25:44

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .





|
|
<

|

|
|







1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18
19
# This file is a Tcl script to test the code in tkEvent.c.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: event.test,v 1.1.4.4 1999/03/24 02:54:39 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
35
36
37
38
39
40
41

















    bind .b <1> {
	lappend x button
    }
    set x {}
    destroy .b
    set x
} {destroy}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
    bind .b <1> {
	lappend x button
    }
    set x {}
    destroy .b
    set x
} {destroy}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/filebox.test.

1
2
3
4
5


6
7
8

9
10
11


12

13






14
15
16
17
18
19
20
# This file is a Tcl script to test out Tk's "tk_getOpenFile" and
# "tk_getSaveFile" commands. It is organized in the standard fashion
# for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) filebox.test 1.5 97/10/10 11:03:21
#




set tk_strictMotif_old $tk_strictMotif







#----------------------------------------------------------------------
#
# Procedures needed by this test file
#
#----------------------------------------------------------------------






>
>

<
<
>

<
|
>
>
|
>

>
>
>
>
>
>







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
# This file is a Tcl script to test out Tk's "tk_getOpenFile" and
# "tk_getSaveFile" commands. It is organized in the standard fashion
# for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: filebox.test,v 1.1.4.8 1999/03/26 00:07:56 hershey Exp $
#


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

set tk_strictMotif_old $tk_strictMotif

# Some tests require user interaction on non-unix platform

set ::tcltest::testConfig(nonUnixUserInteraction) \
    [expr {$::tcltest::testConfig(userInteraction) || \
	$::tcltest::testConfig(unixOnly)}]

#----------------------------------------------------------------------
#
# Procedures needed by this test file
#
#----------------------------------------------------------------------

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
    event generate $btn <Enter>
    event generate $btn <1> -x 5 -y 5
    event generate $btn <ButtonRelease-1> -x 5 -y 5
}

proc EnterFileByKey {parent fileName fileDir} {
    global tk_strictMotif

    set w .__tk_filedialog



    upvar #0 [winfo name $w] data

    if {$tk_strictMotif} {
	$data(sEnt) delete 0 end
	$data(sEnt) insert 0 [file join $fileDir $fileName]
    } else {
	$data(ent) delete 0 end
	$data(ent) insert 0 $fileName
    }

    update
    SendButtonPress $parent ok mouse
}

proc SendButtonPress {parent btn type} {
    global tk_strictMotif

    set w .__tk_filedialog



    upvar #0 [winfo name $w] data

    set button $data($btn\Btn)
    if ![winfo ismapped $button] {
	update
    }








>
|
>
>
>
















>
|
>
>
>







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
    event generate $btn <Enter>
    event generate $btn <1> -x 5 -y 5
    event generate $btn <ButtonRelease-1> -x 5 -y 5
}

proc EnterFileByKey {parent fileName fileDir} {
    global tk_strictMotif
    if {$parent == "."} {
	set w .__tk_filedialog
    } else {
	set w $parent.__tk_filedialog
    }
    upvar #0 [winfo name $w] data

    if {$tk_strictMotif} {
	$data(sEnt) delete 0 end
	$data(sEnt) insert 0 [file join $fileDir $fileName]
    } else {
	$data(ent) delete 0 end
	$data(ent) insert 0 $fileName
    }

    update
    SendButtonPress $parent ok mouse
}

proc SendButtonPress {parent btn type} {
    global tk_strictMotif
    if {$parent == "."} {
	set w .__tk_filedialog
    } else {
	set w $parent.__tk_filedialog
    }
    upvar #0 [winfo name $w] data

    set button $data($btn\Btn)
    if ![winfo ismapped $button] {
	update
    }

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

#----------------------------------------------------------------------
#
# The test suite proper
#
#----------------------------------------------------------------------

if {[string compare test [info procs test]] == 1} {
    source defs
}

if {$tcl_platform(platform) == "unix"} {
    set modes "0 1"
} else {
    set modes 1
}

set unknownOptionsMsg {1 {unknown option "-foo", must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent or -title}}






foreach mode $modes {

    #
    # Test both the motif version and the "tk" version of the file dialog
    # box on Unix.
    #

    if {$tcl_platform(platform) == "unix"} {
	set tk_strictMotif $mode
    }

    #
    # Test both the "open" and the "save" dialogs
    #

    foreach command "tk_getOpenFile tk_getSaveFile" {

	test filebox-1.1 "$command command" {
	    list [catch {$command -foo} msg] $msg
	} $unknownOptionsMsg


	regsub -all ,      $msg "" options
	regsub \"-foo\" $options "" options

	foreach option $options {
	    if {[string index $option 0] == "-"} {
		test filebox-1.2 "$command command" {
		    list [catch {$command $option} msg] $msg







<
<
<
<






|
>
>
>
>
>

















<




>







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

#----------------------------------------------------------------------
#
# The test suite proper
#
#----------------------------------------------------------------------





if {$tcl_platform(platform) == "unix"} {
    set modes "0 1"
} else {
    set modes 1
}

set unknownOptionsMsg {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}

set tmpFile "filebox.tmp"
makeFile {
    # this file can be empty!
} $tmpFile

foreach mode $modes {

    #
    # Test both the motif version and the "tk" version of the file dialog
    # box on Unix.
    #

    if {$tcl_platform(platform) == "unix"} {
	set tk_strictMotif $mode
    }

    #
    # Test both the "open" and the "save" dialogs
    #

    foreach command "tk_getOpenFile tk_getSaveFile" {

	test filebox-1.1 "$command command" {
	    list [catch {$command -foo} msg] $msg
	} $unknownOptionsMsg

	catch {$command -foo 1} msg
	regsub -all ,      $msg "" options
	regsub \"-foo\" $options "" options

	foreach option $options {
	    if {[string index $option 0] == "-"} {
		test filebox-1.2 "$command command" {
		    list [catch {$command $option} msg] $msg
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

	if {[info commands tkMotifFDialog] == "" && [info commands tkFDialog] == ""} {
	    set isNative 1
	} else {
	    set isNative 0
	}

	if {$isNative && ![info exists INTERACTIVE]} {
	    continue
	}

	set parent .

	set verylongstring longstring:
	set verylongstring $verylongstring$verylongstring
	set verylongstring $verylongstring$verylongstring
	set verylongstring $verylongstring$verylongstring
	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring

	set color #404040
	test filebox-2.1 "$command command" {
	    ToPressButton $parent cancel
	    $command -title "Press Cancel ($verylongstring)" -parent $parent
	} ""


	if {$command == "tk_getSaveFile"} {
	    set fileName "12x 455"
	    set fileDir [pwd]
	    set pathName [file join [pwd] $fileName]
	} else {
	    set thisFile [info script]
	    set fileName [file tail $thisFile]
	    set appPWD [pwd]
	    cd [file dirname $thisFile]
	    set fileDir [pwd]
	    cd $appPWD
	    set pathName [file join $fileDir $fileName]
	}

	test filebox-2.2 "$command command" {
	    ToPressButton $parent ok
	    set choice [$command -title "Press Ok" \
			    -parent $parent -initialfile $fileName -initialdir $fileDir]
	} $pathName

	test filebox-2.3 "$command command" {
	    ToEnterFileByKey $parent $fileName $fileDir
	    set choice [$command -title "Enter \"$fileName\" and press Ok" \
			    -parent $parent -initialdir $fileDir]
	} $pathName








































	set filters(1) {}

	set filters(2) {
	    {"Text files"	{.txt .doc}	}
	    {"Text files"	{}		TEXT}
	    {"Tcl Scripts"	{.tcl}		TEXT}







<
<
<
<














|



<






<
|
<
<

<



|





|




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







162
163
164
165
166
167
168




169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186

187
188
189
190
191
192

193


194

195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254

	if {[info commands tkMotifFDialog] == "" && [info commands tkFDialog] == ""} {
	    set isNative 1
	} else {
	    set isNative 0
	}





	set parent .

	set verylongstring longstring:
	set verylongstring $verylongstring$verylongstring
	set verylongstring $verylongstring$verylongstring
	set verylongstring $verylongstring$verylongstring
	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring

	set color #404040
	test filebox-2.1 "$command command" {nonUnixUserInteraction} {
	    ToPressButton $parent cancel
	    $command -title "Press Cancel ($verylongstring)" -parent $parent
	} ""


	if {$command == "tk_getSaveFile"} {
	    set fileName "12x 455"
	    set fileDir [pwd]
	    set pathName [file join [pwd] $fileName]
	} else {

	    set fileName $tmpFile


	    set fileDir [pwd]

	    set pathName [file join $fileDir $fileName]
	}

	test filebox-2.2 "$command command" {nonUnixUserInteraction} {
	    ToPressButton $parent ok
	    set choice [$command -title "Press Ok" \
			    -parent $parent -initialfile $fileName -initialdir $fileDir]
	} $pathName

	test filebox-2.3 "$command command" {nonUnixUserInteraction} {
	    ToEnterFileByKey $parent $fileName $fileDir
	    set choice [$command -title "Enter \"$fileName\" and press Ok" \
			    -parent $parent -initialdir $fileDir]
	} $pathName

	test filebox-2.4 "$command command" {nonUnixUserInteraction} {
	    ToPressButton $parent ok
	    set choice [$command -title "Enter \"$fileName\" and press Ok" \
			    -parent $parent -initialdir . \
			    -initialfile $fileName]
	} $pathName

	test filebox-2.5 "$command command" {nonUnixUserInteraction} {
	    ToPressButton $parent ok
	    set choice [$command -title "Enter \"$fileName\" and press Ok" \
			    -parent $parent -initialdir /badpath \
			    -initialfile $fileName]
	} $pathName

	test filebox-2.6 "$command command" {nonUnixUserInteraction} {
	    toplevel .t1; toplevel .t2
	    ToPressButton .t1 ok
	    set choice {}
	    lappend choice [$command \
		    -title "Enter \"$fileName\" and press Ok" \
		    -parent .t1 -initialdir $fileDir \
		    -initialfile $fileName]
	    ToPressButton .t2 ok
	    lappend choice [$command \
		    -title "Enter \"$fileName\" and press Ok" \
		    -parent .t2 -initialdir $fileDir \
		    -initialfile $fileName]
	    ToPressButton .t1 ok
	    lappend choice [$command \
		    -title "Enter \"$fileName\" and press Ok" \
		    -parent .t1 -initialdir $fileDir \
		    -initialfile $fileName]
	    destroy .t1
	    destroy .t2
	    set choice
	} [list $pathName $pathName $pathName]
 


	set filters(1) {}

	set filters(2) {
	    {"Text files"	{.txt .doc}	}
	    {"Text files"	{}		TEXT}
	    {"Tcl Scripts"	{.tcl}		TEXT}
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228

	set filters(3) {
	    {"Text files"	{.txt .doc}	TEXT}
	    {"Foo"		{""}		TEXT}
	}

	foreach x [lsort -integer [array names filters]] {
	    test filebox-3.$x "$command command" {
		ToPressButton $parent ok
		set choice [$command -title "Press Ok" -filetypes $filters($x)\
				-parent $parent -initialfile $fileName -initialdir $fileDir]
	    } $pathName
	}

	#







|







262
263
264
265
266
267
268
269
270
271
272
273
274
275
276

	set filters(3) {
	    {"Text files"	{.txt .doc}	TEXT}
	    {"Foo"		{""}		TEXT}
	}

	foreach x [lsort -integer [array names filters]] {
	    test filebox-3.$x "$command command" {nonUnixUserInteraction} {
		ToPressButton $parent ok
		set choice [$command -title "Press Ok" -filetypes $filters($x)\
				-parent $parent -initialfile $fileName -initialdir $fileDir]
	    } $pathName
	}

	#
238
239
240
241
242
243
244



245
246
247
248
249
250
251






    }

    # end outer if
}

set tk_strictMotif $tk_strictMotif_old




if {$isNative && ![info exists INTERACTIVE]} {
    puts " Some tests were skipped because they could not be performed"
    puts " automatically on this platform. If you wish to execute them"
    puts " interactively, set the TCL variable INTERACTIVE and re-run"
    puts " the test."
    return
}













>
>
>
|
|
|
|
|
|
|
>
>
>
>
>
>
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
    }

    # end outer if
}

set tk_strictMotif $tk_strictMotif_old

# cleanup
::tcltest::cleanupTests
return













Changes to tests/focus.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
# This file is a Tcl script to test out the "focus" command and the
# other procedures in the file tkFocus.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) focus.test 1.24 97/08/11 09:39:34

if {$tcl_platform(platform) != "unix"} {
    return
}

if {[info procs test] != "test"} {
    source defs
}

eval destroy [winfo children .]
wm geometry . {}
raise .

button .b -text .b -relief raised -bd 2





|
|
<

<
|
<
<
|
|
<
|







1
2
3
4
5
6
7

8

9


10
11

12
13
14
15
16
17
18
19
# This file is a Tcl script to test out the "focus" command and the
# other procedures in the file tkFocus.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#

# RCS: @(#) $Id: focus.test,v 1.1.4.7 1999/04/07 02:32:09 surles Exp $



if {[lsearch [namespace children] ::tcltest] == -1} {

    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

eval destroy [winfo children .]
wm geometry . {}
raise .

button .b -text .b -relief raised -bd 2
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200





201
202
203
204
205
206
207

208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233

234
235
236
237
238
239
240
	button .alt.$i -text .alt.$i -relief raised -bd 2
	pack .alt.$i
    }
    tkwait visibility .alt.d
}

# Make sure the window manager knows who has focus
fixfocus

# The following procedure ensures that there is no input focus
# in this application.  It does it by arranging for another
# application to grab the focus.  The "after" and "update" stuff
# is needed to wait long enough for pending actions to get through
# the X server and possibly also the window manager.

setupbg
proc focusClear {} {
    global x;
    after 200 {set x 1}
    tkwait variable x
    dobg {focus -force .; update}
    update
}

focusSetup
set altDisplay [info exists env(TK_ALT_DISPLAY)]
if $altDisplay {
    focusSetupAlt
}
update

bind all <FocusIn> {
    append focusInfo "in %W %d\n"
}
bind all <FocusOut> {
    append focusInfo "out %W %d\n"
}
bind all <KeyPress> {
    append focusInfo "press %W %K"
}

test focus-1.1 {Tk_FocusCmd procedure} {
    focusClear
    focus
} {}
if $altDisplay {
    test focus-1.2 {Tk_FocusCmd procedure} {
	focus .alt.b
	focus
    } {}
}
test focus-1.3 {Tk_FocusCmd procedure} {
    focusClear
    focus .t.b3
    focus
} {}
test focus-1.4 {Tk_FocusCmd procedure} {
    list [catch {focus ""} msg] $msg
} {0 {}}
test focus-1.5 {Tk_FocusCmd procedure} {
    focusClear
    focus -force .t
    focus .t.b3
    focus
} {.t.b3}
test focus-1.6 {Tk_FocusCmd procedure} {
    list [catch {focus .gorp} msg] $msg
} {1 {bad window path name ".gorp"}}
test focus-1.7 {Tk_FocusCmd procedure} {
    list [catch {focus .gorp a} msg] $msg
} {1 {bad option ".gorp": must be -displayof, -force, or -lastfor}}
test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} {
    toplevel .t2
    wm geom .t2 +10+10
    frame .t2.f -width 200 -height 100 -bd 2 -relief raised
    frame .t2.f2 -width 200 -height 100 -bd 2 -relief raised
    pack .t2.f .t2.f2
    bind .t2.f <Destroy> {focus .t2.f}
    bind .t2.f2 <Destroy> {focus .t2}
    focus -force .t2.f2
    tkwait visibility .t2.f2
    update
    set x [focus]
    destroy .t2.f2
    lappend x [focus]
    destroy .t2.f
    lappend x [focus]
    destroy .t2
    set x
} {.t2.f2 .t2 .t2}
test focus-1.9 {Tk_FocusCmd procedure, -displayof option} {
    list [catch {focus -displayof} msg] $msg
} {1 {wrong # args: should be "focus -displayof window"}}
test focus-1.10 {Tk_FocusCmd procedure, -displayof option} {
    list [catch {focus -displayof a b} msg] $msg
} {1 {wrong # args: should be "focus -displayof window"}}
test focus-1.11 {Tk_FocusCmd procedure, -displayof option} {
    list [catch {focus -displayof .lousy} msg] $msg
} {1 {bad window path name ".lousy"}}
test focus-1.12 {Tk_FocusCmd procedure, -displayof option} {
    focusClear
    focus .t
    focus -displayof .t.b3
} {}
test focus-1.13 {Tk_FocusCmd procedure, -displayof option} {
    focusClear
    focus -force .t
    focus -displayof .t.b3
} {.t}
if $altDisplay {
    test focus-1.14 {Tk_FocusCmd procedure, -displayof option} {
	focus -force .alt.c
	focus -displayof .alt
    } {.alt.c}
}
test focus-1.15 {Tk_FocusCmd procedure, -force option} {
    list [catch {focus -force} msg] $msg
} {1 {wrong # args: should be "focus -force window"}}
test focus-1.16 {Tk_FocusCmd procedure, -force option} {
    list [catch {focus -force a b} msg] $msg
} {1 {wrong # args: should be "focus -force window"}}
test focus-1.17 {Tk_FocusCmd procedure, -force option} {
    list [catch {focus -force foo} msg] $msg
} {1 {bad window path name "foo"}}
test focus-1.18 {Tk_FocusCmd procedure, -force option} {
    list [catch {focus -force ""} msg] $msg
} {0 {}}
test focus-1.19 {Tk_FocusCmd procedure, -force option} {
    focusClear
    focus .t.b1
    set x  [list [focus]]
    focus -force .t.b1
    lappend x [focus]
} {{} .t.b1}
test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} {
    list [catch {focus -lastfor} msg] $msg
} {1 {wrong # args: should be "focus -lastfor window"}}
test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} {
    list [catch {focus -lastfor 1 2} msg] $msg
} {1 {wrong # args: should be "focus -lastfor window"}}
test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} {
    list [catch {focus -lastfor who_knows?} msg] $msg
} {1 {bad window path name "who_knows?"}}
test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} {
    focus .b
    focus .t.b1
    list [focus -lastfor .] [focus -lastfor .t.b3]
} {.b .t.b1}
test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} {
    destroy .t
    focusSetup
    update
    focus -lastfor .t.b2
} {.t}
test focus-1.25 {Tk_FocusCmd procedure} {
    list [catch {focus -unknown} msg] $msg
} {1 {bad option "-unknown": must be -displayof, -force, or -lastfor}}






test focus-2.1 {TkFocusFilterEvent procedure} {nonPortable} {
    focus -force .b
    destroy .t
    focusSetup
    update
    set focusInfo {}
    event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor -sendevent 0x54217567

    list $focusInfo
} {{}}
test focus-2.2 {TkFocusFilterEvent procedure} {nonPortable} {
    focus -force .b
    destroy .t
    focusSetup
    update
    set focusInfo {}
    event gen .t <FocusIn> -detail NotifyAncestor -sendevent 0x547321ac
    list $focusInfo [focus]
} {{in .t NotifyAncestor
} .b}
test focus-2.3 {TkFocusFilterEvent procedure} {nonPortable} {
    focus -force .b
    destroy .t
    focusSetup
    update
    set focusInfo {}
    event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor
    update
    list $focusInfo [focus -lastfor .t]
} {{out .b NotifyNonlinear
out . NotifyNonlinearVirtual
in .t NotifyNonlinear
} .t}
test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} {nonPortable} {

    set result {}
    focus .t.b1
    # Important to end with NotifyAncestor, which is an
    # event that is processed normally. This has a side
    # effect on text 2.5
    foreach detail {NotifyAncestor NotifyNonlinear
	    NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot







|

















|
|














|



<
|
|
|
|
<
|




|


|





|


|


|


















|


|


|


|




|




<
|
|
|
|
<
|


|


|


|


|






|


|


|


|




|





|



>
>
>
>
>
|





|
>


|









|












|
>







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

83
84
85
86

87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144

145
146
147
148

149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
	button .alt.$i -text .alt.$i -relief raised -bd 2
	pack .alt.$i
    }
    tkwait visibility .alt.d
}

# Make sure the window manager knows who has focus
catch {fixfocus}

# The following procedure ensures that there is no input focus
# in this application.  It does it by arranging for another
# application to grab the focus.  The "after" and "update" stuff
# is needed to wait long enough for pending actions to get through
# the X server and possibly also the window manager.

setupbg
proc focusClear {} {
    global x;
    after 200 {set x 1}
    tkwait variable x
    dobg {focus -force .; update}
    update
}

focusSetup
set ::tcltest::testConfig(altDisplay) [info exists env(TK_ALT_DISPLAY)]
if {$::tcltest::testConfig(altDisplay)} {
    focusSetupAlt
}
update

bind all <FocusIn> {
    append focusInfo "in %W %d\n"
}
bind all <FocusOut> {
    append focusInfo "out %W %d\n"
}
bind all <KeyPress> {
    append focusInfo "press %W %K"
}

test focus-1.1 {Tk_FocusCmd procedure} {unixOnly} {
    focusClear
    focus
} {}

test focus-1.2 {Tk_FocusCmd procedure} {unixOnly altDisplay} {
    focus .alt.b
    focus
} {}

test focus-1.3 {Tk_FocusCmd procedure} {unixOnly} {
    focusClear
    focus .t.b3
    focus
} {}
test focus-1.4 {Tk_FocusCmd procedure} {unixOnly} {
    list [catch {focus ""} msg] $msg
} {0 {}}
test focus-1.5 {Tk_FocusCmd procedure} {unixOnly} {
    focusClear
    focus -force .t
    focus .t.b3
    focus
} {.t.b3}
test focus-1.6 {Tk_FocusCmd procedure} {unixOnly} {
    list [catch {focus .gorp} msg] $msg
} {1 {bad window path name ".gorp"}}
test focus-1.7 {Tk_FocusCmd procedure} {unixOnly} {
    list [catch {focus .gorp a} msg] $msg
} {1 {bad option ".gorp": must be -displayof, -force, or -lastfor}}
test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} {unixOnly} {
    toplevel .t2
    wm geom .t2 +10+10
    frame .t2.f -width 200 -height 100 -bd 2 -relief raised
    frame .t2.f2 -width 200 -height 100 -bd 2 -relief raised
    pack .t2.f .t2.f2
    bind .t2.f <Destroy> {focus .t2.f}
    bind .t2.f2 <Destroy> {focus .t2}
    focus -force .t2.f2
    tkwait visibility .t2.f2
    update
    set x [focus]
    destroy .t2.f2
    lappend x [focus]
    destroy .t2.f
    lappend x [focus]
    destroy .t2
    set x
} {.t2.f2 .t2 .t2}
test focus-1.9 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
    list [catch {focus -displayof} msg] $msg
} {1 {wrong # args: should be "focus -displayof window"}}
test focus-1.10 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
    list [catch {focus -displayof a b} msg] $msg
} {1 {wrong # args: should be "focus -displayof window"}}
test focus-1.11 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
    list [catch {focus -displayof .lousy} msg] $msg
} {1 {bad window path name ".lousy"}}
test focus-1.12 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
    focusClear
    focus .t
    focus -displayof .t.b3
} {}
test focus-1.13 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
    focusClear
    focus -force .t
    focus -displayof .t.b3
} {.t}

test focus-1.14 {Tk_FocusCmd procedure, -displayof option} {unixOnly altDisplay} {
    focus -force .alt.c
    focus -displayof .alt
} {.alt.c}

test focus-1.15 {Tk_FocusCmd procedure, -force option} {unixOnly} {
    list [catch {focus -force} msg] $msg
} {1 {wrong # args: should be "focus -force window"}}
test focus-1.16 {Tk_FocusCmd procedure, -force option} {unixOnly} {
    list [catch {focus -force a b} msg] $msg
} {1 {wrong # args: should be "focus -force window"}}
test focus-1.17 {Tk_FocusCmd procedure, -force option} {unixOnly} {
    list [catch {focus -force foo} msg] $msg
} {1 {bad window path name "foo"}}
test focus-1.18 {Tk_FocusCmd procedure, -force option} {unixOnly} {
    list [catch {focus -force ""} msg] $msg
} {0 {}}
test focus-1.19 {Tk_FocusCmd procedure, -force option} {unixOnly} {
    focusClear
    focus .t.b1
    set x  [list [focus]]
    focus -force .t.b1
    lappend x [focus]
} {{} .t.b1}
test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
    list [catch {focus -lastfor} msg] $msg
} {1 {wrong # args: should be "focus -lastfor window"}}
test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
    list [catch {focus -lastfor 1 2} msg] $msg
} {1 {wrong # args: should be "focus -lastfor window"}}
test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
    list [catch {focus -lastfor who_knows?} msg] $msg
} {1 {bad window path name "who_knows?"}}
test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
    focus .b
    focus .t.b1
    list [focus -lastfor .] [focus -lastfor .t.b3]
} {.b .t.b1}
test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
    destroy .t
    focusSetup
    update
    focus -lastfor .t.b2
} {.t}
test focus-1.25 {Tk_FocusCmd procedure} {unixOnly} {
    list [catch {focus -unknown} msg] $msg
} {1 {bad option "-unknown": must be -displayof, -force, or -lastfor}}

# Some tests require the testwrapper command

set ::tcltest::testConfig(testwrapper) \
	[expr {[info commands testwrapper] != {}}]

test focus-2.1 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} {
    focus -force .b
    destroy .t
    focusSetup
    update
    set focusInfo {}
    event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor \
	    -sendevent 0x54217567
    list $focusInfo
} {{}}
test focus-2.2 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} {
    focus -force .b
    destroy .t
    focusSetup
    update
    set focusInfo {}
    event gen .t <FocusIn> -detail NotifyAncestor -sendevent 0x547321ac
    list $focusInfo [focus]
} {{in .t NotifyAncestor
} .b}
test focus-2.3 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} {
    focus -force .b
    destroy .t
    focusSetup
    update
    set focusInfo {}
    event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor
    update
    list $focusInfo [focus -lastfor .t]
} {{out .b NotifyNonlinear
out . NotifyNonlinearVirtual
in .t NotifyNonlinear
} .t}
test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} \
	{unixOnly nonPortable testwrapper} {
    set result {}
    focus .t.b1
    # Important to end with NotifyAncestor, which is an
    # event that is processed normally. This has a side
    # effect on text 2.5
    foreach detail {NotifyAncestor NotifyNonlinear
	    NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot
256
257
258
259
260
261
262
263

264
265
266
267
268
269
270
271
272
273

274
275
276
277
278
279
280
281
282
283

284
285
286
287
288
289
290
291
292
293
294
295

296
297
298
299
300

301
302
303
304
305

306
307
308
309
310
311
312
313
314
315
316
317
318
319

320
321
322
323
324
325
326

327
328
329
330
331
332
333
334

335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355

356
357
358
359
360
361
362
363
364
365
366
367
368
369

370
371
372
373
374
375
376
377
378
379
380
381

382
383
384
385
386
387
388
389
390
391
392
393
394
395

396
397
398
399
400
401
402
403
404
405
406
407

408
409
410
411
412
413
414
415
416
417

418
419
420
421
422

423
424
425
426
427
428
429
430
431
432
433
434
435

436
437
438
439
440
441
442
443
444
445

446
447
448
449
450
451
452
453
454
455
456
457
458

459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510













511

512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530

531
532
533
534
535
536
537
} {} {out . NotifyNonlinear
in .t NotifyNonlinearVirtual
in .t.b1 NotifyNonlinear
} {} {} {out . NotifyNonlinear
in .t NotifyNonlinearVirtual
in .t.b1 NotifyNonlinear
}}
test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} {nonPortable} {

    focusSetup
    focus .t.b1
    update
    event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor
    list $focusInfo [focus]
} {{out . NotifyNonlinear
in .t NotifyNonlinearVirtual
in .t.b1 NotifyNonlinear
} .t.b1}
test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} {

    focus .t.b1
    focus .
    update
    event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor
    set focusInfo {}
    set x [focus]
    event gen . <KeyPress-x>
    list $x $focusInfo
} {.t.b1 {press .t.b1 x}}
test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} {

    set result {}
    foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear
	    NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot
	    NotifyVirtual} {
	focus -force .t.b1
	event gen [testwrapper .t] <FocusOut> -detail $detail
	update
	lappend result [focus]
    }
    set result
} {{} .t.b1 {} {} .t.b1 .t.b1 {}}
test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} {

    focus -force .t.b1
    event gen .t.b1 <FocusOut> -detail NotifyAncestor
    focus
} {.t.b1}
test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} {

    focus .t.b1
    event gen [testwrapper .] <FocusOut> -detail NotifyAncestor
    focus
} {}
test focus-2.10 {TkFocusFilterEvent procedure, Enter events} {

    set result {}
    focus .t.b1
    focusClear
    foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear
	    NotifyNonlinearVirtual NotifyVirtual} {
	event gen [testwrapper .t] <Enter> -detail $detail -focus 1
	update
	lappend result [focus]
	event gen [testwrapper .t] <Leave> -detail NotifyAncestor
	update
    }
    set result
} {.t.b1 {} .t.b1 .t.b1 .t.b1}
test focus-2.11 {TkFocusFilterEvent procedure, Enter events} {

    focusClear
    set focusInfo {}
    event gen [testwrapper .t] <Enter> -detail NotifyAncestor
    update
    set focusInfo
} {}
test focus-2.12 {TkFocusFilterEvent procedure, Enter events} {

    focus -force .b
    update
    set focusInfo {}
    event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
    update
    set focusInfo
} {}
test focus-2.13 {TkFocusFilterEvent procedure, Enter events} {

    focus .t.b1
    focusClear
    event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
    set focusInfo {}
    update
    set focusInfo
} {in .t NotifyVirtual
in .t.b1 NotifyAncestor
}
test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} {
    focusClear
    catch {destroy .t2}
    toplevel .t2
    wm withdraw .t2
    update
    set focusInfo {}
    event gen [testwrapper .t2] <Enter> -detail NotifyAncestor -focus 1
    update
    destroy .t2
} {}
test focus-2.15 {TkFocusFilterEvent procedure, Leave events} {

    set result {}
    focus .t.b1
    foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear
	    NotifyNonlinearVirtual NotifyVirtual} {
	focusClear
	event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
	update
	event gen [testwrapper .t] <Leave> -detail $detail
	update
	lappend result [focus]
    }
    set result
} {{} .t.b1 {} {} {}}
test focus-2.16 {TkFocusFilterEvent procedure, Leave events} {

    set result {}
    focus .t.b1
    event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
    update
    set focusInfo {}
    event gen [testwrapper .t] <Leave> -detail NotifyAncestor
    update
    set focusInfo
} {out .t.b1 NotifyAncestor
out .t NotifyVirtual
}
test focus-2.17 {TkFocusFilterEvent procedure, Leave events} {

    set result {}
    focus .t.b1
    event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
    update
    set focusInfo {}
    event gen .t.b1 <Leave> -detail NotifyAncestor
    event gen [testwrapper .] <Leave> -detail NotifyAncestor
    update
    list $focusInfo [focus]
} {{out .t.b1 NotifyAncestor
out .t NotifyVirtual
} {}}

test focus-3.1 {SetFocus procedure, create record on focus} {

    toplevel .t2 -width 250 -height 100
    wm geometry .t2 +0+0
    update
    focus -force .t2
    update
    focus
} {.t2}
catch {destroy .t2}
# This test produces no result, but it will generate a protocol
# error if Tk forgets to make the window exist before focussing
# on it.
test focus-3.2 {SetFocus procedure, making window exist} {

    update
    button .b2 -text "Another button"
    focus .b2
    update
} {}
catch {destroy .b2}
update
# The following test doesn't produce a check-able result, but if
# there are bugs it may generate an X protocol error.
test focus-3.3 {SetFocus procedure, delaying claim of X focus} {

    focusSetup
    focus -force .t.b2
    update
} {}
test focus-3.4 {SetFocus procedure, delaying claim of X focus} {

    focusSetup
    wm withdraw .t
    focus -force .t.b2
    toplevel .t2 -width 250 -height 100
    wm geometry .t2 +10+10
    focus -force .t2
    wm withdraw .t2
    update
    wm deiconify .t2
    wm deiconify .t
} {}
catch {destroy .t2}
test focus-3.5 {SetFocus procedure, generating events} {

    focusSetup
    focusClear
    set focusInfo {}
    focus -force .t.b2
    update
    set focusInfo
} {in .t NotifyVirtual
in .t.b2 NotifyAncestor
}
test focus-3.6 {SetFocus procedure, generating events} {

    focusSetup
    focus -force .b
    update
    set focusInfo {}
    focus .t.b2
    update
    set focusInfo
} {out .b NotifyNonlinear
out . NotifyNonlinearVirtual
in .t NotifyNonlinearVirtual
in .t.b2 NotifyNonlinear
}
test focus-3.7 {SetFocus procedure, generating events} {nonPortable} {

    # Non-portable because some platforms generate extra events.

    focusSetup
    focusClear
    set focusInfo {}
    focus .t.b2
    update
    set focusInfo
} {}

test focus-4.1 {TkFocusDeadWindow procedure} {
    focusSetup
    update
    focus -force .b
    update
    destroy .t
    focus
} {.b}
test focus-4.2 {TkFocusDeadWindow procedure} {
    focusSetup
    update
    focus -force .t.b2
    focus .b
    update
    destroy .t.b2
    update
    focus
} {.b}

# Non-portable due to wm-specific redirection of input focus when
# windows are deleted:

test focus-4.3 {TkFocusDeadWindow procedure} {nonPortable} {
    focusSetup
    update
    focus .t
    update
    destroy .t
    update
    focus
} {}
test focus-4.4 {TkFocusDeadWindow procedure} {
    focusSetup
    focus -force .t.b2
    update
    destroy .t.b2
    focus
} {.t}

# I don't know how to test most of the remaining procedures of this file
# explicitly;  they've already been exercised by the preceding tests.














test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} {

    focusSetup
    focus -force .t
    update
    set result [focus]
    send [dobg {tk appname}] {focus -force .; update}
    lappend result [focus]
    focus .t.b2
    update
    lappend result [focus]
} {.t .t {}}

catch {destroy .t}
bind all <FocusIn> {}
bind all <FocusOut> {}
bind all <KeyPress> {}
cleanupbg
fixfocus

test focus-6.1 {miscellaneous - embedded application in same process} {unixOnly} {

    eval interp delete [interp slaves]
    catch {destroy .t}
    toplevel .t
    wm geometry .t +0+0
    frame .t.f1 -container 1
    frame .t.f2
    pack .t.f1 .t.f2







|
>









|
>









|
>











|
>




|
>




|
>













|
>






|
>







|
>









|










|
>













|
>











|
>













|
>











|
>









|
>




|
>












|
>









|
>












|
>










|







|













|








|










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









|








|
>







254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
} {} {out . NotifyNonlinear
in .t NotifyNonlinearVirtual
in .t.b1 NotifyNonlinear
} {} {} {out . NotifyNonlinear
in .t NotifyNonlinearVirtual
in .t.b1 NotifyNonlinear
}}
test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} \
	{unixOnly nonPortable testwrapper} {
    focusSetup
    focus .t.b1
    update
    event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor
    list $focusInfo [focus]
} {{out . NotifyNonlinear
in .t NotifyNonlinearVirtual
in .t.b1 NotifyNonlinear
} .t.b1}
test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} \
	{unixOnly testwrapper} {
    focus .t.b1
    focus .
    update
    event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor
    set focusInfo {}
    set x [focus]
    event gen . <KeyPress-x>
    list $x $focusInfo
} {.t.b1 {press .t.b1 x}}
test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} \
	{unixOnly testwrapper} {
    set result {}
    foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear
	    NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot
	    NotifyVirtual} {
	focus -force .t.b1
	event gen [testwrapper .t] <FocusOut> -detail $detail
	update
	lappend result [focus]
    }
    set result
} {{} .t.b1 {} {} .t.b1 .t.b1 {}}
test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} \
	{unixOnly testwrapper} {
    focus -force .t.b1
    event gen .t.b1 <FocusOut> -detail NotifyAncestor
    focus
} {.t.b1}
test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} \
	{unixOnly testwrapper} {
    focus .t.b1
    event gen [testwrapper .] <FocusOut> -detail NotifyAncestor
    focus
} {}
test focus-2.10 {TkFocusFilterEvent procedure, Enter events} \
	{unixOnly testwrapper} {
    set result {}
    focus .t.b1
    focusClear
    foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear
	    NotifyNonlinearVirtual NotifyVirtual} {
	event gen [testwrapper .t] <Enter> -detail $detail -focus 1
	update
	lappend result [focus]
	event gen [testwrapper .t] <Leave> -detail NotifyAncestor
	update
    }
    set result
} {.t.b1 {} .t.b1 .t.b1 .t.b1}
test focus-2.11 {TkFocusFilterEvent procedure, Enter events} \
	{unixOnly testwrapper} {
    focusClear
    set focusInfo {}
    event gen [testwrapper .t] <Enter> -detail NotifyAncestor
    update
    set focusInfo
} {}
test focus-2.12 {TkFocusFilterEvent procedure, Enter events} \
	{unixOnly testwrapper} {
    focus -force .b
    update
    set focusInfo {}
    event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
    update
    set focusInfo
} {}
test focus-2.13 {TkFocusFilterEvent procedure, Enter events} \
	{unixOnly testwrapper} {
    focus .t.b1
    focusClear
    event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
    set focusInfo {}
    update
    set focusInfo
} {in .t NotifyVirtual
in .t.b1 NotifyAncestor
}
test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} {unixOnly testwrapper} {
    focusClear
    catch {destroy .t2}
    toplevel .t2
    wm withdraw .t2
    update
    set focusInfo {}
    event gen [testwrapper .t2] <Enter> -detail NotifyAncestor -focus 1
    update
    destroy .t2
} {}
test focus-2.15 {TkFocusFilterEvent procedure, Leave events} \
	{unixOnly testwrapper} {
    set result {}
    focus .t.b1
    foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear
	    NotifyNonlinearVirtual NotifyVirtual} {
	focusClear
	event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
	update
	event gen [testwrapper .t] <Leave> -detail $detail
	update
	lappend result [focus]
    }
    set result
} {{} .t.b1 {} {} {}}
test focus-2.16 {TkFocusFilterEvent procedure, Leave events} \
	{unixOnly testwrapper} {
    set result {}
    focus .t.b1
    event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
    update
    set focusInfo {}
    event gen [testwrapper .t] <Leave> -detail NotifyAncestor
    update
    set focusInfo
} {out .t.b1 NotifyAncestor
out .t NotifyVirtual
}
test focus-2.17 {TkFocusFilterEvent procedure, Leave events} \
	{unixOnly testwrapper} {
    set result {}
    focus .t.b1
    event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
    update
    set focusInfo {}
    event gen .t.b1 <Leave> -detail NotifyAncestor
    event gen [testwrapper .] <Leave> -detail NotifyAncestor
    update
    list $focusInfo [focus]
} {{out .t.b1 NotifyAncestor
out .t NotifyVirtual
} {}}

test focus-3.1 {SetFocus procedure, create record on focus} \
	{unixOnly testwrapper} {
    toplevel .t2 -width 250 -height 100
    wm geometry .t2 +0+0
    update
    focus -force .t2
    update
    focus
} {.t2}
catch {destroy .t2}
# This test produces no result, but it will generate a protocol
# error if Tk forgets to make the window exist before focussing
# on it.
test focus-3.2 {SetFocus procedure, making window exist} \
	{unixOnly testwrapper} {
    update
    button .b2 -text "Another button"
    focus .b2
    update
} {}
catch {destroy .b2}
update
# The following test doesn't produce a check-able result, but if
# there are bugs it may generate an X protocol error.
test focus-3.3 {SetFocus procedure, delaying claim of X focus} \
	{unixOnly testwrapper} {
    focusSetup
    focus -force .t.b2
    update
} {}
test focus-3.4 {SetFocus procedure, delaying claim of X focus} \
	{unixOnly testwrapper} {
    focusSetup
    wm withdraw .t
    focus -force .t.b2
    toplevel .t2 -width 250 -height 100
    wm geometry .t2 +10+10
    focus -force .t2
    wm withdraw .t2
    update
    wm deiconify .t2
    wm deiconify .t
} {}
catch {destroy .t2}
test focus-3.5 {SetFocus procedure, generating events} \
	{unixOnly testwrapper} {
    focusSetup
    focusClear
    set focusInfo {}
    focus -force .t.b2
    update
    set focusInfo
} {in .t NotifyVirtual
in .t.b2 NotifyAncestor
}
test focus-3.6 {SetFocus procedure, generating events} \
	{unixOnly testwrapper} {
    focusSetup
    focus -force .b
    update
    set focusInfo {}
    focus .t.b2
    update
    set focusInfo
} {out .b NotifyNonlinear
out . NotifyNonlinearVirtual
in .t NotifyNonlinearVirtual
in .t.b2 NotifyNonlinear
}
test focus-3.7 {SetFocus procedure, generating events} \
	{unixOnly nonPortable testwrapper} {
    # Non-portable because some platforms generate extra events.

    focusSetup
    focusClear
    set focusInfo {}
    focus .t.b2
    update
    set focusInfo
} {}

test focus-4.1 {TkFocusDeadWindow procedure} {unixOnly testwrapper} {
    focusSetup
    update
    focus -force .b
    update
    destroy .t
    focus
} {.b}
test focus-4.2 {TkFocusDeadWindow procedure} {unixOnly testwrapper} {
    focusSetup
    update
    focus -force .t.b2
    focus .b
    update
    destroy .t.b2
    update
    focus
} {.b}

# Non-portable due to wm-specific redirection of input focus when
# windows are deleted:

test focus-4.3 {TkFocusDeadWindow procedure} {unixOnly nonPortable testwrapper} {
    focusSetup
    update
    focus .t
    update
    destroy .t
    update
    focus
} {}
test focus-4.4 {TkFocusDeadWindow procedure} {unixOnly testwrapper} {
    focusSetup
    focus -force .t.b2
    update
    destroy .t.b2
    focus
} {.t}

# I don't know how to test most of the remaining procedures of this file
# explicitly;  they've already been exercised by the preceding tests.

# If send is disabled because of inadequate security, don't run any
# of these tests at all.

setupbg
set app [dobg {tk appname}]
set ::tcltest::testConfig(secureServer) 1
if {[catch {send $app set a 0} msg] == 1} {
    if [string match "X server insecure *" $msg] {
	set ::tcltest::testConfig(secureServer) 0
    }
}
cleanupbg
setupbg
test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} \
	{unixOnly testwrapper secureServer} {
    focusSetup
    focus -force .t
    update
    set result [focus]
    send [dobg {tk appname}] {focus -force .; update}
    lappend result [focus]
    focus .t.b2
    update
    lappend result [focus]
} {.t {} {}}

catch {destroy .t}
bind all <FocusIn> {}
bind all <FocusOut> {}
bind all <KeyPress> {}
cleanupbg
fixfocus

test focus-6.1 {miscellaneous - embedded application in same process} \
	{unixOnly testwrapper} {
    eval interp delete [interp slaves]
    catch {destroy .t}
    toplevel .t
    wm geometry .t +0+0
    frame .t.f1 -container 1
    frame .t.f2
    pack .t.f1 .t.f2
572
573
574
575
576
577
578
579

580
581
582
583
584
585
586
    focus .t.f2.e1
    after 300 {set timer 1}
    vwait timer
    set result [list $x [child eval {set x}]]
    interp delete child
    set result
} {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}}
test focus-6.2 {miscellaneous - embedded application in different process} {unixOnly} {

    eval interp delete [interp slaves]
    catch {destroy .t}
    setupbg
    toplevel .t
    wm geometry .t +0+0
    frame .t.f1 -container 1
    frame .t.f2







|
>







604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
    focus .t.f2.e1
    after 300 {set timer 1}
    vwait timer
    set result [list $x [child eval {set x}]]
    interp delete child
    set result
} {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}}
test focus-6.2 {miscellaneous - embedded application in different process} \
	{unixOnly testwrapper} {
    eval interp delete [interp slaves]
    catch {destroy .t}
    setupbg
    toplevel .t
    wm geometry .t +0+0
    frame .t.f1 -container 1
    frame .t.f2
624
625
626
627
628
629
630

















    cleanupbg
    set result
} {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}}

eval destroy [winfo children .]
bind all <FocusIn> {}
bind all <FocusOut> {}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
    cleanupbg
    set result
} {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}}

eval destroy [winfo children .]
bind all <FocusIn> {}
bind all <FocusOut> {}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/focusTcl.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# This file is a Tcl script to test out the features of the script
# file focus.tcl, which includes the procedures tk_focusNext and
# tk_focusPrev, among other things.  This file is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) focusTcl.test 1.7 96/09/26 10:25:58

if {[info procs test] != "test"} {
    source defs
}

eval destroy [winfo children .]
wm geometry . {}
raise .

proc setup1 w {






|
|
<

|

|
|







1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out the features of the script
# file focus.tcl, which includes the procedures tk_focusNext and
# tk_focusPrev, among other things.  This file is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: focusTcl.test,v 1.1.4.4 1999/03/24 02:54:40 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

eval destroy [winfo children .]
wm geometry . {}
raise .

proc setup1 w {
273
274
275
276
277
278
279

















    bind Frame <Key> {foo}
    list [tk_focusNext .] [tk_focusNext .a]
} {.a .b}

bind Frame <Key> {}
. configure -takefocus 0 -highlightthickness 0
option clear
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
    bind Frame <Key> {foo}
    list [tk_focusNext .] [tk_focusNext .a]
} {.a .b}

bind Frame <Key> {}
. configure -takefocus 0 -highlightthickness 0
option clear

# cleanup
::tcltest::cleanupTests
return













Changes to tests/font.test.

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
# This file is a Tcl script to test out Tk's "font" command
# plus the procedures in tkFont.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) font.test 1.22 97/10/10 14:34:54



if {[string compare test [info procs test]] != 0} {



    source defs
}

catch {destroy .b}
toplevel .b
wm geom .b +0+0
update idletasks

proc setup {} {
    catch {destroy .b.f}
    catch {font delete xyz}
    label .b.f 
    pack .b.f
    update
}

label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Helvetica -12 bold"
pack .b.l
canvas .b.c -closeenough 0 
.b.c create text 0 0 -tags text -anchor nw -just left -font "Helvetica -12 bold"
pack .b.c
update

set ax [winfo reqwidth .b.l]
set ay [winfo reqheight .b.l]
proc getsize {} {
    update


|

|
>
>

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









|





|


|







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
# This file is a Tcl script to test out Tk's "font" command
# plus the procedures in tkFont.c.  It is organized in the
# standard white-box fashion for Tcl tests.
#
# Copyright (c) 1996-1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: font.test,v 1.1.4.6 1999/03/26 00:07:56 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[info commands testfont] != "testfont"} {
    puts "testfont command not available; skipping tests"
    ::tcltest::cleanupTests
    return
}

catch {destroy .b}
toplevel .b
wm geom .b +0+0
update idletasks

proc setup {} {
    catch {destroy .b.f}
    catch {eval font delete [font names]}
    label .b.f 
    pack .b.f
    update
}

label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Courier -12"
pack .b.l
canvas .b.c -closeenough 0 
.b.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12"
pack .b.c
update

set ax [winfo reqwidth .b.l]
set ay [winfo reqheight .b.l]
proc getsize {} {
    update
52
53
54
55
56
57
58











































59
60
61




62

63
64
65

66
67
68

69
70
71
72
73
74
75
76
77
78
79












80

81
82
83

84
85
86
87
88
89
90
91
92
93

94
95
96

97
98
99

100
101
102
103
104
105
106

107
108
109
110
111

112
113
114
115
116

117
118
119
120
121
122
123
124
125
126
127
128
129


130
131
132
133

134
135





136

137
138

139
140
141

142






143
144





145

146
147
148
149
150
151
152
153
154
155
156

157
158

159

160

161
162


163



164
165
166
167
168



169
170
171



172
173
174
175

176
177
178
179

180
181
182
183
184
185
186
187

188
189
190
191
192

193
194

195
196
197

198
199




200

201
202
203










204
205
206
207
208
209
210
211
212
213
214

215
216
217

218
219
220
221
222
223
224





225
226












227

228
229
230
231
232
233
234

235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262

263
264
265
266









267
268

269
270
271
272
273
274

275

276
277
278
279
280
281
282
283
284
285
286
287
288
289
290

291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308






























309
































310
311
312
313
314

315
316
317
318
319
320

321
322
323
324
325

326
327
328
329

330
331
332
333

334
335
336
337

338
339




340

341
342
343






344





345
346
347
348
349
350
351
352















353

354
355
356
357
358

359
360
361
362
363
364
365
366
367

368
369
370
371
372
373
374

375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393




















394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
case $tcl_platform(platform) {
    unix	{set fixed "fixed"}
    windows	{set fixed "courier 12"}
    macintosh	{set fixed "monaco 9"}
}
set times [font actual {times 0} -family]












































test font-1.1 {font command: general} {
    list [catch {font} msg] $msg
} {1 {wrong # args: should be "font option ?arg?"}}




test font-1.2 {font command: actual: arguments} {

    list [catch {font actual xyz -displayof} msg] $msg
} {1 {value for "-displayof" missing}}
test font-1.3 {font command: actual: arguments} {

    list [catch {font actual} msg] $msg
} {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
test font-1.4 {font command: actual: arguments} {

    list [catch {font actual xyz abc def} msg] $msg
} {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
test font-1.5 {font command: actual: arguments} {
    list [catch {font actual {}} msg] $msg
} {1 {font "" doesn't exist}}
test font-1.6 {font command: actual: displayof specified, so skip to next} {
    catch {font actual xyz -displayof . -size}
} {0}
test font-1.7 {font command: actual: displayof specified, so skip to next} {
    lindex [font actual xyz -displayof .] 0
} {-family}












test font-1.8 {font command: actual} {unix || mac} {

    string tolower [font actual {-family times} -family]
} {times}
test font-1.9 {font command: actual} {pcOnly} {

    font actual {-family times} -family
} {Times New Roman}
test font-1.10 {font command: actual} {
    lindex [font actual {-family times}] 0
} {-family}
test font-1.11 {font command: bad option} {
    list [catch {font actual xyz -style} msg] $msg
} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}

test font-2.1 {font command: configure} {

    list [catch {font configure} msg] $msg
} {1 {wrong # args: should be "font configure fontname ?options?"}}
test font-2.2 {font command: configure: non-existent font} {

    list [catch {font configure xyz} msg] $msg
} {1 {named font "xyz" doesn't exist}}
test font-2.3 {font command: configure: "deleted" font} {

    setup
    font create xyz
    .b.f configure -font xyz
    font delete xyz
    list [catch {font configure xyz} msg] $msg
} {1 {named font "xyz" doesn't exist}}
test font-2.4 {font command: configure: get all options} {

    setup
    font create xyz -family xyz
    lindex [font configure xyz] 1
} xyz
test font-2.5 {font command: configure: get one option} {

    setup
    font create xyz -family xyz
    font configure xyz -family
} xyz
test font-2.6 {font command: configure: update existing font} {

    setup
    font create xyz
    font configure xyz -family xyz
    update
    font configure xyz -family
} xyz
test font-2.7 {font command: configure: bad option} {
    setup
    font create xyz
    list [catch {font configure xyz -style} msg] $msg
} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}

test font-3.1 {font command: create: make up name} {


    font delete [font create]
    font delete [font create -family xyz]
} {}
test font-3.2 {font command: create: already exists} {

    setup
    font create xyz





    list [catch {font create xyz} msg] $msg

} {1 {font "xyz" already exists}}
test font-3.3 {font command: create: error recreating "deleted" font} {

    setup
    font create xyz
    .b.f configure -font xyz

    font delete xyz






    list [catch {font create xyz -xyz times} msg] $msg
} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}





test font-3.4 {font command: create: recreate "deleted" font} {

    setup
    font create xyz
    .b.f configure -font xyz
    font delete xyz
    font actual xyz
    font create xyz -family times
    update
    font configure xyz -family
} {times}
test font-3.5 {font command: create: bad option creating new font} {
    setup

    list [catch {font create xyz -xyz times} msg] $msg
} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}

test font-3.6 {font command: create: totally new font} {

    setup

    font create xyz -family xyz
    font configure xyz -family


} {xyz}




test font-4.1 {font command: delete: arguments} {
    list [catch {font delete} msg] $msg
} {1 {wrong # args: should be "font delete fontname ?fontname ...?"}}
test font-4.2 {font command: delete: loop test} {



    font create a -underline 1
    font create b -underline 1
    font create c -underline 1



    font delete a b c
    list [font actual a -underline] [font actual b -underline] [font actual c -underline]
} {0 0 0}
test font-4.3 {font command: delete: non-existent} {

    setup
    list [catch {font delete xyz} msg] $msg
} {1 {named font "xyz" doesn't exist}}
test font-4.4 {font command: delete: mark for later deletion} {

    setup
    font create xyz
    .b.f configure -font xyz
    font delete xyz
    font actual xyz
    list [catch {font configure xyz} msg] $msg
} {1 {named font "xyz" doesn't exist}}
test font-4.5 {font command: delete: actually delete} {

    setup
    font create xyz -underline 1
    font delete xyz
    font actual xyz -underline
} {0}


test font-5.1 {font command: families: arguments} {

    list [catch {font families -displayof} msg] $msg
} {1 {value for "-displayof" missing}}
test font-5.2 {font command: families: arguments} {

    list [catch {font families xyz} msg] $msg
} {1 {wrong # args: should be "font families ?-displayof window?"}}




test font-5.3 {font command: families} {

    font families
    set x {}
} {}











test font-6.1 {font command: measure: arguments} {
    list [catch {font measure xyz -displayof} msg] $msg
} {1 {value for "-displayof" missing}}
test font-6.2 {font command: measure: arguments} {
    list [catch {font measure} msg] $msg
} {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
test font-6.3 {font command: measure: arguments} {
    list [catch {font measure xyz abc def} msg] $msg
} {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
test font-6.4 {font command: measure: arguments} {

    list [catch {font measure {} abc} msg] $msg
} {1 {font "" doesn't exist}}
test font-6.5 {font command: measure} {

    expr [font measure $fixed "abcdefg"]==[font measure $fixed "a"]*7
} {1}

test font-7.1 {font command: metrics: arguments} {
    list [catch {font metrics xyz -displayof} msg] $msg
} {1 {value for "-displayof" missing}}
test font-7.2 {font command: metrics: arguments} {





    list [catch {font metrics} msg] $msg
} {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}












test font-7.3 {font command: metrics: get all metrics} {

    catch {unset a}
    array set a [font metrics {-family xyz}]
    set x [lsort [array names a]]
    unset a
    set x    
} {-ascent -descent -fixed -linespace}
test font-7.4 {font command: metrics: get ascent} {

    catch {expr [font metrics $fixed -ascent]}
} {0}
test font-7.5 {font command: metrics: get descent} {
    catch {expr [font metrics {-family xyz} -descent]}
} {0}
test font-7.6 {font command: metrics: get linespace} {
    catch {expr [font metrics {-family fixed} -linespace]}
} {0}
test font-7.7 {font command: metrics: get fixed} {
    catch {expr [font metrics {-family fixed} -fixed]}
} {0}
test font-7.8 {font command: metrics: get ascent} {
    catch {expr [font metrics {-family xyz} -ascent]}
} {0}
test font-7.9 {font command: metrics: get descent} {
    catch {expr [font metrics {-family xyz} -descent]}
} {0}
test font-7.10 {font command: metrics: get linespace} {
    catch {expr [font metrics {-family fixed} -linespace]}
} {0}
test font-7.11 {font command: metrics: get fixed} {
    catch {expr [font metrics {-family fixed} -fixed]}
} {0}
test font-7.12 {font command: metrics: bad metric} {
    list [catch {font metrics {-family fixed} -xyz} msg] $msg
} {1 {bad metric "-xyz": must be -ascent, -descent, -linespace, or -fixed}}

test font-8.1 {font command: names: arguments} {

    list [catch {font names xyz} msg] $msg
} {1 {wrong # args: should be "font names"}}
test font-8.2 {font command: names} {
    setup









    font create xyz
    font create abc

    set x [lsort [font names]]
    font delete abc
    font delete xyz
    set x
} {abc xyz}
test font-8.3 {font command: names} {

    setup

    font create xyz
    font create abc
    set x [lsort [font names]]
    .b.f config -font xyz
    font delete xyz
    lappend x [font names]
    font delete abc
    set x
} {abc xyz abc}

test font-9.1 {font command: unknown option} {
    list [catch {font xyz} msg] $msg
} {1 {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names}}

test font-10.1 {UpdateDependantFonts procedure: no users} {

    setup
    font create xyz
    font configure xyz -family times
} {}
test font-10.2 {UpdateDependantFonts procedure: pings the widgets} {
    setup
    font create xyz -family times -size 20
    .b.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0
    set a1 [font measure xyz "abcd"]
    update
    set b1 [winfo reqwidth .b.f]
    font configure xyz -family helvetica -size 20
    set a2 [font measure xyz "abcd"]
    update
    set b2 [winfo reqwidth .b.f]
    expr {$a1==$b1 && $a2==$b2}
} {1}































test font-11.1 {Tk_GetFont procedure: bump ref count} {
































    setup
    .b.f config -font {-family fixed}
    lindex [font actual {-family fixed}] 0
} {-family}
test font-11.2 {Tk_GetFont procedure: bump ref count of named font, too} {

    setup
    font create xyz
    .b.f config -font xyz
    lindex [font actual xyz] 0
} {-family}
test font-11.3 {Tk_GetFont procedure: get named font} {

    setup
    font create xyz
    .b.f config -font xyz
} {}
test font-11.4 {Tk_GetFont procedure: get native font} {unixOnly} {

    setup
    .b.f config -font fixed
} {}
test font-11.5 {Tk_GetFont procedure: get native font} {pcOnly} {

    setup
    .b.f config -font oemfixed
} {}
test font-11.6 {Tk_GetFont procedure: get native font} {macOnly} {

    setup
    .b.f config -font application
} {}
test font-11.7 {Tk_GetFont procedure: get attribute font} {

    list [catch {.b.f config -font {xxx yyy zzz}} msg] $msg
} {1 {expected integer but got "yyy"}}




test font-11.8 {Tk_GetFont procedure: get attribute font} {

    lindex [font actual {plan 9}] 0
} {-family}
test font-11.9 {Tk_GetFont procedure: no match} {






    list [catch {font actual {}} msg] $msg





} {1 {font "" doesn't exist}}

test font-12.1 {Tk_NameOfFont procedure} {
    setup
    .b.f config -font {-family fixed}
    .b.f cget -font
} {-family fixed}
















test font-13.1 {Tk_FreeFont procedure: one ref} {

    setup
    .b.f config -font {-family fixed}
    destroy .b.f
} {}
test font-13.2 {Tk_FreeFont procedure: multiple ref} {

    setup
    .b.f config -font {-family fixed}
    button .b.b -font {-family fixed}
    destroy .b.f
    set x [.b.b cget -font]
    destroy .b.b
    set x
} {-family fixed}
test font-13.3 {Tk_FreeFont procedure: named font} {

    setup
    font create xyz
    .b.f config -font xyz
    destroy .b.f
    font names
} {xyz}
test font-13.4 {Tk_FreeFont procedure: named font} {

    setup
    font create xyz -underline 1
    .b.f config -font xyz
    font delete xyz
    set x [font actual xyz -underline]
    destroy .b.f
    list [font actual xyz -underline] $x
} {0 1}
test font-13.5 {Tk_FreeFont procedure: named font not deleted yet} {
    setup
    font create xyz
    .b.f config -font xyz
    button .b.b -font xyz
    font delete xyz
    set x [font actual xyz]
    destroy .b.b
    list [lindex [font actual xyz] 0] [lindex $x 0]
} {-family -family}





















test font-14.1 {Tk_FontId} {
    .b.f config -font "times 20"
    update
} {}

test font-15.1 {Tk_FontMetrics procedure} {
    button .b.w1 -text abc
    entry .b.w2 -text abcd
    update
    destroy .b.w1 .b.w2
} {}

proc psfontname {name} {
    set a [.b.c itemcget text -font]
    .b.c itemconfig text -font $name
    set post [.b.c postscript]
    .b.c itemconfig text -font $a
    set end [string first "findfont" $post]
    incr end -2
    set post [string range $post [expr $end-70] $end]
    set start [string first "gsave" $post]
    return [string range $post [expr $start+7] end]
}
test font-16.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
    set x [font actual {{itc avant garde} 10} -family]
    if {[string match *avant*garde $x]} {
	psfontname "{itc avant garde} 10"
    } else {
	set x {AvantGarde-Book}
    }
} {AvantGarde-Book}
test font-16.2 {Tk_PostscriptFontName procedure: native} {pcOnly} {
    psfontname "arial 10"
} {Helvetica}
test font-16.3 {Tk_PostscriptFontName procedure: native} {pcOnly} {
    psfontname "{times new roman} 10"
} {Times-Roman}
test font-16.4 {Tk_PostscriptFontName procedure: native} {pcOnly} {
    psfontname "{courier new} 10"
} {Courier}
test font-16.5 {Tk_PostscriptFontName procedure: native} {macOnly} {
    psfontname "geneva 10"
} {Helvetica}
test font-16.6 {Tk_PostscriptFontName procedure: native} {macOnly} {
    psfontname "{new york} 10"
} {Times-Roman}
test font-16.7 {Tk_PostscriptFontName procedure: native} {macOnly} {
    psfontname "monaco 10"
} {Courier}
test font-16.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
    set x [font actual {{lucida bright} 10} -family]
    if {[string match lucida*bright $x]} {
	psfontname "{lucida bright} 10"
    } else {
	set x {LucidaBright}
    }
} {LucidaBright}
test font-16.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
    psfontname "{new century schoolbook} 10"
} {NewCenturySchlbk-Roman}
set i 10
foreach p {
    {"avantgarde" AvantGarde-Book AvantGarde-Demi AvantGarde-BookOblique AvantGarde-DemiOblique}
    {"bookman" Bookman-Light Bookman-Demi Bookman-LightItalic Bookman-DemiItalic}
    {"courier" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
    {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
    {"new century schoolbook" NewCenturySchlbk-Roman NewCenturySchlbk-Bold NewCenturySchlbk-Italic NewCenturySchlbk-BoldItalic}
    {"palatino" Palatino-Roman Palatino-Bold Palatino-Italic Palatino-BoldItalic}
    {"symbol" Symbol Symbol Symbol Symbol}
    {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
    {"zapfchancery" ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic}
    {"zapfdingbats" ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats}
} {
    test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} {
	set family [lindex $p 0]
	set x {}
	set i 1
	foreach slant {roman italic} {
	    foreach weight {normal bold} {
		set name [list $family 12 $slant $weight]
		if {[font actual $name -family] == $family} {







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


>
>
>
>
|
>


|
>


|
>


<
<
<
|


|


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


|
>


<
<
<
|



|
>


|
>


|
>






|
>




|
>




|
>






|





|
>
>
|
|
|
|
>


>
>
>
>
>
|
>
|
|
>

|
|
>
|
>
>
>
>
>
>


>
>
>
>
>
|
>


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

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



>
>
>
|
|
|
|
>



|
>





|
|
|
>



|
|
>

|
>


|
>


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


|
>
|
|
|
>



|


|
>
>
>
>
>


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






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

|
>


|

>
>
>
>
>
>
>
>
>


>
|
<
<
<
|
|
>

>


|



<
<
|

<
<
<
<
|
>




|













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




|
>

|
|
<
|
|
>

<
|

|
>



|
>



|
>



|
>


>
>
>
>
|
>


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

|

|



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




|
>








|
>






|
>








|

|








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




|

















|







|


|


|


|


|


|


|







|















|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125



126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151



152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239



240

241
242
243

244
245

246
247
248
249
250
251
252
253
254
255
256
257
258
259



260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310

311
312
313
314
315
316
317
318
319
320
321
322







323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367




368


369
370


371


372


373
374






375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394



395
396
397
398
399
400
401
402
403
404
405


406
407




408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499

500
501
502
503

504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
case $tcl_platform(platform) {
    unix	{set fixed "fixed"}
    windows	{set fixed "courier 12"}
    macintosh	{set fixed "monaco 9"}
}
set times [font actual {times 0} -family]

test font-1.1 {TkFontPkgInit} {
    catch {interp delete foo}
    interp create foo
    foo eval {
	load {} Tk
	wm geometry . +0+0
	update
    }
    interp delete foo
} {}

test font-2.1 {TkFontPkgFree} {
    catch {interp delete foo}
    interp create foo
    set x {}

    # Makes sure that named font was visible only to child interp.

    foo eval {
	load {} Tk
	wm geometry . +0+0
	button .b -font {times 16} -text "hi"
	pack .b
	font create wiggles -family courier -underline 1
	update
    }
    lappend x [catch {font configure wiggles} msg; set msg]

    # Tests cancelling the idle handler for TheWorldHasChanged,
    # because app goes away before idle serviced.
    
    foo eval {
	.b config -font wiggles
	font config wiggles -size 24
	destroy .
    }
    lappend x [foo eval {catch {font families} msg; set msg}]

    interp delete foo
    set x
} {{named font "wiggles" doesn't exist} {can't invoke "font" command:  application has been destroyed}}


test font-3.1 {font command: general} {
    list [catch {font} msg] $msg
} {1 {wrong # args: should be "font option ?arg?"}}
test font-3.2 {font command: general} {
    list [catch {font xyz} msg] $msg
} {1 {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names}}

test font-4.1 {font command: actual: arguments} {
    # (skip < 0)
    list [catch {font actual xyz -displayof} msg] $msg
} {1 {value for "-displayof" missing}}
test font-4.2 {font command: actual: arguments} {
    # (objc < 3) 
    list [catch {font actual} msg] $msg
} {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
test font-4.3 {font command: actual: arguments} {
    # (objc - skip > 4) when skip == 0
    list [catch {font actual xyz abc def} msg] $msg
} {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}



test font-4.4 {font command: actual: displayof specified, so skip to next} {
    catch {font actual xyz -displayof . -size}
} {0}
test font-4.5 {font command: actual: displayof specified, so skip to next} {
    lindex [font actual xyz -displayof .] 0
} {-family}
test font-4.6 {font command: actual: arguments} {
    # (objc - skip > 4) when skip == 2
    list [catch {font actual xyz -displayof . abc def} msg] $msg
} {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
test font-4.7 {font command: actual: arguments} {
    # (tkfont == NULL)
    list [catch {font actual "\{xyz"} msg] $msg
} [list 1 "font \"{xyz\" doesn't exist"]
test font-4.8 {font command: actual: all attributes} {
    # not (objc > 3) so objPtr = NULL
    lindex [font actual {-family times}] 0
} {-family}
test font-4.9 {font command: actual} {macOrUnix} {
    # (objc > 3) so objPtr = objv[3 + skip]
    string tolower [font actual {-family times} -family]
} {times}
test font-4.10 {font command: actual} {pcOnly} {
    # (objc > 3) so objPtr = objv[3 + skip]
    font actual {-family times} -family
} {Times New Roman}



test font-4.11 {font command: bad option} {
    list [catch {font actual xyz -style} msg] $msg
} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}

test font-5.1 {font command: configure} {
    # (objc < 3) 
    list [catch {font configure} msg] $msg
} {1 {wrong # args: should be "font configure fontname ?options?"}}
test font-5.2 {font command: configure: non-existent font} {
    # (namedHashPtr == NULL)
    list [catch {font configure xyz} msg] $msg
} {1 {named font "xyz" doesn't exist}}
test font-5.3 {font command: configure: "deleted" font} {
    # (nfPtr->deletePending != 0) 
    setup
    font create xyz
    .b.f configure -font xyz
    font delete xyz
    list [catch {font configure xyz} msg] $msg
} {1 {named font "xyz" doesn't exist}}
test font-5.4 {font command: configure: get all options} {
    # (objc == 3) so objPtr = NULL
    setup
    font create xyz -family xyz
    lindex [font configure xyz] 1
} xyz
test font-5.5 {font command: configure: get one option} {
    # (objc == 4) so objPtr = objv[3]
    setup
    font create xyz -family xyz
    font configure xyz -family
} xyz
test font-5.6 {font command: configure: update existing font} {
    # else result = ConfigAttributesObj()
    setup
    font create xyz
    font configure xyz -family xyz
    update
    font configure xyz -family
} xyz
test font-5.7 {font command: configure: bad option} {
    setup
    font create xyz
    list [catch {font configure xyz -style} msg] $msg
} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}

test font-6.1 {font command: create: make up name} {
    # (objc < 3) so name = NULL
    setup
    font create
    font names
} {font1}
test font-6.2 {font command: create: name specified} {
    # not (objc < 3)
    setup
    font create xyz
    font names
} {xyz}
test font-6.3 {font command: create: name not really specified} {
    # (name[0] == '-') so name = NULL
    setup
    font create -family xyz
    font names
} {font1}
test font-6.4 {font command: create: generate name} {
    # (name == NULL)
    setup
    font create -family one
    font create -family two
    font create -family three
    font delete font2
    font create -family four
    font configure font2 -family
} {four}
test font-6.5 {font command: create: bad option creating new font} {
    # name was specified so skip = 3 
    setup
    list [catch {font create xyz -xyz times} msg] $msg
} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
test font-6.6 {font command: create: bad option creating new font} {
    # name was not specified so skip = 2 
    setup
    list [catch {font create -xyz times} msg] $msg
} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
test font-6.7 {font command: create: already exists} {
    # (CreateNamedFont() != TCL_OK)
    setup
    font create xyz



    list [catch {font create xyz} msg] $msg

} {1 {named font "xyz" already exists}}

test font-7.1 {font command: delete: arguments} {

    # (objc < 3) 
    list [catch {font delete} msg] $msg

} {1 {wrong # args: should be "font delete fontname ?fontname ...?"}}
test font-7.2 {font command: delete: loop test} {
    # for (i = 2; i < objc; i++) 
    setup
    set x {}
    font create a -underline 1
    font create b -underline 1
    font create c -underline 1
    font create d -underline 1
    font create e -underline 1
    lappend x [lsort [font names]]
    font delete a e c b
    lappend x [lsort [font names]]
} {{a b c d e} d}



test font-7.3 {font command: delete: loop test} {
    # (namedHashPtr == NULL) in middle of loop
    setup
    set x {}
    font create a -underline 1
    font create b -underline 1
    font create c -underline 1
    font create d -underline 1
    font create e -underline 1
    lappend x [lsort [font names]]
    catch {font delete a d q c e b}
    lappend x [lsort [font names]]
} {{a b c d e} {b c e}}
test font-7.4 {font command: delete: non-existent} {
    # (namedHashPtr == NULL) 
    setup
    list [catch {font delete xyz} msg] $msg
} {1 {named font "xyz" doesn't exist}}
test font-7.5 {font command: delete: mark for later deletion} {
    # (nfPtr->refCount != 0)
    setup
    font create xyz
    .b.f configure -font xyz
    font delete xyz
    font actual xyz
    list [catch {font configure xyz} msg] $msg [.b.f cget -font]
} {1 {named font "xyz" doesn't exist} xyz}
test font-7.6 {font command: delete: actually delete} {
    # not (nfPtr->refCount != 0)
    setup
    font create xyz -underline 1
    font delete xyz
    catch {font config xyz}
} {1}
setup

test font-8.1 {font command: families: arguments} {
    # (skip < 0)
    list [catch {font families -displayof} msg] $msg
} {1 {value for "-displayof" missing}}
test font-8.2 {font command: families: arguments} {
    # (objc - skip != 2) when skip == 0
    list [catch {font families xyz} msg] $msg
} {1 {wrong # args: should be "font families ?-displayof window?"}}
test font-8.3 {font command: families: arguments} {
    # (objc - skip != 2) when skip == 2
    list [catch {font families -displayof . xyz} msg] $msg
} {1 {wrong # args: should be "font families ?-displayof window?"}}
test font-8.4 {font command: families} {
    # TkpGetFontFamilies()
    regexp -nocase times [font families]

} {1}

test font-9.1 {font command: measure: arguments} {
    # (skip < 0)
    list [catch {font measure xyz -displayof} msg] $msg
} {1 {value for "-displayof" missing}}
test font-9.2 {font command: measure: arguments} {
    # (objc - skip != 4) 
    list [catch {font measure} msg] $msg
} {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
test font-9.3 {font command: measure: arguments} {
    # (objc - skip != 4) 







    list [catch {font measure xyz abc def} msg] $msg
} {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
test font-9.4 {font command: measure: arguments} {
    # (tkfont == NULL)
    list [catch {font measure "\{xyz" abc} msg] $msg
} [list 1 "font \"{xyz\" doesn't exist"]
test font-9.5 {font command: measure} {
    # Tk_TextWidth()
    expr [font measure $fixed "abcdefg"]==[font measure $fixed "a"]*7
} {1}

test font-10.1 {font command: metrics: arguments} {
    list [catch {font metrics xyz -displayof} msg] $msg
} {1 {value for "-displayof" missing}}
test font-10.2 {font command: metrics: arguments} {
    # (skip < 0)
    list [catch {font metrics xyz -displayof} msg] $msg
} {1 {value for "-displayof" missing}}
test font-10.3 {font command: metrics: arguments} {
    # (objc < 3) 
    list [catch {font metrics} msg] $msg
} {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}
test font-10.4 {font command: metrics: arguments} {
    # (objc - skip) > 4) when skip == 0
    list [catch {font metrics xyz abc def} msg] $msg
} {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}
test font-10.5 {font command: metrics: arguments} {
    # (objc - skip) > 4) when skip == 2
    list [catch {font metrics xyz -displayof . abc} msg] $msg
} {1 {bad metric "abc": must be -ascent, -descent, -linespace, or -fixed}}
test font-10.6 {font command: metrics: bad font} {
    # (tkfont == NULL)
    list [catch {font metrics "\{xyz"} msg] $msg
} [list 1 "font \"{xyz\" doesn't exist"]
test font-10.7 {font command: metrics: get all metrics} {
    # (objc == 3)
    catch {unset a}
    array set a [font metrics {-family xyz}]
    set x [lsort [array names a]]
    unset a
    set x    
} {-ascent -descent -fixed -linespace}
test font-10.8 {font command: metrics: bad metric} {
    # (Tcl_GetIndexFromObj() != TCL_OK)
    list [catch {font metrics $fixed -xyz} msg] $msg




} {1 {bad metric "-xyz": must be -ascent, -descent, -linespace, or -fixed}}


test font-10.9 {font command: metrics: get individual metrics} {
    font metrics $fixed -ascent


    font metrics $fixed -descent


    font metrics $fixed -linespace


    font metrics $fixed -fixed
} {1}







test font-11.1 {font command: names: arguments} {
    # (objc != 2)
    list [catch {font names xyz} msg] $msg
} {1 {wrong # args: should be "font names"}}
test font-11.2 {font command: names: loop test: no passes} {
    setup
    font names
} {}
test font-11.3 {font command: names: loop test: one pass} {
    setup
    font create
    font names
} {font1}
test font-11.4 {font command: names: loop test: multiple passes} {
    setup
    font create xyz
    font create abc
    font create def
    lsort [font names]



} {abc def xyz}
test font-11.5 {font command: names: skip deletePending fonts} {
    # (nfPtr->deletePending == 0)
    setup
    set x {}
    font create xyz
    font create abc
    lappend x [lsort [font names]]
    .b.f config -font xyz
    font delete xyz
    lappend x [font names]


} {{abc xyz} abc}





test font-12.1 {UpdateDependantFonts procedure: no users} {
    # (nfPtr->refCount == 0)
    setup
    font create xyz
    font configure xyz -family times
} {}
test font-12.2 {UpdateDependantFonts procedure: pings the widgets} {
    setup
    font create xyz -family times -size 20
    .b.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0
    set a1 [font measure xyz "abcd"]
    update
    set b1 [winfo reqwidth .b.f]
    font configure xyz -family helvetica -size 20
    set a2 [font measure xyz "abcd"]
    update
    set b2 [winfo reqwidth .b.f]
    expr {$a1==$b1 && $a2==$b2}
} {1}

test font-13.1 {CreateNamedFont: new named font} {
    # not (new == 0)
    setup
    set x {}
    lappend x [font names]
    font create xyz
    lappend x [font names]
} {{} xyz}
test font-13.2 {CreateNamedFont: named font already exists} {
    # (new == 0)
    setup
    font create xyz
    list [catch {font create xyz} msg] $msg
} {1 {named font "xyz" already exists}}
test font-13.3 {CreateNamedFont: named font already exists} {
    # (nfPtr->deletePending == 0)
    setup
    font create xyz
    list [catch {font create xyz} msg] $msg
} {1 {named font "xyz" already exists}}
test font-13.4 {CreateNamedFont: recreate "deleted" font} {
    # not (nfPtr->deletePending == 0)
    setup
    font create xyz -family times
    .b.f configure -font xyz
    font delete xyz
    font create xyz -family courier
    font configure xyz -family
} {courier}

test font-14.1 {Tk_GetFont procedure} {
} {}

test font-15.1 {Tk_AllocFontFromObj - converting internal reps} {
    set x {Times 16}
    lindex $x 0
    destroy .b1 .b2
    button .b1 -font $x
    lindex $x 0
    testfont counts {Times 16}
} {{1 0}}
test font-15.2 {Tk_AllocFontFromObj - discard stale font} {
    set x {Times 16}
    destroy .b1 .b2
    button .b1 -font $x
    destroy .b1
    set result {}
    lappend result [testfont counts {Times 16}]
    button .b2 -font $x
    lappend result [testfont counts {Times 16}]
} {{} {{1 1}}}
test font-15.3 {Tk_AllocFontFromObj - reuse existing font} {
    set x {Times 16}
    destroy .b1 .b2
    button .b1 -font $x
    set result {}
    lappend result [testfont counts {Times 16}]
    button .b2 -font $x
    pack .b1 .b2 -side top
    lappend result [testfont counts {Times 16}]
} {{{1 1}} {{2 1}}}
test font-15.4 {Tk_AllocFontFromObj procedure: bump ref count} {
    # (new == 0)
    setup
    .b.f config -font {-family fixed}
    lindex [font actual {-family fixed}] 0
} {-family}
test font-15.5 {Tk_AllocFontFromObj procedure: get named font} {
    # (namedHashPtr != NULL) 
    setup
    font create xyz 
    .b.f config -font xyz 

} {}
test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} {
    # not (namedHashPtr != NULL)
    setup

    .b.f config -font {times 20}
} {}
test font-15.7 {Tk_AllocFontFromObj procedure: get native font} {unixOnly} {
    # not (fontPtr == NULL) 
    setup
    .b.f config -font fixed
} {}
test font-15.8 {Tk_AllocFontFromObj procedure: get native font} {pcOnly} {
    # not (fontPtr == NULL) 
    setup
    .b.f config -font oemfixed
} {}
test font-15.9 {Tk_AllocFontFromObj procedure: get native font} {macOnly} {
    # not (fontPtr == NULL) 
    setup
    .b.f config -font application
} {}
test font-15.10 {Tk_AllocFontFromObj procedure: get attribute font} {
    # (fontPtr == NULL) 
    list [catch {.b.f config -font {xxx yyy zzz}} msg] $msg
} {1 {expected integer but got "yyy"}}
test font-15.11 {Tk_AllocFontFromObj procedure: no match} {
    # (ParseFontNameObj() != TCL_OK)
    list [catch {font actual "\{xyz"} msg] $msg
} [list 1 "font \"{xyz\" doesn't exist"]
test font-15.12 {Tk_AllocFontFromObj procedure: get attribute font} {
    # not (ParseFontNameObj() != TCL_OK)
    lindex [font actual {plan 9}] 0
} {-family}
test font-15.13 {Tk_AllocFontFromObj procedure: setup tab width} {
    # Tk_MeasureChars(fontPtr, "0", ...)
    label .l -bd 0 -padx 0  -highlightthickness 0 -font $fixed -text "a\tb"
    update
    set x [winfo reqwidth .l]
    destroy .l
    set x
} [expr [font measure $fixed "0"]*9]
test font-15.14 {Tk_AllocFontFromObj procedure: underline position} {
    # (fontPtr->underlineHeight == 0) because size was < 10
    setup
    .b.f config -text "underline" -font "times -8 underline"
    update
} {}    

test font-16.1 {Tk_NameOfFont procedure} {
    setup
    .b.f config -font -family\ fixed
    .b.f cget -font
} {-family fixed}

test font-17.1 {Tk_FreeFontFromObj - reference counts} {
    set x {Courier 12}
    destroy .b1 .b2 .b3
    button .b1 -font $x
    button .b3 -font $x
    button .b2 -font $x
    set result {}
    lappend result [testfont counts {Courier 12}]
    destroy .b1
    lappend result [testfont counts {Courier 12}]
    destroy .b2
    lappend result [testfont counts {Courier 12}]
    destroy .b3
    lappend result [testfont counts {Courier 12}]
} {{{3 1}} {{2 1}} {{1 1}} {}}
test font-17.2 {Tk_FreeFont procedure: one ref} {
    # (fontPtr->refCount == 0)
    setup
    .b.f config -font {-family fixed}
    destroy .b.f
} {}
test font-17.3 {Tk_FreeFont procedure: multiple ref} {
    # not (fontPtr->refCount == 0)
    setup
    .b.f config -font {-family fixed}
    button .b.b -font {-family fixed}
    destroy .b.f
    set x [.b.b cget -font]
    destroy .b.b
    set x
} {-family fixed}
test font-17.4 {Tk_FreeFont procedure: named font} {
    # (fontPtr->namedHashPtr != NULL) 
    setup
    font create xyz
    .b.f config -font xyz
    destroy .b.f
    font names
} {xyz}
test font-17.5 {Tk_FreeFont procedure: named font} {
    # not (fontPtr->refCount == 0) 
    setup
    font create xyz -underline 1
    .b.f config -font xyz
    font delete xyz
    set x [font actual xyz -underline]
    destroy .b.f
    list [font actual xyz -underline] $x
} {0 1}
test font-17.6 {Tk_FreeFont procedure: named font not deleted yet} {
    setup
    font create xyz 
    .b.f config -font xyz
    button .b.b -font xyz
    font delete xyz
    set x [font actual xyz]
    destroy .b.b
    list [lindex [font actual xyz] 0] [lindex $x 0]
} {-family -family}

test font-18.1 {FreeFontObjProc} {
    destroy .b1
    set x [format {Courier 12}]
    button .b1 -font $x
    set y [format {Courier 12}]
    .b1 configure -font $y
    set z [format {Courier 12}]
    .b1 configure -font $z
    set result {}
    lappend result [testfont counts {Courier 12}]
    set x red
    lappend result [testfont counts {Courier 12}]
    set z 32
    lappend result [testfont counts {Courier 12}]
    destroy .b1
    lappend result [testfont counts {Courier 12}]
    set y bogus
    set result
} {{{1 3}} {{1 2}} {{1 1}} {}}

test font-19.1 {Tk_FontId} {
    .b.f config -font "times 20"
    update
} {}

test font-20.1 {Tk_GetFontMetrics procedure} {
    button .b.w1 -text abc
    entry .b.w2 -text abcd
    update
    destroy .b.w1 .b.w2
} {}

proc psfontname {name} {
    set a [.b.c itemcget text -font]
    .b.c itemconfig text -font $name
    set post [.b.c postscript]
    .b.c itemconfig text -font $a
    set end [string first "findfont" $post]
    incr end -2
    set post [string range $post [expr $end-70] $end]
    set start [string first "gsave" $post]
    return [string range $post [expr $start+7] end]
}
test font-21.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
    set x [font actual {{itc avant garde} 10} -family]
    if {[string match *avant*garde $x]} {
	psfontname "{itc avant garde} 10"
    } else {
	set x {AvantGarde-Book}
    }
} {AvantGarde-Book}
test font-21.2 {Tk_PostscriptFontName procedure: native} {pcOnly} {
    psfontname "arial 10"
} {Helvetica}
test font-21.3 {Tk_PostscriptFontName procedure: native} {pcOnly} {
    psfontname "{times new roman} 10"
} {Times-Roman}
test font-21.4 {Tk_PostscriptFontName procedure: native} {pcOnly} {
    psfontname "{courier new} 10"
} {Courier}
test font-21.5 {Tk_PostscriptFontName procedure: native} {macOnly} {
    psfontname "geneva 10"
} {Helvetica}
test font-21.6 {Tk_PostscriptFontName procedure: native} {macOnly} {
    psfontname "{new york} 10"
} {Times-Roman}
test font-21.7 {Tk_PostscriptFontName procedure: native} {macOnly} {
    psfontname "monaco 10"
} {Courier}
test font-21.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
    set x [font actual {{lucida bright} 10} -family]
    if {[string match lucida*bright $x]} {
	psfontname "{lucida bright} 10"
    } else {
	set x {LucidaBright}
    }
} {LucidaBright}
test font-21.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
    psfontname "{new century schoolbook} 10"
} {NewCenturySchlbk-Roman}
set i 10
foreach p {
    {"avantgarde" AvantGarde-Book AvantGarde-Demi AvantGarde-BookOblique AvantGarde-DemiOblique}
    {"bookman" Bookman-Light Bookman-Demi Bookman-LightItalic Bookman-DemiItalic}
    {"courier" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
    {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
    {"new century schoolbook" NewCenturySchlbk-Roman NewCenturySchlbk-Bold NewCenturySchlbk-Italic NewCenturySchlbk-BoldItalic}
    {"palatino" Palatino-Roman Palatino-Bold Palatino-Italic Palatino-BoldItalic}
    {"symbol" Symbol Symbol Symbol Symbol}
    {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
    {"zapfchancery" ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic}
    {"zapfdingbats" ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats}
} {
    test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} {
	set family [lindex $p 0]
	set x {}
	set i 1
	foreach slant {roman italic} {
	    foreach weight {normal bold} {
		set name [list $family 12 $slant $weight]
		if {[font actual $name -family] == $family} {
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526




527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
foreach p {
    {"arial" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
    {"courier new" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
    {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
    {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
    {"times new roman" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
} {
    test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} {
	set family [lindex $p 0]
	set x {}
	foreach slant {roman italic} {
	    foreach weight {normal bold} {
		lappend x [psfontname [list $family 12 "$slant $weight"]]
	    }
	}
        incr i
	set x
    } [lrange $p 1 end]
}
foreach p {
    {"courier" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
    {"geneva" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
    {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
    {"monaco" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
    {"new york" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
    {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
    {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
} {
    test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {macOnly} {
	set family [lindex $p 0]
	set x {}
	foreach slant {roman italic} {
	    foreach weight {normal bold} {
		lappend x [psfontname [list $family 12 $slant $weight]]
	    }
	}
	incr i
	set x
    } [lrange $p 1 end]
}





test font-17.1 {Tk_UnderlineChars procedure} {
    text .b.t
    .b.t insert 1.0 abc\tdefg
    .b.t tag config sel -underline 1
    .b.t tag add sel 1.0 end
    update
} {}

setup
test font-18.1 {Tk_ComputeTextLayout: empty string} {
    .b.l config -text ""
} {}
test font-18.2 {Tk_ComputeTextLayout: simple string} {
    .b.l config -text "000"
    getsize
} "[expr $ax*3] $ay"
test font-18.3 {Tk_ComputeTextLayout: find special chars} {
    .b.l config -text "000\n000"
    getsize
} "[expr $ax*3] [expr $ay*2]"
test font-18.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} {
    .b.l config -text "000\n000"
    getsize
} "[expr $ax*3] [expr $ay*2]"
test font-18.5 {Tk_ComputeTextLayout: break line} {
    .b.l config -text "000\t00000" -wrap [expr 9*$ax]
    set x [getsize]
    .b.l config -wrap 0
    set x
} "[expr 8*$ax] [expr 2*$ay]"
test font-18.6 {Tk_ComputeTextLayout: normal ended on special char} {
    .b.l config -text "000\n000"
} {}
test font-18.7 {Tk_ComputeTextLayout: special char was \n} {
    .b.l config -text "000\n0000"
    getsize
} "[expr $ax*4] [expr $ay*2]"
test font-18.8 {Tk_ComputeTextLayout: special char was \t} {
    .b.l config -text "000\t00"
    getsize
} "[expr $ax*10] $ay"
test font-18.9 {Tk_ComputeTextLayout: tab didn't cause break} {
    set x {}
    .b.l config -text "000\t000"
    lappend x [getsize]
    .b.l config -text "000\t000" -wrap [expr 100*$ax]
    lappend x [getsize]
    .b.l config -wrap 0
    set x
} "{[expr $ax*11] $ay} {[expr $ax*11] $ay}"
test font-18.10 {Tk_ComputeTextLayout: tab caused break} {
    set x {}
    .b.l config -text "000\t"
    lappend x [getsize]
    .b.l config -text "000\t00" -wrap [expr $ax*6]
    lappend x [getsize]
    .b.l config -wrap 0
    set x
} "{[expr $ax*3] $ay} {[expr $ax*3] [expr $ay*2]}"
test font-18.11 {Tk_ComputeTextLayout: absorb spaces at eol} {
    set x {}
    .b.l config -text "000            000" -wrap [expr $ax*5]
    lappend x [getsize]
    .b.l config -text "000            "
    lappend x [getsize]
    .b.l config -wrap 0
    set x
} "{[expr $ax*3] [expr $ay*2]} {[expr $ax*3] $ay}"
test font-18.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} {
    set x {}
    .b.l config -text "000            0000" -wrap [expr $ax*5]
    lappend x [getsize]
    .b.l config -text "000\t00            0000" -wrap [expr $ax*12]
    lappend x [getsize]
    .b.l config -wrap 0
    set x
} "{[expr $ax*4] [expr $ay*2]} {[expr $ax*10] [expr $ay*2]}"
test font-18.13 {Tk_ComputeTextLayout: many lines -> realloc line array} {
    .b.l config -text "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
    getsize
} "1 [expr $ay*129]"
test font-18.14 {Tk_ComputeTextLayout: text ended with \n} {
    list [.b.l config -text "0000"; getsize] [.b.l config -text "0000\n"; getsize]
} "{[expr $ax*4] $ay} {[expr $ax*4] [expr $ay*2]}"
test font-18.15 {Tk_ComputeTextLayout: justification} {
    csetup "000\n00000"
    set x {}
    .b.c itemconfig text -just left
    lappend x [.b.c index text @[expr $ax*2],0]
    .b.c itemconfig text -just center
    lappend x [.b.c index text @[expr $ax*2],0]
    .b.c itemconfig text -just right
    lappend x [.b.c index text @[expr $ax*2],0]
    .b.c itemconfig text -just left
    set x
} {2 1 0}

test font-19.1 {Tk_FreeTextLayout procedure} {
    setup
    .b.f config -text foo
    .b.f config -text boo
} {}
    
test font-20.1 {Tk_DrawTextLayout procedure: auto-detect last char} {
    .b.f config -text foo
} {}
test font-20.2 {Tk_DrawTextLayout procedure: multiple chunks} {
    csetup "000\t00\n000"
} {}
test font-20.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} {
    csetup "000\t00"
    .b.c select from text 3
    .b.c select to text 5
} {}
test font-20.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} {
    .b.c select from text 3
    .b.c select to text 5
} {}
test font-20.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} {
    .b.c select from text 2
    .b.c select to text 2
} {}
test font-20.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} {
    .b.c select from text 4
    .b.c select to text 4
} {}

test font-21.1 {Tk_UnderlineTextLayout procedure: no underline chosen} {
    .b.f config -text "foo" -under -1
} {}
test font-21.2 {Tk_UnderlineTextLayout procedure: underline not visible} {
    .b.f config -text "000          00000" -wrap [expr $ax*7] -under 10
} {}
test font-21.3 {Tk_UnderlineTextLayout procedure: underline is visible} {
    .b.f config -text "000          00000" -wrap [expr $ax*7] -under 5
    .b.f config -wrap -1 -under -1
} {}
    
test font-22.1 {Tk_PointToChar procedure: above all lines} {
    csetup "000"
    .b.c index text @-1,0
} {0}
test font-22.2 {Tk_PointToChar procedure: no chars} {
    # After fixing the following bug:
    #
    # In canvas text item, it was impossible to click to position the
    # insertion point just after the last character.
    #
    # introduced another bug that Tk_PointToChar() would return a character
    # index of 1 if TextLayout contained 0 characters.

    csetup ""
    .b.c index text @100,100
} {0}
test font-22.3 {Tk_PointToChar procedure: loop test} {
    csetup "000\n000\n000\n000"
    .b.c index text @10000,0
} {3}
test font-22.4 {Tk_PointToChar procedure: intersect line} {
    csetup "000\n000\n000"
    .b.c index text @0,$ay
} {4}
test font-22.5 {Tk_PointToChar procedure: to the left of all chunks} {
    .b.c index text @-100,$ay
} {4}
test font-22.6 {Tk_PointToChar procedure: past any possible chunk} {
    .b.c index text @100000,$ay
} {7}
test font-22.7 {Tk_PointToChar procedure: which chunk on this line} {
    csetup "000\n000\t000\t000\n000"
    .b.c index text @[expr $ax*2],$ay
} {6}
test font-22.8 {Tk_PointToChar procedure: which chunk on this line} {
    csetup "000\n000\t000\t000\n000"
    .b.c index text @[expr $ax*10],$ay
} {10}
test font-22.9 {Tk_PointToChar procedure: in special chunk} {
    csetup "000\n000\t000\t000\n000"
    .b.c index text @[expr $ax*6],$ay
} {7}
test font-22.10 {Tk_PointToChar procedure: past all chars in chunk} {
    csetup "000 0000000"
    .b.c itemconfig text -width [expr $ax*5]
    set x [.b.c index text @[expr $ax*5],0]
    .b.c itemconfig text -width 0
    set x
} {3}
test font-22.11 {Tk_PointToChar procedure: below all chunks} {
    csetup "000 0000000"
    .b.c index text @0,1000000
} {11}
    
test font-23.1 {Tk_CharBBox procedure: index < 0} {
    .b.f config -text "000" -underline -1
} {}
test font-23.2 {Tk_CharBBox procedure: loop} {
    .b.f config -text "000\t000\t000\t000" -underline 9
} {}
test font-23.3 {Tk_CharBBox procedure: special char} {
    .b.f config -text "000\t000\t000" -underline 7
} {}
test font-23.4 {Tk_CharBBox procedure: normal char} {
    .b.f config -text "000" -underline 1
} {}
test font-23.5 {Tk_CharBBox procedure: right edge of bbox truncated} {
    .b.f config -text "0    0000" -wrap [expr $ax*4] -under 2
    .b.f config -wrap 0
} {}
test font-23.6 {Tk_CharBBox procedure: bbox pegged to right edge} {
    .b.f config -text "0    0000" -wrap [expr $ax*4] -under 3
    .b.f config -wrap 0
} {}

.b.c bind all <Enter> {lappend x [.b.c index current @%x,%y]}

test font-24.1 {Tk_TextLayoutToPoint procedure: loop once} {
    csetup "000\n000\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x 0 -y 0
    set x
} {0}
test font-24.2 {Tk_TextLayoutToPoint procedure: loop multiple} {
    csetup "000\n000\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x $ax -y $ay
    set x
} {5}
test font-24.3 {Tk_TextLayoutToPoint procedure: loop to end} {
    csetup "000\n0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*2] -y $ay
    set x
} {}
test font-24.4 {Tk_TextLayoutToPoint procedure: hit a special char (tab)} {
    csetup "000\t000\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*6] -y 0
    set x
} {3}
test font-24.5 {Tk_TextLayoutToPoint procedure: ignore newline} {
    csetup "000\n0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*2] -y $ay
    set x
} {}
test font-24.6 {Tk_TextLayoutToPoint procedure: ignore spaces at eol} {
    csetup "000\n000      000000000"
    .b.c itemconfig text -width [expr $ax*10]
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*5] -y $ay
    .b.c itemconfig text -width 0
    set x
} {}
.b.c itemconfig text -justify center
test font-24.7 {Tk_TextLayoutToPoint procedure: on left side} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x 0 -y 0
    set x
} {}
test font-24.8 {Tk_TextLayoutToPoint procedure: on right side} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*2] -y 0
    set x
} {}
test font-24.9 {Tk_TextLayoutToPoint procedure: inside line} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x $ax -y 0
    set x
} {0}
test font-24.10 {Tk_TextLayoutToPoint procedure: above line} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x 0 -y 0
    set x
} {}
test font-24.11 {Tk_TextLayoutToPoint procedure: below line} {
    csetup "000\n0"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x 0 -y $ay
    set x
} {}
test font-24.12 {Tk_TextLayoutToPoint procedure: in line} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x $ax -y $ay
    set x
} {3}
.b.c itemconfig text -justify left
test font-24.13 {Tk_TextLayoutToPoint procedure: exact hit} {
    csetup "000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x $ax -y 0
    set x
} {1}

test font-25.1 {Tk_TextLayoutToArea procedure: loop once} {
    csetup "000\n000\n000"
    .b.c find overlapping 0 0 0 0
} [.b.c find withtag text]
test font-25.2 {Tk_TextLayoutToArea procedure: loop multiple} {
    csetup "000\t000\t000"
    .b.c find overlapping [expr $ax*10] 0 [expr $ax*10] 0
} [.b.c find withtag text]
test font-25.3 {Tk_TextLayoutToArea procedure: loop to end} {
    csetup "0\n000"
    .b.c find overlapping [expr $ax*2] 0 [expr $ax*2] 0
} {}
test font-25.4 {Tk_TextLayoutToArea procedure: hit a special char (tab)} {
    csetup "000\t000"
    .b.c find overlapping [expr $ax*6] 0 [expr $ax*6] 0
} [.b.c find withtag text]
test font-25.5 {Tk_TextLayoutToArea procedure: ignore newlines} {
    csetup "000\n0\n000"
    .b.c find overlapping $ax $ay $ax $ay
} {}
test font-25.6 {Tk_TextLayoutToArea procedure: ignore spaces at eol} {
    csetup "000\n000      000000000"
    .b.c itemconfig text -width [expr $ax*10]
    set x [.b.c find overlapping [expr $ax*5] $ay [expr $ax*5] $ay]
    .b.c itemconfig text -width 0
    set x
} {}

test font-26.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
    # If there were a whole bunch of returns or tabs in a row, then the
    # temporary buffer could overflow and write on the stack.
    
    csetup "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm\n"
    .b.c itemconfig text -width 800
    .b.c insert text end "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm\n"
    .b.c insert text end "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"







|




















|












>
>
>
>
|








|


|



|



|



|





|


|



|



|








|








|








|








|



|


|












|





|


|


|




|



|



|




|


|


|




|



|











|



|



|


|


|



|



|



|






|




|


|


|


|


|



|






|






|






|






|






|






|









|






|






|






|






|






|







|







|



|



|



|



|



|







|







726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
foreach p {
    {"arial" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
    {"courier new" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
    {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
    {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
    {"times new roman" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
} {
    test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} {
	set family [lindex $p 0]
	set x {}
	foreach slant {roman italic} {
	    foreach weight {normal bold} {
		lappend x [psfontname [list $family 12 "$slant $weight"]]
	    }
	}
        incr i
	set x
    } [lrange $p 1 end]
}
foreach p {
    {"courier" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
    {"geneva" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
    {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
    {"monaco" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
    {"new york" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
    {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
    {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
} {
    test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {macOnly} {
	set family [lindex $p 0]
	set x {}
	foreach slant {roman italic} {
	    foreach weight {normal bold} {
		lappend x [psfontname [list $family 12 $slant $weight]]
	    }
	}
	incr i
	set x
    } [lrange $p 1 end]
}

test font-22.1 {Tk_TextWidth procedure} {
    font measure [.b.l cget -font] "000"
} [expr $ax*3]

test font-23.1 {Tk_UnderlineChars procedure} {
    text .b.t
    .b.t insert 1.0 abc\tdefg
    .b.t tag config sel -underline 1
    .b.t tag add sel 1.0 end
    update
} {}

setup
test font-24.1 {Tk_ComputeTextLayout: empty string} {
    .b.l config -text ""
} {}
test font-24.2 {Tk_ComputeTextLayout: simple string} {
    .b.l config -text "000"
    getsize
} "[expr $ax*3] $ay"
test font-24.3 {Tk_ComputeTextLayout: find special chars} {
    .b.l config -text "000\n000"
    getsize
} "[expr $ax*3] [expr $ay*2]"
test font-24.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} {
    .b.l config -text "000\n000"
    getsize
} "[expr $ax*3] [expr $ay*2]"
test font-24.5 {Tk_ComputeTextLayout: break line} {
    .b.l config -text "000\t00000" -wrap [expr 9*$ax]
    set x [getsize]
    .b.l config -wrap 0
    set x
} "[expr 8*$ax] [expr 2*$ay]"
test font-24.6 {Tk_ComputeTextLayout: normal ended on special char} {
    .b.l config -text "000\n000"
} {}
test font-24.7 {Tk_ComputeTextLayout: special char was \n} {
    .b.l config -text "000\n0000"
    getsize
} "[expr $ax*4] [expr $ay*2]"
test font-24.8 {Tk_ComputeTextLayout: special char was \t} {
    .b.l config -text "000\t00"
    getsize
} "[expr $ax*10] $ay"
test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} {
    set x {}
    .b.l config -text "000\t000"
    lappend x [getsize]
    .b.l config -text "000\t000" -wrap [expr 100*$ax]
    lappend x [getsize]
    .b.l config -wrap 0
    set x
} "{[expr $ax*11] $ay} {[expr $ax*11] $ay}"
test font-24.10 {Tk_ComputeTextLayout: tab caused break} {
    set x {}
    .b.l config -text "000\t"
    lappend x [getsize]
    .b.l config -text "000\t00" -wrap [expr $ax*6]
    lappend x [getsize]
    .b.l config -wrap 0
    set x
} "{[expr $ax*3] $ay} {[expr $ax*3] [expr $ay*2]}"
test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} {
    set x {}
    .b.l config -text "000            000" -wrap [expr $ax*5]
    lappend x [getsize]
    .b.l config -text "000            "
    lappend x [getsize]
    .b.l config -wrap 0
    set x
} "{[expr $ax*3] [expr $ay*2]} {[expr $ax*3] $ay}"
test font-24.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} {
    set x {}
    .b.l config -text "000            0000" -wrap [expr $ax*5]
    lappend x [getsize]
    .b.l config -text "000\t00            0000" -wrap [expr $ax*12]
    lappend x [getsize]
    .b.l config -wrap 0
    set x
} "{[expr $ax*4] [expr $ay*2]} {[expr $ax*10] [expr $ay*2]}"
test font-24.13 {Tk_ComputeTextLayout: many lines -> realloc line array} {
    .b.l config -text "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
    getsize
} "1 [expr $ay*129]"
test font-24.14 {Tk_ComputeTextLayout: text ended with \n} {
    list [.b.l config -text "0000"; getsize] [.b.l config -text "0000\n"; getsize]
} "{[expr $ax*4] $ay} {[expr $ax*4] [expr $ay*2]}"
test font-24.15 {Tk_ComputeTextLayout: justification} {
    csetup "000\n00000"
    set x {}
    .b.c itemconfig text -just left
    lappend x [.b.c index text @[expr $ax*2],0]
    .b.c itemconfig text -just center
    lappend x [.b.c index text @[expr $ax*2],0]
    .b.c itemconfig text -just right
    lappend x [.b.c index text @[expr $ax*2],0]
    .b.c itemconfig text -just left
    set x
} {2 1 0}

test font-25.1 {Tk_FreeTextLayout procedure} {
    setup
    .b.f config -text foo
    .b.f config -text boo
} {}
    
test font-26.1 {Tk_DrawTextLayout procedure: auto-detect last char} {
    .b.f config -text foo
} {}
test font-26.2 {Tk_DrawTextLayout procedure: multiple chunks} {
    csetup "000\t00\n000"
} {}
test font-26.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} {
    csetup "000\t00"
    .b.c select from text 3
    .b.c select to text 5
} {}
test font-26.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} {
    .b.c select from text 3
    .b.c select to text 5
} {}
test font-26.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} {
    .b.c select from text 2
    .b.c select to text 2
} {}
test font-26.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} {
    .b.c select from text 4
    .b.c select to text 4
} {}

test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} {
    .b.f config -text "foo" -under -1
} {}
test font-27.2 {Tk_UnderlineTextLayout procedure: underline not visible} {
    .b.f config -text "000          00000" -wrap [expr $ax*7] -under 10
} {}
test font-27.3 {Tk_UnderlineTextLayout procedure: underline is visible} {
    .b.f config -text "000          00000" -wrap [expr $ax*7] -under 5
    .b.f config -wrap -1 -under -1
} {}
    
test font-28.1 {Tk_PointToChar procedure: above all lines} {
    csetup "000"
    .b.c index text @-1,0
} {0}
test font-28.2 {Tk_PointToChar procedure: no chars} {
    # After fixing the following bug:
    #
    # In canvas text item, it was impossible to click to position the
    # insertion point just after the last character.
    #
    # introduced another bug that Tk_PointToChar() would return a character
    # index of 1 if TextLayout contained 0 characters.

    csetup ""
    .b.c index text @100,100
} {0}
test font-28.3 {Tk_PointToChar procedure: loop test} {
    csetup "000\n000\n000\n000"
    .b.c index text @10000,0
} {3}
test font-28.4 {Tk_PointToChar procedure: intersect line} {
    csetup "000\n000\n000"
    .b.c index text @0,$ay
} {4}
test font-28.5 {Tk_PointToChar procedure: to the left of all chunks} {
    .b.c index text @-100,$ay
} {4}
test font-28.6 {Tk_PointToChar procedure: past any possible chunk} {
    .b.c index text @100000,$ay
} {7}
test font-28.7 {Tk_PointToChar procedure: which chunk on this line} {
    csetup "000\n000\t000\t000\n000"
    .b.c index text @[expr $ax*2],$ay
} {6}
test font-28.8 {Tk_PointToChar procedure: which chunk on this line} {
    csetup "000\n000\t000\t000\n000"
    .b.c index text @[expr $ax*10],$ay
} {10}
test font-28.9 {Tk_PointToChar procedure: in special chunk} {
    csetup "000\n000\t000\t000\n000"
    .b.c index text @[expr $ax*6],$ay
} {7}
test font-28.10 {Tk_PointToChar procedure: past all chars in chunk} {
    csetup "000 0000000"
    .b.c itemconfig text -width [expr $ax*5]
    set x [.b.c index text @[expr $ax*5],0]
    .b.c itemconfig text -width 0
    set x
} {3}
test font-28.11 {Tk_PointToChar procedure: below all chunks} {
    csetup "000 0000000"
    .b.c index text @0,1000000
} {11}
    
test font-29.1 {Tk_CharBBox procedure: index < 0} {
    .b.f config -text "000" -underline -1
} {}
test font-29.2 {Tk_CharBBox procedure: loop} {
    .b.f config -text "000\t000\t000\t000" -underline 9
} {}
test font-29.3 {Tk_CharBBox procedure: special char} {
    .b.f config -text "000\t000\t000" -underline 7
} {}
test font-29.4 {Tk_CharBBox procedure: normal char} {
    .b.f config -text "000" -underline 1
} {}
test font-29.5 {Tk_CharBBox procedure: right edge of bbox truncated} {
    .b.f config -text "0    0000" -wrap [expr $ax*4] -under 2
    .b.f config -wrap 0
} {}
test font-29.6 {Tk_CharBBox procedure: bbox pegged to right edge} {
    .b.f config -text "0    0000" -wrap [expr $ax*4] -under 3
    .b.f config -wrap 0
} {}

.b.c bind all <Enter> {lappend x [.b.c index current @%x,%y]}

test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} {
    csetup "000\n000\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x 0 -y 0
    set x
} {0}
test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} {
    csetup "000\n000\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x $ax -y $ay
    set x
} {5}
test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} {
    csetup "000\n0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*2] -y $ay
    set x
} {}
test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} {
    csetup "000\t000\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*6] -y 0
    set x
} {3}
test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} {
    csetup "000\n0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*2] -y $ay
    set x
} {}
test font-30.6 {Tk_DistanceToTextLayout procedure: ignore spaces at eol} {
    csetup "000\n000      000000000"
    .b.c itemconfig text -width [expr $ax*10]
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*5] -y $ay
    .b.c itemconfig text -width 0
    set x
} {}
.b.c itemconfig text -justify center
test font-30.7 {Tk_DistanceToTextLayout procedure: on left side} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x 0 -y 0
    set x
} {}
test font-30.8 {Tk_DistanceToTextLayout procedure: on right side} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x [expr $ax*2] -y 0
    set x
} {}
test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x $ax -y 0
    set x
} {0}
test font-30.10 {Tk_DistanceToTextLayout procedure: above line} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x 0 -y 0
    set x
} {}
test font-30.11 {Tk_DistanceToTextLayout procedure: below line} {
    csetup "000\n0"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x 0 -y $ay
    set x
} {}
test font-30.12 {Tk_DistanceToTextLayout procedure: in line} {
    csetup "0\n000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x $ax -y $ay
    set x
} {3}
.b.c itemconfig text -justify left
test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} {
    csetup "000"
    set x {}
    event generate .b.c <Leave>
    event generate .b.c <Enter> -x $ax -y 0
    set x
} {1}

test font-31.1 {Tk_IntersectTextLayout procedure: loop once} {
    csetup "000\n000\n000"
    .b.c find overlapping 0 0 0 0
} [.b.c find withtag text]
test font-31.2 {Tk_IntersectTextLayout procedure: loop multiple} {
    csetup "000\t000\t000"
    .b.c find overlapping [expr $ax*10] 0 [expr $ax*10] 0
} [.b.c find withtag text]
test font-31.3 {Tk_IntersectTextLayout procedure: loop to end} {
    csetup "0\n000"
    .b.c find overlapping [expr $ax*2] 0 [expr $ax*2] 0
} {}
test font-31.4 {Tk_IntersectTextLayout procedure: hit a special char (tab)} {
    csetup "000\t000"
    .b.c find overlapping [expr $ax*6] 0 [expr $ax*6] 0
} [.b.c find withtag text]
test font-31.5 {Tk_IntersectTextLayout procedure: ignore newlines} {
    csetup "000\n0\n000"
    .b.c find overlapping $ax $ay $ax $ay
} {}
test font-31.6 {Tk_IntersectTextLayout procedure: ignore spaces at eol} {
    csetup "000\n000      000000000"
    .b.c itemconfig text -width [expr $ax*10]
    set x [.b.c find overlapping [expr $ax*5] $ay [expr $ax*5] $ay]
    .b.c itemconfig text -width 0
    set x
} {}

test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
    # If there were a whole bunch of returns or tabs in a row, then the
    # temporary buffer could overflow and write on the stack.
    
    csetup "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm\n"
    .b.c itemconfig text -width 800
    .b.c insert text end "qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm\n"
    .b.c insert text end "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922

923
924
925
926
927
928

929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970









971
972
973

974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019



1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037




1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086


1087





1088


1089



1090


















1091



1092













()
()
()
()
(end)
}

test font-27.1 {Tk_TextWidth procedure} {
    font measure [.b.l cget -font] "000"
} [expr $ax*3]

test font-28.1 {SetupFontMetrics procedure} {
    setup
    .b.f config -font $fixed
} {}

test font-29.1 {TkInitFontAttributes procedure} {

    setup
    font create xyz
    font config xyz
} {-family {} -size 0 -weight normal -slant roman -underline 0 -overstrike 0}

test font-30.1 {ConfigAttributes procedure: arguments} {

    setup
    list [catch {font create xyz -family} msg] $msg
} {1 {missing value for "-family" option}}
test font-30.2 {ConfigAttributes procedure: arguments} {
    setup
    list [catch {font create xyz -xyz xyz} msg] $msg
} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
set i 3
foreach p {
    {family xyz times}
    {size 20 40}
    {weight normal bold}
    {slant roman italic}
    {underline 0 1}
    {overstrike 0 1}
} {
    set opt [lindex $p 0]
    test font-30.$i "ConfigAttributes procedure: $opt" {
	setup
	set x {}
	font create xyz -$opt [lindex $p 1]
	lappend x [font config xyz -$opt]
	font config xyz -$opt [lindex $p 2]
	lappend x [font config xyz -$opt]
    } [lrange $p 1 2]
    incr i
}
foreach p {
    {size	xyz {1 {expected integer but got "xyz"}}}
    {weight	xyz {1 {bad -weight value "xyz": must be normal, bold}}}
    {slant	xyz {1 {bad -slant value "xyz": must be roman, italic}}}
    {underline	xyz {1 {expected boolean value but got "xyz"}}}
    {overstrike	xyz {1 {expected boolean value but got "xyz"}}}
} {
    test font-30.$i "ConfigAttributes procedure: [lindex $p 0]" {
	setup
	list [catch {font create xyz -[lindex $p 0] [lindex $p 1]} msg] $msg
    } [lindex $p 2]
    incr i
}

test font-31.1 {GetAttributeInfo procedure: error} {









    list [catch {font actual xyz -style} msg] $msg
} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
test font-31.2 {GetAttributeInfo procedure: all attributes} {

    setup
    font create xyz -family xyz
    font config xyz
} {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0}
set i 3
foreach p {
    {family	xyz	xyz}
    {size	20	20}
    {weight	normal	normal}
    {slant	italic	italic}
    {underline	yes	1}
    {overstrike	false	0}
} {
    test font-31.$i "GetAttributeInfo procedure: [lindex $p 0]" {
	setup
	font create xyz -[lindex $p 0] [lindex $p 1]
	font config xyz -[lindex $p 0]
    } [lindex $p 2]
    incr i
}

# In tests below, one field is set to "xyz" so that font name doesn't
# look like a native X font, so that ParseFontName or TkParseXLFD will
# be called.

setup

test font-32.1 {ParseFontName procedure: begins with -} {
    lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
test font-32.2 {ParseFontName procedure: begins with -*} {
    lindex [font actual -*-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
test font-32.3 {ParseFontName procedure: begins with -, doesn't look like list} {
    lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
test font-32.4 {ParseFontName procedure: begins with -, looks like list} {
    lindex [font actual {-family times}] 1
} $times
test font-32.5 {ParseFontName procedure: begins with *} {
    lindex [font actual *-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
test font-32.6 {ParseFontName procedure: begins with *} {
    font actual *-times-xyz -family
} $times
test font-32.7 {ParseFontName procedure: arguments} {



    list [catch {font actual {}} msg] $msg
} {1 {font "" doesn't exist}}
test font-32.8 {ParseFontName procedure: arguments} {
    list [catch {font actual {times 20 xyz xyz}} msg] $msg
} {1 {unknown font style "xyz"}}
test font-32.9 {ParseFontName procedure: arguments} {
    list [catch {font actual {times xyz xyz}} msg] $msg
} {1 {expected integer but got "xyz"}}
test font-32.10 {ParseFontName procedure: stylelist loop} {macOnly} {
    lrange [font actual {times 12 bold italic overstrike underline}] 4 end
} {-weight bold -slant italic -underline 1 -overstrike 0}
test font-32.11 {ParseFontName procedure: stylelist loop} {unixOrPc} {
    lrange [font actual {times 12 bold italic overstrike underline}] 4 end
} {-weight bold -slant italic -underline 1 -overstrike 1}
test font-32.12 {ParseFontName procedure: stylelist error} {
    list [catch {font actual {times 12 bold xyz}} msg] $msg
} {1 {unknown font style "xyz"}}





test font-33.1 {TkParseXLFD procedure: initial dash} {
    font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-* -family
} $times
test font-33.2 {TkParseXLFD procedure: no initial dash} {
    font actual *-times-*-*-*-*-*-*-*-*-*-*-*-xyz -family
} $times
test font-33.3 {TkParseXLFD procedure: not enough fields} {
    font actual -xyz-times-*-*-* -family
} $times
test font-33.4 {TkParseXLFD procedure: all fields unspecified} {
    lindex [font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*] 0
} {-family}
test font-33.5 {TkParseXLFD procedure: all fields specified} {
    lindex [font actual -foundry-times-weight-slant-setwidth-addstyle-10-10-10-10-spacing-avgwidth-registry-encoding] 1
} $times
test font-33.6 {TkParseXLFD procedure: arguments} {
    # XLFD with bad pointsize: fallback to some system font.
    font actual -*-*-*-*-*-*-xyz-*-*-*-*-*-*-*
    set x {}
} {}
test font-33.7 {TkParseXLFD procedure: arguments} {
    # XLFD with bad pixelsize: fallback to some system font.
    font actual -*-*-*-*-*-*-*-xyz-*-*-*-*-*-*
    set x {}
} {}
test font-33.8 {TkParseXLFD procedure: pixelsize specified} {
    font metrics -xyz-times-*-*-*-*-12-*-*-*-*-*-*-* -linespace
    set x {}
} {}
test font-33.9 {TkParseXLFD procedure: weird pixelsize specified} {
    font metrics {-xyz-times-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*-*} -linespace
    set x {}
} {}
test font-33.10 {TkParseXLFD procedure: pointsize specified} {
    font metrics -xyz-times-*-*-*-*-*-120-*-*-*-*-*-* -linespace
    set x {}
} {}
test font-33.11 {TkParseXLFD procedure: weird pointsize specified} {
    font metrics {-xyz-times-*-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*} -linespace
    set x {}
} {}

test font-34.1 {FieldSpecified procedure: specified vs. non-specified} {
    font actual -xyz--*-*-*-*-*-*-*-*-*-*-*-*
    font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*
    font actual -xyz-?-*-*-*-*-*-*-*-*-*-*-*-*
    lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
} $times



test font-35.1 {NewChunk procedure: test realloc} {





    .b.f config -text "xxx\nxxx\txxx\nxxx\t\t\t"


} {}






















destroy .b



return




















|
<
<
<
<
<
<


|
>

|
<
<
|
|
>


|
<
<
<
<










|











|
|



|






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




|

















|




|


|


|


|


|


|


|
>
>
>
|

|


|


|


|


|



>
>
>
>
|


|


|


|


|


|




|




|



|



|



|




|






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

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

>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
1150
1151
1152
1153
1154
1155
1156
1157






1158
1159
1160
1161
1162
1163


1164
1165
1166
1167
1168
1169




1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
()
()
()
()
(end)
}

test font-33.1 {Tk_TextWidth procedure} {






} {}

test font-33.2 {ConfigAttributesObj procedure: arguments} {
    # (Tcl_GetIndexFromObj() != TCL_OK)
    setup
    list [catch {font create xyz -xyz} msg] $msg


} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
test font-34.1 {ConfigAttributesObj procedure: arguments} {
    # (objc & 1)
    setup
    list [catch {font create xyz -family} msg] $msg
} {1 {value for "-family" option missing}}




set i 3
foreach p {
    {family xyz times}
    {size 20 40}
    {weight normal bold}
    {slant roman italic}
    {underline 0 1}
    {overstrike 0 1}
} {
    set opt [lindex $p 0]
    test font-34.$i "ConfigAttributesObj procedure: $opt" {
	setup
	set x {}
	font create xyz -$opt [lindex $p 1]
	lappend x [font config xyz -$opt]
	font config xyz -$opt [lindex $p 2]
	lappend x [font config xyz -$opt]
    } [lrange $p 1 2]
    incr i
}
foreach p {
    {size	xyz {1 {expected integer but got "xyz"}}}
    {weight	xyz {1 {bad -weight value "xyz": must be normal, or bold}}}
    {slant	xyz {1 {bad -slant value "xyz": must be roman, or italic}}}
    {underline	xyz {1 {expected boolean value but got "xyz"}}}
    {overstrike	xyz {1 {expected boolean value but got "xyz"}}}
} {
    test font-34.$i "ConfigAttributesObj procedure: [lindex $p 0]" {
	setup
	list [catch {font create xyz -[lindex $p 0] [lindex $p 1]} msg] $msg
    } [lindex $p 2]
    incr i
}

test font-35.1 {GetAttributeInfoObj procedure: one attribute} {
    # (objPtr != NULL)
    setup
    font create xyz -family xyz
    font config xyz -family
} {xyz}
test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} {
    # (Tcl_GetIndexFromObj() != TCL_OK)
    setup
    font create xyz
    list [catch {font config xyz -xyz} msg] $msg
} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
test font-37.1 {GetAttributeInfoObj procedure: all attributes} {
    # not (objPtr != NULL) 
    setup
    font create xyz -family xyz
    font config xyz
} {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0}
set i 4
foreach p {
    {family	xyz	xyz}
    {size	20	20}
    {weight	normal	normal}
    {slant	italic	italic}
    {underline	yes	1}
    {overstrike	false	0}
} {
    test font-31.$i "GetAttributeInfo procedure: [lindex $p 0]" {
	setup
	font create xyz -[lindex $p 0] [lindex $p 1]
	font config xyz -[lindex $p 0]
    } [lindex $p 2]
    incr i
}

# In tests below, one field is set to "xyz" so that font name doesn't
# look like a native X font, so that ParseFontNameObj or TkParseXLFD will
# be called.

setup

test font-38.1 {ParseFontNameObj procedure: begins with -} {
    lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
test font-38.2 {ParseFontNameObj procedure: begins with -*} {
    lindex [font actual -*-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
test font-38.3 {ParseFontNameObj procedure: begins with -, doesn't look like list} {
    lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
test font-38.4 {ParseFontNameObj procedure: begins with -, looks like list} {
    lindex [font actual {-family times}] 1
} $times
test font-38.5 {ParseFontNameObj procedure: begins with *} {
    lindex [font actual *-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
test font-38.6 {ParseFontNameObj procedure: begins with *} {
    font actual *-times-xyz -family
} $times
test font-38.7 {ParseFontNameObj procedure: arguments} {
    list [catch {font actual "\{xyz"} msg] $msg
} [list 1 "font \"{xyz\" doesn't exist"]
test font-38.8 {ParseFontNameObj procedure: arguments} {
    list [catch {font actual ""} msg] $msg
} {1 {font "" doesn't exist}}
test font-38.9 {ParseFontNameObj procedure: arguments} {
    list [catch {font actual {times 20 xyz xyz}} msg] $msg
} {1 {unknown font style "xyz"}}
test font-38.10 {ParseFontNameObj procedure: arguments} {
    list [catch {font actual {times xyz xyz}} msg] $msg
} {1 {expected integer but got "xyz"}}
test font-38.11 {ParseFontNameObj procedure: stylelist loop} {macOnly} {
    lrange [font actual {times 12 bold italic overstrike underline}] 4 end
} {-weight bold -slant italic -underline 1 -overstrike 0}
test font-38.12 {ParseFontNameObj procedure: stylelist loop} {unixOrPc} {
    lrange [font actual {times 12 bold italic overstrike underline}] 4 end
} {-weight bold -slant italic -underline 1 -overstrike 1}
test font-38.13 {ParseFontNameObj procedure: stylelist error} {
    list [catch {font actual {times 12 bold xyz}} msg] $msg
} {1 {unknown font style "xyz"}}

test font-39.1 {NewChunk procedure: test realloc} {
    .b.f config -text "xxx\nxxx\txxx\nxxx\t\t\t"
} {}

test font-40.1 {TkFontParseXLFD procedure: initial dash} {
    font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-* -family
} $times
test font-40.2 {TkFontParseXLFD procedure: no initial dash} {
    font actual *-times-*-*-*-*-*-*-*-*-*-*-*-xyz -family
} $times
test font-40.3 {TkFontParseXLFD procedure: not enough fields} {
    font actual -xyz-times-*-*-* -family
} $times
test font-40.4 {TkFontParseXLFD procedure: all fields unspecified} {
    lindex [font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*] 0
} {-family}
test font-40.5 {TkFontParseXLFD procedure: all fields specified} {
    lindex [font actual -foundry-times-weight-slant-setwidth-addstyle-10-10-10-10-spacing-avgwidth-registry-encoding] 1
} $times
test font-41.1 {TkParseXLFD procedure: arguments} {
    # XLFD with bad pointsize: fallback to some system font.
    font actual -*-*-*-*-*-*-xyz-*-*-*-*-*-*-*
    set x {}
} {}
test font-42.1 {TkFontParseXLFD procedure: arguments} {
    # XLFD with bad pixelsize: fallback to some system font.
    font actual -*-*-*-*-*-*-*-xyz-*-*-*-*-*-*
    set x {}
} {}
test font-42.2 {TkFontParseXLFD procedure: pixelsize specified} {
    font metrics -xyz-times-*-*-*-*-12-*-*-*-*-*-*-* -linespace
    set x {}
} {}
test font-42.3 {TkFontParseXLFD procedure: weird pixelsize specified} {
    font metrics {-xyz-times-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*-*} -linespace
    set x {}
} {}
test font-42.4 {TkFontParseXLFD procedure: pointsize specified} {
    font metrics -xyz-times-*-*-*-*-*-120-*-*-*-*-*-* -linespace
    set x {}
} {}
test font-42.5 {TkFontParseXLFD procedure: weird pointsize specified} {
    font metrics {-xyz-times-*-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*} -linespace
    set x {}
} {}

test font-43.1 {FieldSpecified procedure: specified vs. non-specified} {
    font actual -xyz--*-*-*-*-*-*-*-*-*-*-*-*
    font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*
    font actual -xyz-?-*-*-*-*-*-*-*-*-*-*-*-*
    lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
} $times

set oldscale [tk scaling]
tk scaling 0.5
test font-44.1 {TkFontGetPixels: size < 0} {
    font actual {times -12} -size
} {24}
test font-44.2 {TkFontGetPixels: size >= 0} {
    font actual {times 12} -size
} {12}

test font-45.1 {TkFontGetPoints: size >= 0} {
    font actual {times 12} -size
} {12}
test font-45.2 {TkFontGetPoints: size < 0} {
    font actual {times -12} -size
} {24}

tk scaling $oldscale

test font-46.1 {TkFontGetAliasList: no match} {
    font actual {snarky 10} -family
} [font actual {-size 10} -family]
test font-46.2 {TkFontGetAliasList: match} {macOnly} {
    # Result could be either "Times" or "New York"
    font actual {{times new roman} 10} -family
} [font actual {times 10} -family]
test font-46.3 {TkFontGetAliasList: match} {pcOnly} {
    font actual {times 10} -family
} {Times New Roman}
test font-46.4 {TkFontGetAliasList: match} {unixOnly} {
    font actual {{times new roman} 10} -family
} [font actual {times 10} -family]

setup

destroy .b

# cleanup
::tcltest::cleanupTests
return













Changes to tests/frame.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# This file is a Tcl script to test out the "frame" and "toplevel"
# commands of Tk.  It is organized in the standard fashion for Tcl
# tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) frame.test 1.29 97/10/10 15:52:19

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    catch {destroy $i}
}
wm geometry . {}
raise .






|
|
<

|

|
|







1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out the "frame" and "toplevel"
# commands of Tk.  It is organized in the standard fashion for Tcl
# tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: frame.test,v 1.1.4.4 1999/03/24 02:54:42 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    catch {destroy $i}
}
wm geometry . {}
raise .
611
612
613
614
615
616
617

















    list [rename .t foo] [destroy .t] [destroy foo] [destroy .m1]
} {{} {} {} {}}


catch {destroy .f}
rename eatColors {}
rename colorsFree {}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
    list [rename .t foo] [destroy .t] [destroy foo] [destroy .m1]
} {{} {} {} {}}


catch {destroy .f}
rename eatColors {}
rename colorsFree {}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/geometry.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# This file is a Tcl script to test the procedures in the file
# tkGeometry.c (generic support for geometry managers).  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) geometry.test 1.9 96/02/16 10:55:06

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . 300x300
raise .






|
|
<

|

|
|







1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test the procedures in the file
# tkGeometry.c (generic support for geometry managers).  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: geometry.test,v 1.1.4.4 1999/03/24 02:54:42 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . 300x300
raise .
243
244
245
246
247
248
249

250
251
















    set x 0
    after 500 {set x 1}
    tkwait variable x
    wm deiconify .t
    update
    winfo ismapped .t.quit
} {1}

catch {destroy .t}
concat























>

|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
    set x 0
    after 500 {set x 1}
    tkwait variable x
    wm deiconify .t
    update
    winfo ismapped .t.quit
} {1}

catch {destroy .t}

# cleanup
::tcltest::cleanupTests
return













Added tests/get.test.



































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
# This file is a Tcl script to test out the procedures in the file
# tkGet.c.  It is organized in the standard fashion for Tcl
# white-box tests.
#
# Copyright (c) 1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: get.test,v 1.1.2.5 1999/03/24 02:54:43 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

eval destroy [winfo children .]
wm geometry . {}
raise .

button .b
test get-1.1 {Tk_GetAnchorFromObj} {
    .b configure -anchor n
    .b cget -anchor
} {n}
test get-1.2 {Tk_GetAnchorFromObj} {
    .b configure -anchor ne
    .b cget -anchor
} {ne}
test get-1.3 {Tk_GetAnchorFromObj} {
    .b configure -anchor e
    .b cget -anchor
} {e}
test get-1.4 {Tk_GetAnchorFromObj} {
    .b configure -anchor se
    .b cget -anchor
} {se}
test get-1.5 {Tk_GetAnchorFromObj} {
    .b configure -anchor s
    .b cget -anchor
} {s}
test get-1.6 {Tk_GetAnchorFromObj} {
    .b configure -anchor sw
    .b cget -anchor
} {sw}
test get-1.7 {Tk_GetAnchorFromObj} {
    .b configure -anchor w
    .b cget -anchor
} {w}
test get-1.8 {Tk_GetAnchorFromObj} {
    .b configure -anchor nw
    .b cget -anchor
} {nw}
test get-1.9 {Tk_GetAnchorFromObj} {
    .b configure -anchor n
    .b cget -anchor
} {n}
test get-1.10 {Tk_GetAnchorFromObj} {
    .b configure -anchor center
    .b cget -anchor
} {center}
test get-1.11 {Tk_GetAnchorFromObj - error} {
    list [catch {.b configure -anchor unknown} msg] $msg
} {1 {bad anchor "unknown": must be n, ne, e, se, s, sw, w, nw, or center}}

catch {destroy .b}
button .b
test get-2.1 {Tk_GetJustifyFromObj} {
    .b configure -justify left
    .b cget -justify
} {left}
test get-2.2 {Tk_GetJustifyFromObj} {
    .b configure -justify right
    .b cget -justify
} {right}
test get-2.3 {Tk_GetJustifyFromObj} {
    .b configure -justify center
    .b cget -justify
} {center}
test get-2.4 {Tk_GetJustifyFromObj - error} {
    list [catch {.b configure -justify stupid} msg] $msg
} {1 {bad justification "stupid": must be left, right, or center}}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/grid.test.

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
# This file is a Tcl script to test out the *NEW* "grid" command
# of Tk.  It is (almost) organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) grid.test 1.22 97/10/10 10:07:31

if {[string compare test [info procs test]] == 1} then \
  {source ../tests/defs}

# Test Arguments:
# name -                Name of test, in the form foo-1.2.
# description -         Short textual description of the test, to
#                       help humans understand what it does.
# constraints -         A list of one or more keywords, each of
#                       which must be the name of an element in
#                       the array "testConfig".  If any of these
#                       elements is zero, the test is skipped.
#                       This argument may be omitted.
# script -              Script to run to carry out the test.  It must
#                       return a result that can be checked for
#                       correctness.
# answer -              Expected result from script.

# helper routine to return "." to a sane state after a test
# The variable GRID_VERBOSE can be used to "look" at the result
# of one or all of the tests

proc grid_reset {{test ?} {top .}} {
    global GRID_VERBOSE




>
>

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







1
2
3
4
5
6
7


8
9

10

11
12













13
14
15
16
17
18
19
# This file is a Tcl script to test out the *NEW* "grid" command
# of Tk.  It is (almost) organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: grid.test,v 1.1.4.7 1999/04/02 18:06:43 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {

    source [file join [pwd] [file dirname [info script]] defs.tcl]
}














# helper routine to return "." to a sane state after a test
# The variable GRID_VERBOSE can be used to "look" at the result
# of one or all of the tests

proc grid_reset {{test ?} {top .}} {
    global GRID_VERBOSE
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
	}
    }
    set result
} {{-10->0 -1} {0->0 0} {101->0 1}}
grid_reset 6.7

test grid-6.8 {location (weights)} {
    frame .f -width 200 -height 100 -highlightthickness 0 -bg red
    frame .a
    grid .a
    grid .f -in .a
    grid rowconfigure .f 0 -weight 1
    grid columnconfigure .f 0 -weight 1
    grid propagate .a 0
    .a configure -width 110 -height 15
    update
    set got ""
    set result ""
    for {set y -10} { $y < 120} { incr y} {
	set a [grid location . $y $y]
	if {$a != $got} {
	    lappend result $y->$a
	    set got $a
	}
    }
    set result
} {{-10->-1 -1} {0->0 0} {16->0 1} {111->1 1}}
grid_reset 6.8

test grid-6.9 {location: check updates pending} {
	set a ""
	foreach i {0 1 2} {
	    frame .$i -width 120 -height 75 -bg red
	    lappend a [grid location . 150 90]
	    grid .$i -row $i -column $i
	}
	set a







|






|



|







|


|







292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
	}
    }
    set result
} {{-10->0 -1} {0->0 0} {101->0 1}}
grid_reset 6.7

test grid-6.8 {location (weights)} {
    frame .f -width 300 -height 100 -highlightthickness 0 -bg red
    frame .a
    grid .a
    grid .f -in .a
    grid rowconfigure .f 0 -weight 1
    grid columnconfigure .f 0 -weight 1
    grid propagate .a 0
    .a configure -width 200 -height 15
    update
    set got ""
    set result ""
    for {set y -10} { $y < 210} { incr y} {
	set a [grid location . $y $y]
	if {$a != $got} {
	    lappend result $y->$a
	    set got $a
	}
    }
    set result
} {{-10->-1 -1} {0->0 0} {16->0 1} {201->1 1}}
grid_reset 6.8

test grid-6.9 {location: check updates pending} {nonPortable} {
	set a ""
	foreach i {0 1 2} {
	    frame .$i -width 120 -height 75 -bg red
	    lappend a [grid location . 150 90]
	    grid .$i -row $i -column $i
	}
	set a
998
999
1000
1001
1002
1003
1004
1005



1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
    lappend a [grid bbox .],[grid bbox .f]
    .f config -bd 20
    update
    lappend a [grid bbox .],[grid bbox .f]
} {{0 0 200 100,0 0 200 100} {0 0 240 140,20 20 200 100}}
grid_reset 14.2

test grid-14.3 {map notify} {



	global A
	catch {unset A}
	bind . <Configure> {incr A(%W)}
	set A(.) 0
	foreach i {0 1 2} {
		frame .$i -width 100 -height 75
		set A(.$i) 0
	}
	grid .0 .1 .2
	update
	bind <Configure> .1 {destroy .0}
	.2 configure -bd 10
	update
	bind . <Configure> {}
	array get A
} {.2 2 .0 1 . 1 .1 1}
grid_reset 14.3

test grid-15.1 {lost slave} {
    button .b
    grid .b
    set a [grid slaves .]
    pack .b







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







984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
    lappend a [grid bbox .],[grid bbox .f]
    .f config -bd 20
    update
    lappend a [grid bbox .],[grid bbox .f]
} {{0 0 200 100,0 0 200 100} {0 0 240 140,20 20 200 100}}
grid_reset 14.2

test grid-14.3 {map notify: bug 1648} {nonPortable} {
    # This test is nonPortable because the number of times
    # A(.) will be incremented is unspecified--the behavior
    # is different accross window managers.
    global A
    catch {unset A}
    bind . <Configure> {incr A(%W)}
    set A(.) 0
    foreach i {0 1 2} {
	frame .$i -width 100 -height 75
	set A(.$i) 0
    }
    grid .0 .1 .2
    update
    bind <Configure> .1 {destroy .0}
    .2 configure -bd 10
    update
    bind . <Configure> {}
    array get A
} {.2 2 .0 1 . 2 .1 1}
grid_reset 14.3

test grid-15.1 {lost slave} {
    button .b
    grid .b
    set a [grid slaves .]
    pack .b
1199
1200
1201
1202
1203
1204
1205







































    grid remove .f
    update
    foreach i {0 1 2 3 4} {
    	append a "[winfo x .$i] "
    }
    set a
} {0 30 70 250 280 , 0 30 130 230 260 , 0 30 113 197 280 , 0 30 60 90 120 }














































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
    grid remove .f
    update
    foreach i {0 1 2 3 4} {
    	append a "[winfo x .$i] "
    }
    set a
} {0 30 70 250 280 , 0 30 130 230 260 , 0 30 113 197 280 , 0 30 60 90 120 }

test grid-17.1 {forget and pending idle handlers} {
    # This test is intended to detect a crash caused by a failure to remove
    # pending idle handlers when grid forget is invoked.

    toplevel .t
    frame .t.f
    label .t.f.l -text foobar
    grid .t.f.l
    grid .t.f
    update
    grid forget .t.f.l
    grid forget .t.f
    destroy .t

    toplevel .t
    frame .t.f
    label .t.f.l -text foobar
    grid .t.f.l
    destroy .t
    set result ok
} ok

# cleanup
::tcltest::cleanupTests
return













Changes to tests/id.test.

1
2
3
4
5


6
7
8

9
10


11
12




13
14
15
16
17
18
19
20
# This file is a Tcl script to test out the procedures in the file
# tkId.c, which recycle X resource identifiers.  It is organized in
# the standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) id.test 1.7 97/05/15 09:47:10



if {[info procs test] != "test"} {




    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .





>
>

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







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
# This file is a Tcl script to test out the procedures in the file
# tkId.c, which recycle X resource identifiers.  It is organized in
# the standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: id.test,v 1.1.4.5 1999/03/26 00:07:57 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[string compare testwrapper [info commands testwrapper]] != 0} {
    puts "This application hasn't been compiled with the testwrapper command,"
    puts "therefore I am skipping all of these tests."
    ::tcltest::cleanupTests
    return
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
90
91
92
93
94
95
96

















    }

    # Ids should be reused now, due to time delay.  Destroy events should
    # have been discarded.
    lappend result [lsort $reused] [lsort $x]
} {{.f .f.a .f.b .f.c .f.d .f.e .f.f .f.g .f.h .f.i .f.j .f.k .f.l .f.m .f.n .f.o .f.p .f.q} {} {} {.f.o .f.p .f.q wrapper.f.p wrapper.f.q} {}}
bind all <Destroy> {}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
    }

    # Ids should be reused now, due to time delay.  Destroy events should
    # have been discarded.
    lappend result [lsort $reused] [lsort $x]
} {{.f .f.a .f.b .f.c .f.d .f.e .f.f .f.g .f.h .f.i .f.j .f.k .f.l .f.m .f.n .f.o .f.p .f.q} {} {} {.f.o .f.p .f.q wrapper.f.p wrapper.f.q} {}}
bind all <Destroy> {}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/image.test.

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
# This file is a Tcl script to test out the "image" command and the
# other procedures in the file tkImage.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) image.test 1.15 97/07/31 10:17:25




if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"

    return
}

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

eval image delete [image names]






>
>

<
<
>
|
<
>
>
>





>



<
<
<
<







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
# This file is a Tcl script to test out the "image" command and the
# other procedures in the file tkImage.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: image.test,v 1.1.4.5 1999/03/26 00:07:57 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    ::tcltest::cleanupTests
    return
}





foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

eval image delete [image names]
351
352
353
354
355
356
357

















    interp hide {} hidden
    image delete hidden
    list [image names] [interp hidden]
} [list $l $h]
    
destroy .c
eval image delete [image names]
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
    interp hide {} hidden
    image delete hidden
    list [image names] [interp hidden]
} [list $l $h]
    
destroy .c
eval image delete [image names]

# cleanup
::tcltest::cleanupTests
return













Changes to tests/imgBmap.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# This file is a Tcl script to test out images of type "bitmap" (i.e.,
# the procedures in the file tkImgBmap.c).  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) imgBmap.test 1.15 97/03/10 14:12:38

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .






|
|
<

|

|
|







1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out images of type "bitmap" (i.e.,
# the procedures in the file tkImgBmap.c).  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: imgBmap.test,v 1.1.4.4 1999/03/24 02:54:46 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
468
469
470
471
472
473
474

















    list [lsearch -exact [image names] i2] [catch {i2 foo} msg] $msg
} {-1 1 {invalid command name "i2"}}

removeFile foo.bm
removeFile foo2.bm
destroy .c
eval image delete [image names]
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
    list [lsearch -exact [image names] i2] [catch {i2 foo} msg] $msg
} {-1 1 {invalid command name "i2"}}

removeFile foo.bm
removeFile foo2.bm
destroy .c
eval image delete [image names]

# cleanup
::tcltest::cleanupTests
return













Changes to tests/imgPPM.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out the code in tkImgFmtPPM.c,
# which reads and write PPM-format image files for photo widgets.
# The files is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) imgPPM.test 1.14 97/10/28 14:47:05

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .





|
|
<

|

|
|







1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18
19
# This file is a Tcl script to test out the code in tkImgFmtPPM.c,
# which reads and write PPM-format image files for photo widgets.
# The files is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: imgPPM.test,v 1.1.4.4 1999/03/24 02:54:46 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
150
151
152
153
154
155
156

















    put test.ppm "P6\n566\n#asdf"
    list [catch {image create photo p1 -file test.ppm} msg] $msg
} {1 {couldn't recognize data in image file "test.ppm"}}

removeFile test.ppm
removeFile test2.ppm
eval image delete [image names]
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
    put test.ppm "P6\n566\n#asdf"
    list [catch {image create photo p1 -file test.ppm} msg] $msg
} {1 {couldn't recognize data in image file "test.ppm"}}

removeFile test.ppm
removeFile test2.ppm
eval image delete [image names]

# cleanup
::tcltest::cleanupTests
return













Changes to tests/imgPhoto.test.

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
# This file is a Tcl script to test out the "photo" image type and the
# other procedures in the file tkImgPhoto.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Australian National University
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Author: Paul Mackerras ([email protected])
#
# SCCS: @(#) imgPhoto.test 1.23 97/08/08 11:29:25

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

eval image delete [image names]

canvas .c
pack .c
update
























test imgPhoto-1.1 {options for photo images} {
    image create photo p1 -width 79 -height 83
    list [lindex [p1 configure -width] 4] [lindex [p1 configure -height] 4] \
	[image width p1] [image height p1]
} {79 83 79 83}
test imgPhoto-1.2 {options for photo images} {
    list [catch {image create photo p1 -file no.such.file} err] \
	[string tolower $err]
} {1 {couldn't open "no.such.file": no such file or directory}}
test imgPhoto-1.3 {options for photo images} {
    list [catch {image create photo p1 -file \
	    [file join $tk_library demos/images/teapot.ppm] \
	    -format no.such.format} err] $err
} {1 {image file format "no.such.format" is not supported}}
test imgPhoto-1.4 {options for photo images} {
    image create photo p1 -file [file join $tk_library demos/images/teapot.ppm]
    list [image width p1] [image height p1]
} {256 256}
test imgPhoto-1.5 {options for photo images} {
    image create photo p1 \
	    -file [file join $tk_library demos/images/teapot.ppm] \
	    -format ppm -width 79 -height 83
    list [image width p1] [image height p1] \
	[lindex [p1 configure -file] 4] [lindex [p1 configure -format] 4]
} [list 79 83 [file join $tk_library demos/images/teapot.ppm] ppm]
test imgPhoto-1.6 {options for photo images} {
    image create photo p1 -palette 2/2/2 -gamma 2.2
    list [format %.1f [lindex [p1 configure -gamma] 4]] \
	    [lindex [p1 configure -palette] 4]
} {2.2 2/2/2}
test imgPhoto-1.7 {options for photo images} {
    list [catch {image create photo p1 -file README} err] $err






|
|
<



|

|
|













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











|
<



|



|
<



|







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
# This file is a Tcl script to test out the "photo" image type and the
# other procedures in the file tkImgPhoto.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Australian National University
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# Author: Paul Mackerras ([email protected])
#
# RCS: @(#) $Id: imgPhoto.test,v 1.1.4.5 1999/03/24 02:54:47 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

eval image delete [image names]

canvas .c
pack .c
update

# temporarily copy the README fiel from testsDir to tmpDir
if {![file exists README]} {
    set newREADME [file join $::tcltest::workingDir README]
    file copy [file join $::tcltest::testsDir README] $newREADME
    set removeREADME 1
}

# find the teapot.ppm file for use in these tests
# first look in $tk_library/demos/images/teapot.ppm
# then look in <this file>/../../library/demos/images/teapot.ppm
# skip this file if you can't find the teapot.ppm file.
set teapotPhotoFile [file join $tk_library demos images teapot.ppm]
if {![file exists $teapotPhotoFile]} {
    set newLib [file dirname $::tcltest::testsDir]
    set teapotPhotoFile \
	[file join $newLib library demos images teapot.ppm]
    if {![file exists $teapotPhotoFile]} {
	puts "Can't find [file join demos images teapot.ppm] in $tk_library"
	puts "your Tk library is incomplete, so I am skipping imgPhoto tests."    
	return 0
    }
}

test imgPhoto-1.1 {options for photo images} {
    image create photo p1 -width 79 -height 83
    list [lindex [p1 configure -width] 4] [lindex [p1 configure -height] 4] \
	[image width p1] [image height p1]
} {79 83 79 83}
test imgPhoto-1.2 {options for photo images} {
    list [catch {image create photo p1 -file no.such.file} err] \
	[string tolower $err]
} {1 {couldn't open "no.such.file": no such file or directory}}
test imgPhoto-1.3 {options for photo images} {
    list [catch {image create photo p1 -file $teapotPhotoFile \

	    -format no.such.format} err] $err
} {1 {image file format "no.such.format" is not supported}}
test imgPhoto-1.4 {options for photo images} {
    image create photo p1 -file $teapotPhotoFile
    list [image width p1] [image height p1]
} {256 256}
test imgPhoto-1.5 {options for photo images} {
    image create photo p1 -file $teapotPhotoFile \

	    -format ppm -width 79 -height 83
    list [image width p1] [image height p1] \
	[lindex [p1 configure -file] 4] [lindex [p1 configure -format] 4]
} [list 79 83 $teapotPhotoFile ppm]
test imgPhoto-1.6 {options for photo images} {
    image create photo p1 -palette 2/2/2 -gamma 2.2
    list [format %.1f [lindex [p1 configure -gamma] 4]] \
	    [lindex [p1 configure -palette] 4]
} {2.2 2/2/2}
test imgPhoto-1.7 {options for photo images} {
    list [catch {image create photo p1 -file README} err] $err
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
#     image create photo p2 -width 10 -height 10
#     catch {image create photo p2 -file bogus.img} msg
#     p1 copy p2
#     set msg
# } {couldn't open "bogus.img": no such file or directory}

test imgPhoto-3.1 {ImgPhotoConfigureMaster procedure} {
    image create photo p1 -file [file join $tk_library demos/images/teapot.ppm]
    p1 configure -file [file join $tk_library demos/images/teapot.ppm]
} {}
test imgPhoto-3.2 {ImgPhotoConfigureMaster procedure} {
    image create photo p1 -file [file join $tk_library demos/images/teapot.ppm]
    list [catch {p1 configure -file bogus} err] [string tolower $err] \
	[image width p1] [image height p1]
} {1 {couldn't open "bogus": no such file or directory} 256 256}
test imgPhoto-3.3 {ImgPhotoConfigureMaster procedure} {
    image create photo p1
    .c create image 10 10 -image p1 -tags p1.1 -anchor nw
    .c create image 300 10 -image p1 -tags p1.2 -anchor nw
    update
    p1 configure -file [file join $tk_library demos/images/teapot.ppm]
    update
    list [image width p1] [image height p1] [.c bbox p1.1] [.c bbox p1.2]
} {256 256 {10 10 266 266} {300 10 556 266}}

eval image delete [image names]
image create photo p1
.c create image 10 10 -image p1







|
|


|








|







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
#     image create photo p2 -width 10 -height 10
#     catch {image create photo p2 -file bogus.img} msg
#     p1 copy p2
#     set msg
# } {couldn't open "bogus.img": no such file or directory}

test imgPhoto-3.1 {ImgPhotoConfigureMaster procedure} {
    image create photo p1 -file $teapotPhotoFile
    p1 configure -file $teapotPhotoFile
} {}
test imgPhoto-3.2 {ImgPhotoConfigureMaster procedure} {
    image create photo p1 -file $teapotPhotoFile
    list [catch {p1 configure -file bogus} err] [string tolower $err] \
	[image width p1] [image height p1]
} {1 {couldn't open "bogus": no such file or directory} 256 256}
test imgPhoto-3.3 {ImgPhotoConfigureMaster procedure} {
    image create photo p1
    .c create image 10 10 -image p1 -tags p1.1 -anchor nw
    .c create image 300 10 -image p1 -tags p1.2 -anchor nw
    update
    p1 configure -file $teapotPhotoFile
    update
    list [image width p1] [image height p1] [.c bbox p1.1] [.c bbox p1.2]
} {256 256 {10 10 266 266} {300 10 556 266}}

eval image delete [image names]
image create photo p1
.c create image 10 10 -image p1
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
test imgPhoto-4.8 {ImgPhotoCmd procedure: configure option} {
    list [catch {p1 configure -blah} msg] $msg
} {1 {unknown option "-blah"}}
test imgPhoto-4.9 {ImgPhotoCmd procedure: configure option} {
    list [catch {p1 configure -palette {} -gamma} msg] $msg
} {1 {value for "-gamma" missing}}
test imgPhoto-4.10 {ImgPhotoCmd procedure: copy option} {
    image create photo p2 -file [file join $tk_library demos/images/teapot.ppm]
    p1 configure -width 0 -height 0 -palette {} -gamma 1
    p1 copy p2
    list [image width p1] [image height p1] [p1 get 100 100]
} {256 256 {169 117 90}}
test imgPhoto-4.11 {ImgPhotoCmd procedure: copy option} {
    list [catch {p1 copy} msg] $msg
} {1 {wrong # args: should be "p1 copy source-image ?-from x1 y1 x2 y2? ?-to x1 y1 x2 y2? ?-zoom x y? ?-subsample x y?"}}







|







155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
test imgPhoto-4.8 {ImgPhotoCmd procedure: configure option} {
    list [catch {p1 configure -blah} msg] $msg
} {1 {unknown option "-blah"}}
test imgPhoto-4.9 {ImgPhotoCmd procedure: configure option} {
    list [catch {p1 configure -palette {} -gamma} msg] $msg
} {1 {value for "-gamma" missing}}
test imgPhoto-4.10 {ImgPhotoCmd procedure: copy option} {
    image create photo p2 -file $teapotPhotoFile
    p1 configure -width 0 -height 0 -palette {} -gamma 1
    p1 copy p2
    list [image width p1] [image height p1] [p1 get 100 100]
} {256 256 {169 117 90}}
test imgPhoto-4.11 {ImgPhotoCmd procedure: copy option} {
    list [catch {p1 copy} msg] $msg
} {1 {wrong # args: should be "p1 copy source-image ?-from x1 y1 x2 y2? ?-to x1 y1 x2 y2? ?-zoom x y? ?-subsample x y?"}}
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
    p1 copy p2 -from 0 0 10 10 -shrink
    lappend result [image width p1] [image height p1]
    p1 conf -height 0
    p1 copy p2 -from 0 0 10 10 -shrink
    lappend result [image width p1] [image height p1]
} {256 256 49 51 49 51 49 51 10 51 10 10}
test imgPhoto-4.22 {ImgPhotoCmd procedure: get option} {
    p1 read [file join $tk_library demos/images/teapot.ppm]
    list [p1 get 100 100] [p1 get 150 100] [p1 get 100 150]
} {{169 117 90} {172 115 84} {35 35 35}}
test imgPhoto-4.23 {ImgPhotoCmd procedure: get option} {
    list [catch {p1 get 256 0} err] $err
} {1 {p1 get: coordinates out of range}}
test imgPhoto-4.24 {ImgPhotoCmd procedure: get option} {
    list [catch {p1 get 0 -1} err] $err







|







214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
    p1 copy p2 -from 0 0 10 10 -shrink
    lappend result [image width p1] [image height p1]
    p1 conf -height 0
    p1 copy p2 -from 0 0 10 10 -shrink
    lappend result [image width p1] [image height p1]
} {256 256 49 51 49 51 49 51 10 51 10 10}
test imgPhoto-4.22 {ImgPhotoCmd procedure: get option} {
    p1 read $teapotPhotoFile
    list [p1 get 100 100] [p1 get 150 100] [p1 get 100 150]
} {{169 117 90} {172 115 84} {35 35 35}}
test imgPhoto-4.23 {ImgPhotoCmd procedure: get option} {
    list [catch {p1 get 256 0} err] $err
} {1 {p1 get: coordinates out of range}}
test imgPhoto-4.24 {ImgPhotoCmd procedure: get option} {
    list [catch {p1 get 0 -1} err] $err
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
    p1 put -to 10 10 20 20 {{white}}
    p1 get 19 19
} {255 255 255}
test imgPhoto-4.30 {ImgPhotoCmd procedure: read option} {
    list [catch {p1 read} err] $err
} {1 {wrong # args: should be "p1 read fileName ?-format format-name? ?-from x1 y1 x2 y2? ?-to x y? ?-shrink?"}}
test imgPhoto-4.31 {ImgPhotoCmd procedure: read option} {
    list [catch {p1 read [file join $tk_library demos/images/teapot.ppm] \
	 -zoom 2} err] $err
} {1 {unrecognized option "-zoom": must be -format, -from, -shrink, or -to}}
test imgPhoto-4.32 {ImgPhotoCmd procedure: read option} {
    list [catch {p1 read bogus} err] [string tolower $err]
} {1 {couldn't open "bogus": no such file or directory}}
test imgPhoto-4.33 {ImgPhotoCmd procedure: read option} {
    list [catch {p1 read [file join $tk_library demos/images/teapot.ppm] \
	    -format bogus} err] $err
} {1 {image file format "bogus" is not supported}}
test imgPhoto-4.34 {ImgPhotoCmd procedure: read option} {
    list [catch {p1 read README} err] $err
} {1 {couldn't recognize data in image file "README"}}
test imgPhoto-4.35 {ImgPhotoCmd procedure: read option} {
    p1 read [file join $tk_library demos/images/teapot.ppm] -shrink
    list [image width p1] [image height p1] [p1 get 120 120]
} {256 256 {161 109 82}}
test imgPhoto-4.36 {ImgPhotoCmd procedure: read option} {
    p1 read [file join $tk_library demos/images/teapot.ppm] \
	     -from 0 70 60 120 -to 10 10 -shrink
    list [image width p1] [image height p1] [p1 get 29 19]
} {70 60 {244 180 144}}
test imgPhoto-4.37 {ImgPhotoCmd procedure: redither option} {
    p1 redither
    list [catch {p1 redither x} err] $err
} {1 {wrong # args: should be "p1 redither"}}
test imgPhoto-4.38 {ImgPhotoCmd procedure: write option} {
    list [catch {p1 write} err] $err
} {1 {wrong # args: should be "p1 write fileName ?-format format-name??-from x1 y1 x2 y2?"}}
test imgPhoto-4.39 {ImgPhotoCmd procedure: write option} {
    list [catch {p1 write teapot.tmp -format bogus} err] $err
} {1 {image file format "bogus" is unknown}}

test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} {
    eval image delete [image names]
    .c delete all
    image create photo p1 -file [file join $tk_library demos/images/teapot.ppm]
    .c create image 0 0 -image p1 -tags p1.1
    .c create image 256 0 -image p1 -tags p1.2
    .c create image 0 256 -image p1 -tags p1.3
    update
    .c delete i1.1
    p1 configure -width 1
    update







<
|





<
|





|



<
|
















|







243
244
245
246
247
248
249

250
251
252
253
254
255

256
257
258
259
260
261
262
263
264
265

266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
    p1 put -to 10 10 20 20 {{white}}
    p1 get 19 19
} {255 255 255}
test imgPhoto-4.30 {ImgPhotoCmd procedure: read option} {
    list [catch {p1 read} err] $err
} {1 {wrong # args: should be "p1 read fileName ?-format format-name? ?-from x1 y1 x2 y2? ?-to x y? ?-shrink?"}}
test imgPhoto-4.31 {ImgPhotoCmd procedure: read option} {

    list [catch {p1 read $teapotPhotoFile -zoom 2} err] $err
} {1 {unrecognized option "-zoom": must be -format, -from, -shrink, or -to}}
test imgPhoto-4.32 {ImgPhotoCmd procedure: read option} {
    list [catch {p1 read bogus} err] [string tolower $err]
} {1 {couldn't open "bogus": no such file or directory}}
test imgPhoto-4.33 {ImgPhotoCmd procedure: read option} {

    list [catch {p1 read $teapotPhotoFile -format bogus} err] $err
} {1 {image file format "bogus" is not supported}}
test imgPhoto-4.34 {ImgPhotoCmd procedure: read option} {
    list [catch {p1 read README} err] $err
} {1 {couldn't recognize data in image file "README"}}
test imgPhoto-4.35 {ImgPhotoCmd procedure: read option} {
    p1 read $teapotPhotoFile
    list [image width p1] [image height p1] [p1 get 120 120]
} {256 256 {161 109 82}}
test imgPhoto-4.36 {ImgPhotoCmd procedure: read option} {

    p1 read $teapotPhotoFile -from 0 70 60 120 -to 10 10 -shrink
    list [image width p1] [image height p1] [p1 get 29 19]
} {70 60 {244 180 144}}
test imgPhoto-4.37 {ImgPhotoCmd procedure: redither option} {
    p1 redither
    list [catch {p1 redither x} err] $err
} {1 {wrong # args: should be "p1 redither"}}
test imgPhoto-4.38 {ImgPhotoCmd procedure: write option} {
    list [catch {p1 write} err] $err
} {1 {wrong # args: should be "p1 write fileName ?-format format-name??-from x1 y1 x2 y2?"}}
test imgPhoto-4.39 {ImgPhotoCmd procedure: write option} {
    list [catch {p1 write teapot.tmp -format bogus} err] $err
} {1 {image file format "bogus" is unknown}}

test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} {
    eval image delete [image names]
    .c delete all
    image create photo p1 -file $teapotPhotoFile
    .c create image 0 0 -image p1 -tags p1.1
    .c create image 256 0 -image p1 -tags p1.2
    .c create image 0 256 -image p1 -tags p1.3
    update
    .c delete i1.1
    p1 configure -width 1
    update
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
    .c create image 10 10 -image p1
    update
} {}

test imgPhoto-7.1 {ImgPhotoFree procedure, resource freeing} {
    eval image delete [image names]
    .c delete all
    image create photo p1 -file [file join $tk_library demos/images/teapot.ppm]
    .c create image 0 0 -image p1 -anchor nw
    update
    .c delete all
    image delete p1
} {}
test imgPhoto-7.2 {ImgPhotoFree procedures, unlinking} {
    image create photo p1 -file [file join $tk_library demos/images/teapot.ppm]
    .c create image 10 10 -image p1 -anchor nw
    button .b1 -image p1
    button .b2 -image p1
    button .b3 -image p1
    pack .b1 .b2 .b3
    update
    destroy .b2
    update
    destroy .b3
    update
    destroy .b1
    update
    .c delete all
} {}
test imgPhoto-7.3 {ImgPhotoFree procedures, multiple visuals} {
    image create photo p1 -file [file join $tk_library demos/images/teapot.ppm]
    button .b1 -image p1
    frame .f -visual best
    button .f.b2 -image p1
    pack .f.b2
    pack .b1 .f
    update
    destroy .b1
    update
    .f.b2 configure -image {}
    update
    destroy .f
    image delete p1
} {}

test imgPhoto-8.1 {ImgPhotoDelete procedure} {
    image create photo p2 -file [file join $tk_library demos/images/teapot.ppm]
    image delete p2
} {}
test imagePhoto-8.2 {ImgPhotoDelete procedure} {
    image create photo p2 -file [file join $tk_library demos/images/teapot.ppm]
    rename p2 newp2
    set x [list [info command p2] [info command new*] [newp2 cget -file]]
    image delete p2
    lappend x [info command new*]
} [list {} newp2 [file join $tk_library demos/images/teapot.ppm] {}]
test imagePhoto-8.3 {ImgPhotoDelete procedure, name cleanup} {
    image create photo p1
    image create photo p2 -width 10 -height 10
    image delete p2
    list [catch {p1 copy p2} msg] $msg
} {1 {image "p2" doesn't exist or is not a photo image}}

test imagePhoto-9.1 {ImgPhotoCmdDeletedProc procedure} {
    image create photo p2 -file [file join $tk_library demos/images/teapot.ppm]
    rename p2 {}
    list [lsearch -exact [image names] p2] [catch {p2 foo} msg] $msg
} {-1 1 {invalid command name "p2"}}

test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} {
    eval image delete [image names]
    image create photo p1







|






|















|















|



|



|
|








|







301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
    .c create image 10 10 -image p1
    update
} {}

test imgPhoto-7.1 {ImgPhotoFree procedure, resource freeing} {
    eval image delete [image names]
    .c delete all
    image create photo p1 -file $teapotPhotoFile
    .c create image 0 0 -image p1 -anchor nw
    update
    .c delete all
    image delete p1
} {}
test imgPhoto-7.2 {ImgPhotoFree procedures, unlinking} {
    image create photo p1 -file $teapotPhotoFile
    .c create image 10 10 -image p1 -anchor nw
    button .b1 -image p1
    button .b2 -image p1
    button .b3 -image p1
    pack .b1 .b2 .b3
    update
    destroy .b2
    update
    destroy .b3
    update
    destroy .b1
    update
    .c delete all
} {}
test imgPhoto-7.3 {ImgPhotoFree procedures, multiple visuals} {
    image create photo p1 -file $teapotPhotoFile
    button .b1 -image p1
    frame .f -visual best
    button .f.b2 -image p1
    pack .f.b2
    pack .b1 .f
    update
    destroy .b1
    update
    .f.b2 configure -image {}
    update
    destroy .f
    image delete p1
} {}

test imgPhoto-8.1 {ImgPhotoDelete procedure} {
    image create photo p2 -file $teapotPhotoFile
    image delete p2
} {}
test imagePhoto-8.2 {ImgPhotoDelete procedure} {
    image create photo p2 -file $teapotPhotoFile
    rename p2 newp2
    set x [list [info command p2] [info command new*] [newp2 cget -file]]
    image delete p2
    append x [info command new*]
} [list {} newp2 $teapotPhotoFile]
test imagePhoto-8.3 {ImgPhotoDelete procedure, name cleanup} {
    image create photo p1
    image create photo p2 -width 10 -height 10
    image delete p2
    list [catch {p1 copy p2} msg] $msg
} {1 {image "p2" doesn't exist or is not a photo image}}

test imagePhoto-9.1 {ImgPhotoCmdDeletedProc procedure} {
    image create photo p2 -file $teapotPhotoFile
    rename p2 {}
    list [lsearch -exact [image names] p2] [catch {p2 foo} msg] $msg
} {-1 1 {invalid command name "p2"}}

test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} {
    eval image delete [image names]
    image create photo p1
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
    eval image delete [image names]
    image create bitmap i1
    image create photo p1
    list [catch {p1 copy i1} msg] $msg
} {1 {image "i1" doesn't exist or is not a photo image}}

test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} {
    image create photo p3 -file [file join $tk_library demos/images/teapot.ppm]
    set result [list [p3 get 50 50] [p3 get 100 100]]
    p3 copy p3 -zoom 2
    lappend result [image width p3] [image height p3] [p3 get 100 100]
    image delete p3
    set result
} {{19 92 192} {169 117 90} 512 512 {19 92 192}}








|







380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
    eval image delete [image names]
    image create bitmap i1
    image create photo p1
    list [catch {p1 copy i1} msg] $msg
} {1 {image "i1" doesn't exist or is not a photo image}}

test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} {
    image create photo p3 -file $teapotPhotoFile
    set result [list [p3 get 50 50] [p3 get 100 100]]
    p3 copy p3 -zoom 2
    lappend result [image width p3] [image height p3] [p3 get 100 100]
    image delete p3
    set result
} {{19 92 192} {169 117 90} 512 512 {19 92 192}}

417
418
419
420
421
422
423




















    unset data
    interp delete x1
    interp delete x2
} {}

destroy .c
eval image delete [image names]



























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
    unset data
    interp delete x1
    interp delete x2
} {}

destroy .c
eval image delete [image names]

# cleanup
if {[info exists removeREADME]} {
    catch {file delete -force $newREADME}
}
::tcltest::cleanupTests
return













Changes to tests/listbox.test.

1
2
3
4
5


6
7
8

9
10


11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out the "listbox" command
# of Tk.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1993-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) listbox.test 1.45 97/10/29 13:05:46



if {[string compare test [info procs test]] == 1} then \
  {source defs}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
set fixed {Courier -12}





>
>

<
<
>
|
<
>
>
|
<
<







1
2
3
4
5
6
7
8


9
10

11
12
13


14
15
16
17
18
19
20
# This file is a Tcl script to test out the "listbox" command
# of Tk.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1993-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: listbox.test,v 1.1.4.4 1999/03/24 02:54:47 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}



foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
set fixed {Courier -12}
1651
1652
1653
1654
1655
1656
1657
1658

















resetGridInfo
catch {destroy .l2}
catch {destroy .t}
catch {destroy .e}
catch {destroy .partial}
option clear

























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674

resetGridInfo
catch {destroy .l2}
catch {destroy .t}
catch {destroy .e}
catch {destroy .partial}
option clear

# cleanup
::tcltest::cleanupTests
return













Changes to tests/macEmbed.test.

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
# This file is a Tcl script to test out the procedures in the file 
# tkMacEmbed.c.  It is organized in the standard fashion for Tcl
# tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS:  @(#) macEmbed.test 1.1 97/08/06 21:18:53

if {$tcl_platform(platform) != "macintosh"} {
    return
}

if {[info procs test] != "test"} {
    source defs
}

eval destroy [winfo children .]
wm geometry . {}
raise .


test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {
    catch {destroy .t}
    list [catch {toplevel .t -use xyz} msg] $msg
} {1 {expected integer but got "xyz"}}
test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {
    catch {destroy .t}
    list [catch {toplevel .t -use 47} msg] $msg
} {1 {The window ID 47 does not correspond to a valid Tk Window.}}








test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {
    eval destroy [winfo child .]
    frame .f1 -container 1 -width 200 -height 50
    frame .f2 -container 1 -width 200 -height 50
    pack .f1 .f2
    set w [winfo id .f1]
	toplevel .t -use $w
	list [testembed] [expr [lindex [lindex [testembed all] 1] 0] - $w]
} {{{XXX .f2 {} {}} {XXX .f1 XXX .t}} 0}
test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {
    eval destroy [winfo child .]
    frame .f1 -container 1 -width 200 -height 50
    frame .f2 -container 1 -width 200 -height 50
    pack .f1 .f2
    set w1 [winfo id .f1]
    set w2 [winfo id .f2]
	toplevel .t1 -use $w1
	toplevel .t2 -use $w2
	testembed
} {{XXX .f2 XXX .t2} {XXX .f1 XXX .t1}}

# Can't think of any way to test the procedures TkpMakeWindow,
# TkpMakeContainer, or EmbedErrorProc.

test macEmbed-2.1 {EmbeddedEventProc procedure} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
	testembed
    destroy .t1
    update
	testembed
} {}
test macEmbed-2.2 {EmbeddedEventProc procedure} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    toplevel .t1 -use [winfo id .f1]
    update
    destroy .f1
    testembed
} {}
test macEmbed-2.3 {EmbeddedEventProc procedure} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    toplevel .t1 -use [winfo id .f1]
    update
    destroy .t1
    update
    list [testembed] [winfo children .]
} {{} {}}

test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
    set x [testembed]
	toplevel .t1 -use $w1
	wm withdraw .t1
    list $x [testembed]
} {{{XXX .f1 {} {}}} {{XXX .f1 XXX .t1}}}
test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} {

    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1 -bd 2 -relief raised
	update
	wm geometry .t1 +30+40
    update
	wm geometry .t1
} {200x200+0+0}
test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} {

    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
	update
	wm geometry .t1 300x100+30+40
    update
	wm geometry .t1
} {300x100+0+0}
test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    toplevel .t1 -container 1 -width 200 -height 50
    set w1 [winfo id .t1]
	toplevel .t2 -use $w1
    update
	.t1 configure -width 300 -height 80
    update
    list [winfo width .t1] [winfo height .t1] [wm geometry .t2]
} {300 80 300x80+0+0}
test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
	set x unmapped
	bind .t1 <Map> {set x mapped}
    update
	after 100
	update
	set x
} {mapped}
test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
    bind .f1 <Destroy> {set x dead}
    set x alive
	toplevel .t1 -use $w1
    update
	destroy .t1
    update
    list $x [winfo exists .f1]
} {dead 0}

test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
    update
	.t1 configure -width 180 -height 100
    update
	winfo geometry .t1
} {180x100+0+0}
test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
    update
    set x [testembed]
    destroy .f1
    list $x [testembed]
} {{{XXX .f1 XXX .t1}} {}}

# Can't think up any tests for TkpGetOtherWindow procedure.

test unixEmbed-5.1 {TkpClaimFocus procedure} {tempNotMac} {
    catch {interp delete child}
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    frame .f2 -width 200 -height 50
    pack .f1 .f2





|
|
<

<
|
<
<
|
|
<
|







|



|



>
>
>
>
>
>
>
>
|








|














|












|










|












|











|
>












|
>












|











|














|















|












|















|







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
# This file is a Tcl script to test out the procedures in the file 
# tkMacEmbed.c.  It is organized in the standard fashion for Tcl
# tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#

# RCS: @(#) $Id: macEmbed.test,v 1.1.4.5 1999/03/26 00:07:58 hershey Exp $



if {[lsearch [namespace children] ::tcltest] == -1} {

    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

eval destroy [winfo children .]
wm geometry . {}
raise .


test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {macOnly} {
    catch {destroy .t}
    list [catch {toplevel .t -use xyz} msg] $msg
} {1 {expected integer but got "xyz"}}
test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {macOnly} {
    catch {destroy .t}
    list [catch {toplevel .t -use 47} msg] $msg
} {1 {The window ID 47 does not correspond to a valid Tk Window.}}

if {[string compare testembed [info commands testembed]] != 0} {
    puts "This application hasn't been compiled with the testembed command,"
    puts "therefore I am skipping all of these tests."
    ::tcltest::cleanupTests
    return
}

test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {macOnly} {
    eval destroy [winfo child .]
    frame .f1 -container 1 -width 200 -height 50
    frame .f2 -container 1 -width 200 -height 50
    pack .f1 .f2
    set w [winfo id .f1]
	toplevel .t -use $w
	list [testembed] [expr [lindex [lindex [testembed all] 1] 0] - $w]
} {{{XXX .f2 {} {}} {XXX .f1 XXX .t}} 0}
test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {macOnly} {
    eval destroy [winfo child .]
    frame .f1 -container 1 -width 200 -height 50
    frame .f2 -container 1 -width 200 -height 50
    pack .f1 .f2
    set w1 [winfo id .f1]
    set w2 [winfo id .f2]
	toplevel .t1 -use $w1
	toplevel .t2 -use $w2
	testembed
} {{XXX .f2 XXX .t2} {XXX .f1 XXX .t1}}

# Can't think of any way to test the procedures TkpMakeWindow,
# TkpMakeContainer, or EmbedErrorProc.

test macEmbed-2.1 {EmbeddedEventProc procedure} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
	testembed
    destroy .t1
    update
	testembed
} {}
test macEmbed-2.2 {EmbeddedEventProc procedure} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    toplevel .t1 -use [winfo id .f1]
    update
    destroy .f1
    testembed
} {}
test macEmbed-2.3 {EmbeddedEventProc procedure} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    toplevel .t1 -use [winfo id .f1]
    update
    destroy .t1
    update
    list [testembed] [winfo children .]
} {{} {}}

test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
    set x [testembed]
	toplevel .t1 -use $w1
	wm withdraw .t1
    list $x [testembed]
} {{{XXX .f1 {} {}}} {{XXX .f1 XXX .t1}}}
test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} \
	{macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1 -bd 2 -relief raised
	update
	wm geometry .t1 +30+40
    update
	wm geometry .t1
} {200x200+0+0}
test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} \
	{macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
	update
	wm geometry .t1 300x100+30+40
    update
	wm geometry .t1
} {300x100+0+0}
test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    toplevel .t1 -container 1 -width 200 -height 50
    set w1 [winfo id .t1]
	toplevel .t2 -use $w1
    update
	.t1 configure -width 300 -height 80
    update
    list [winfo width .t1] [winfo height .t1] [wm geometry .t2]
} {300 80 300x80+0+0}
test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
	set x unmapped
	bind .t1 <Map> {set x mapped}
    update
	after 100
	update
	set x
} {mapped}
test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
    bind .f1 <Destroy> {set x dead}
    set x alive
	toplevel .t1 -use $w1
    update
	destroy .t1
    update
    list $x [winfo exists .f1]
} {dead 0}

test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
    update
	.t1 configure -width 180 -height 100
    update
	winfo geometry .t1
} {180x100+0+0}
test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
    update
    set x [testembed]
    destroy .f1
    list $x [testembed]
} {{{XXX .f1 XXX .t1}} {}}

# Can't think up any tests for TkpGetOtherWindow procedure.

test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} {
    catch {interp delete child}
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    frame .f2 -width 200 -height 50
    pack .f1 .f2
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290

















	set x [list [focus]]
	update
	lappend x [focus]
    }] [focus]
} {{{} .} .f1}
catch {interp delete child}

test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    frame .f2 -container 1 -width 200 -height 50
    frame .f3 -container 1 -width 200 -height 50
    frame .f4 -container 1 -width 200 -height 50
    pack .f1 .f2 .f3 .f4
    set x {}
    lappend x [testembed]
    foreach w {.f3 .f4 .f1 .f2} {
	destroy $w
	lappend x [testembed]
    }
    set x
} {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}}
test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken
	set x {}
	lappend x [testembed]
	destroy .t1
	update
	lappend x [testembed]
} {{{XXX .f1 XXX .t1}} {}}

test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    toplevel .t1 -use [winfo id .f1] -width 150 -height 80
    update
    wm geometry .t1 +40+50
    update
    wm geometry .t1
} {150x80+0+0}
test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    toplevel .t1 -use [winfo id .f1] -width 150 -height 80
    update
    wm geometry .t1 70x300+10+20
    update
    wm geometry .t1
} {70x300+0+0}



foreach w [winfo child .] {
    catch {destroy $w}
}
























|
















|














|











|

















>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
	set x [list [focus]]
	update
	lappend x [focus]
    }] [focus]
} {{{} .} .f1}
catch {interp delete child}

test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    frame .f2 -container 1 -width 200 -height 50
    frame .f3 -container 1 -width 200 -height 50
    frame .f4 -container 1 -width 200 -height 50
    pack .f1 .f2 .f3 .f4
    set x {}
    lappend x [testembed]
    foreach w {.f3 .f4 .f1 .f2} {
	destroy $w
	lappend x [testembed]
    }
    set x
} {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}}
test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken
	set x {}
	lappend x [testembed]
	destroy .t1
	update
	lappend x [testembed]
} {{{XXX .f1 XXX .t1}} {}}

test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    toplevel .t1 -use [winfo id .f1] -width 150 -height 80
    update
    wm geometry .t1 +40+50
    update
    wm geometry .t1
} {150x80+0+0}
test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    toplevel .t1 -use [winfo id .f1] -width 150 -height 80
    update
    wm geometry .t1 70x300+10+20
    update
    wm geometry .t1
} {70x300+0+0}



foreach w [winfo child .] {
    catch {destroy $w}
}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/macFont.test.

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

















# This file is a Tcl script to test out the procedures in tkMacFont.c. 
# It is organized in the standard fashion for Tcl tests.
#
# Some of these tests are visually oriented and cannot be checked
# programmatically (such as "does an underlined font appear to be
# underlined?"); these tests attempt to exercise the code in question,
# but there are no results that can be checked.  
#
# Copyright (c) 1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) macFont.test 1.5 97/05/05 14:21:05




if {$tcl_platform(platform)!="macintosh"} {


    return
}

if {[string compare test [info procs test]] != 0} {
    source defs
}

catch {destroy .b}
toplevel .b
update idletasks

set courier {Courier 10}
set cx [font measure $courier 0]


label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Monaco 9"
pack .b.l
canvas .b.c -closeenough 0

set t [.b.c create text 0 0 -anchor nw -just left -font $courier]
pack .b.c
update

set ax [winfo reqwidth .b.l]
set ay [winfo reqheight .b.l]
proc getsize {} {
    update
    return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
}











test macfont-1.1 {TkpGetNativeFont procedure: not native} {
    list [catch {font measure {} xyz} msg] $msg
} {1 {font "" doesn't exist}}
test macfont-1.2 {TkpGetNativeFont procedure: native} {
    font measure system "0"
    font measure application "0"
    set x {}
} {}

test macfont-2.1 {TkpGetFontFromAttributes procedure: no family} {
    font actual {-underline 1} -family
} [font actual system -family]
test macfont-2.2 {TkpGetFontFromAttributes procedure: long family name} {
    set x "12345678901234567890123456789012345678901234567890"
    set x "$x$x$x$x$x$x"
    font actual "-family $x" -family
} [font actual system -family]
test macfont-2.3 {TkpGetFontFromAttributes procedure: family} {
    font actual {-family Courier} -family
} {Courier}
test macfont-2.4 {TkpGetFontFromAttributes procedure: Times fonts} {
    set x {}
    lappend x [font actual {-family "Times"} -family]
    lappend x [font actual {-family "Times New Roman"} -family]
} {Times Times}
test macfont-2.5 {TkpGetFontFromAttributes procedure: Courier fonts} {
    set x {}
    lappend x [font actual {-family "Courier"} -family]
    lappend x [font actual {-family "Courier New"} -family]
} {Courier Courier}
test macfont-2.6 {TkpGetFontFromAttributes procedure: Helvetica fonts} {
    set x {}
    lappend x [font actual {-family "Geneva"} -family]
    lappend x [font actual {-family "Helvetica"} -family]
    lappend x [font actual {-family "Arial"} -family]
} {Geneva Helvetica Helvetica}
test macfont-2.7 {TkpGetFontFromAttributes procedure: styles} {






    font actual {-weight normal} -weight
} {normal}
test macfont-2.8 {TkpGetFontFromAttributes procedure: styles} {
    font actual {-weight bold} -weight
} {bold}
test macfont-2.9 {TkpGetFontFromAttributes procedure: styles} {
    font actual {-slant roman} -slant
} {roman}
test macfont-2.10 {TkpGetFontFromAttributes procedure: styles} {
    font actual {-slant italic} -slant
} {italic}
test macfont-2.11 {TkpGetFontFromAttributes procedure: styles} {
    font actual {-underline false} -underline
} {0}
test macfont-2.12 {TkpGetFontFromAttributes procedure: styles} {
    font actual {-underline true} -underline
} {1}
test macfont-2.13 {TkpGetFontFromAttributes procedure: styles} {
    font actual {-overstrike false} -overstrike
} {0}
test macfont-2.14 {TkpGetFontFromAttributes procedure: styles} {
    font actual {-overstrike true} -overstrike
} {0}

test macfont-3.1 {TkpDeleteFont procedure} {
    font actual {-family xyz}
    set x {}
} {}

test macfont-4.1 {TkpGetFontFamilies procedure} {
    font families
    set x {}
} {}







test macfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {
    .b.l config -wrap 0 -text "000000"
    getsize
} "[expr $ax*6] $ay"
test macfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {
    .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
    getsize
} "[expr $ax*256] $ay"
test macfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {
    .b.l config -wrap [expr $ax*10] -text "00000000"
    getsize
} "[expr $ax*8] $ay"
test macfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {
    .b.l config -wrap [expr $ax*6] -text "00000000"
    getsize
} "[expr $ax*6] [expr $ay*2]"
test macfont-5.5 {Tk_MeasureChars procedure: already saw space in line} {
    .b.l config -wrap [expr $ax*12] -text "000000    0000000"
    getsize
} "[expr $ax*7] [expr $ay*2]"
test macfont-5.6 {Tk_MeasureChars procedure: internal spaces significant} {
    .b.l config -wrap [expr $ax*12] -text "000  00   00000"
    getsize
} "[expr $ax*7] [expr $ay*2]"
test macfont-5.7 {Tk_MeasureChars procedure: include last partial char} {
    .b.c dchars $t 0 end
    .b.c insert $t 0 "0000"
    .b.c index $t @[expr int($ax*2.5)],1
} {2}
test macfont-5.8 {Tk_MeasureChars procedure: at least one char on line} { 
    .b.l config -text "000000" -wrap 1
    getsize
} "$ax [expr $ay*6]"
test macfont-5.9 {Tk_MeasureChars procedure: whole words} {
    .b.l config -wrap [expr $ax*8] -text "000000 0000"
    getsize
} "[expr $ax*6] [expr $ay*2]"
test macfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {
    .b.l config -wrap [expr $ax*12] -text "0000000000000000"
    getsize
} "[expr $ax*12] [expr $ay*2]"

















































































test macfont-6.1 {Tk_DrawChars procedure} {
    .b.l config -text "a"
    update
} {}

test macfont-7.1 {AllocMacFont procedure: use old font} {
    font create xyz
    button .c -font xyz
    font configure xyz -family times
    update
    destroy .c
    font delete xyz
} {}
test macfont-7.2 {AllocMacFont procedure: extract info from style} {
    font actual {Monaco 9 bold italic underline overstrike}
} {-family Monaco -size 9 -weight bold -slant italic -underline 1 -overstrike 0}
test macfont-7.3 {AllocMacFont procedure: extract text metrics} {
    font metric {Geneva 10} -fixed
} {0}
test macfont-7.4 {AllocMacFont procedure: extract text metrics} {
    font metric "Monaco 9" -fixed
} {1}

destroy .b


























>
>

<
<
>
|
<
>
>
|
>

>
>



<
<
<
<




|


>
|














>
>
>
>
>
>
>
>
>
>
|


|





|


|




|


|




|




|





|
>
>
>
>
>
>


|


|


|


|


|


|


|



|




|
|
<
|

>
>
>
>
>
>
|



|



|



|



|



|



|




|



|



|



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

|




|







|


|


|




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12


13
14

15
16
17
18
19
20
21
22
23
24




25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
# This file is a Tcl script to test out the procedures in tkMacFont.c. 
# It is organized in the standard fashion for Tcl tests.
#
# Some of these tests are visually oriented and cannot be checked
# programmatically (such as "does an underlined font appear to be
# underlined?"); these tests attempt to exercise the code in question,
# but there are no results that can be checked.  
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: macFont.test,v 1.1.4.6 1999/03/26 00:07:59 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {$tcl_platform(platform)!="macintosh"} {
    puts "skipping: Mac only tests..."
    ::tcltest::cleanupTests
    return
}





catch {destroy .b}
toplevel .b
update idletasks

set courier {Courier 12}
set cx [font measure $courier 0]

set fixed {Monaco 12}
label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font $fixed
pack .b.l
canvas .b.c -closeenough 0

set t [.b.c create text 0 0 -anchor nw -just left -font $courier]
pack .b.c
update

set ax [winfo reqwidth .b.l]
set ay [winfo reqheight .b.l]
proc getsize {} {
    update
    return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
}

set ::tcltest::testConfig(gothic) 0
set gothic {gothic 12}
set mx [font measure  $gothic \u4e4e]
if {[font actual $gothic -family] != [font actual system -family]} {
    set ::tcltest::testConfig(gothic) 1
}

test macFont-1.1 {TkpFontPkgInit} {
} {}

test macfont-2.1 {TkpGetNativeFont: not native} {
    list [catch {font measure {} xyz} msg] $msg
} {1 {font "" doesn't exist}}
test macFont-2.2 {TkpGetNativeFont: native} {
    font measure system "0"
    font measure application "0"
    set x {}
} {}

test macFont-3.1 {TkpGetFontFromAttributes: no family} {
    font actual {-underline 1} -family
} [font actual system -family]
test macFont-3.2 {TkpGetFontFromAttributes: long family name} {
    set x "12345678901234567890123456789012345678901234567890"
    set x "$x$x$x$x$x$x"
    font actual "-family $x" -family
} [font actual system -family]
test macFont-3.3 {TkpGetFontFromAttributes: family} {
    font actual {-family Courier} -family
} {Courier}
test macFont-3.4 {TkpGetFontFromAttributes: Times fonts} {
    set x {}
    lappend x [font actual {-family "Times"} -family]
    lappend x [font actual {-family "Times New Roman"} -family]
} {Times Times}
test macFont-3.5 {TkpGetFontFromAttributes: Courier fonts} {
    set x {}
    lappend x [font actual {-family "Courier"} -family]
    lappend x [font actual {-family "Courier New"} -family]
} {Courier Courier}
test macFont-3.6 {TkpGetFontFromAttributes: Helvetica fonts} {
    set x {}
    lappend x [font actual {-family "Geneva"} -family]
    lappend x [font actual {-family "Helvetica"} -family]
    lappend x [font actual {-family "Arial"} -family]
} {Geneva Helvetica Helvetica}
test macFont-3.7 {TkpGetFontFromAttributes: try aliases} {
    font actual {arial 10} -family
} {Helvetica}    
test macFont-3.8 {TkpGetFontFromAttributes: try fallbacks} {
    font actual {{ms sans serif} 10} -family
} {Chicago}
test macFont-3.9 {TkpGetFontFromAttributes: styles} {
    font actual {-weight normal} -weight
} {normal}
test macFont-3.10 {TkpGetFontFromAttributes: styles} {
    font actual {-weight bold} -weight
} {bold}
test macFont-3.11 {TkpGetFontFromAttributes: styles} {
    font actual {-slant roman} -slant
} {roman}
test macFont-3.12 {TkpGetFontFromAttributes: styles} {
    font actual {-slant italic} -slant
} {italic}
test macFont-3.13 {TkpGetFontFromAttributes: styles} {
    font actual {-underline false} -underline
} {0}
test macFont-3.14 {TkpGetFontFromAttributes: styles} {
    font actual {-underline true} -underline
} {1}
test macFont-3.15 {TkpGetFontFromAttributes: styles} {
    font actual {-overstrike false} -overstrike
} {0}
test macFont-3.16 {TkpGetFontFromAttributes: styles} {
    font actual {-overstrike true} -overstrike
} {0}

test macFont-4.1 {TkpDeleteFont} {
    font actual {-family xyz}
    set x {}
} {}

test macFont-5.1 {TkpGetFontFamilies} {
    expr {[lsearch [font families] Geneva] > 0}

} {1}

test macFont-6.1 {TkpGetSubFonts} {gothic} {
    .b.l config -text "abc\u4e4e" 
    update
    set x [testfont subfonts $fixed]
} "Monaco [font actual $gothic -family]"    

test macFont-7.1 {Tk_MeasureChars: unbounded right margin} {
    .b.l config -wrap 0 -text "000000"
    getsize
} "[expr $ax*6] $ay"
test macFont-7.2 {Tk_MeasureChars: static width buffer exceeded} {
    .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
    getsize
} "[expr $ax*256] $ay"
test macFont-7.3 {Tk_MeasureChars: all chars did fit} {
    .b.l config -wrap [expr $ax*10] -text "00000000"
    getsize
} "[expr $ax*8] $ay"
test macFont-7.4 {Tk_MeasureChars: not all chars fit} {
    .b.l config -wrap [expr $ax*6] -text "00000000"
    getsize
} "[expr $ax*6] [expr $ay*2]"
test macFont-7.5 {Tk_MeasureChars: already saw space in line} {
    .b.l config -wrap [expr $ax*12] -text "000000    0000000"
    getsize
} "[expr $ax*7] [expr $ay*2]"
test macFont-7.6 {Tk_MeasureChars: internal spaces significant} {
    .b.l config -wrap [expr $ax*12] -text "000  00   00000"
    getsize
} "[expr $ax*7] [expr $ay*2]"
test macFont-7.7 {Tk_MeasureChars: include last partial char} {
    .b.c dchars $t 0 end
    .b.c insert $t 0 "0000"
    .b.c index $t @[expr int($ax*2.5)],1
} {2}
test macFont-7.8 {Tk_MeasureChars: at least one char on line} { 
    .b.l config -text "000000" -wrap 1
    getsize
} "$ax [expr $ay*6]"
test macFont-7.9 {Tk_MeasureChars: whole words} {
    .b.l config -wrap [expr $ax*8] -text "000000 0000"
    getsize
} "[expr $ax*6] [expr $ay*2]"
test macFont-7.10 {Tk_MeasureChars: make first part of word fit} {
    .b.l config -wrap [expr $ax*12] -text "0000000000000000"
    getsize
} "[expr $ax*12] [expr $ay*2]"
test macFont-7.11 {Tk_MeasureChars: numBytes == 0} {
    font measure system {}
} {0}
test macFont-7.12 {Tk_MeasureChars: maxLength < 0} {
    font measure $courier abcd
} "[expr $cx*4]"
test macFont-7.13 {Tk_MeasureChars: loop on each char} {
    font measure $courier abcd
} "[expr $cx*4]"
test macFont-7.14 {Tk_MeasureChars: p == end} {
    font measure $courier abcd
} "[expr $cx*4]"
test macFont-7.15 {Tk_MeasureChars: p > end} {
    font measure $courier abc\xc2
} "[expr $cx*4]"
test macFont-7.16 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic} {
    font measure $courier abc\u4e4edef
} [expr $cx*6+$mx]
test macFont-7.17 {Tk_MeasureChars: measure no chars (in loop)} {gothic} {
    font measure $courier \u4e4edef
} [expr $mx+$cx*3]
test macFont-7.18 {Tk_MeasureChars: final measure} {gothic} {
    font measure $courier \u4e4edef
} [expr $mx+$cx*3]
test macFont-7.19 {Tk_MeasureChars: final measure (no chars)} {gothic} {
    font measure $courier \u4e4e
} [expr $mx]
test macFont-7.20 {Tk_MeasureChars: maxLength >= 0} {
    .b.l config -wrap [expr $ax*8] -text "000"
    getsize
} "[expr $ax*3] $ay"
test macFont-7.21 {Tk_MeasureChars: loop on each char} {
    .b.l config -wrap [expr $ax*8] -text "000"
    getsize
} "[expr $ax*3] $ay"
test macFont-7.22 {Tk_MeasureChars: p == end} {
    .b.l config -wrap [expr $ax*8] -text "000"
    getsize
} "[expr $ax*3] $ay"
test macFont-7.23 {Tk_MeasureChars: p > end} {
    .b.l config -wrap [expr $ax*8] -text "00\xc2"
    getsize
} "[expr $ax*3] $ay"
test macFont-7.24 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic} {
    .b.l config -wrap [expr $ax*8] -text "00\u4e4e00"
    getsize
} "[expr $ax*4+$mx] $ay"
test macFont-7.25 {Tk_MeasureChars: measure no chars (in loop)} {gothic} {
    .b.l config -wrap [expr $ax*8] -text "\u4e4e00"
    getsize
} "[expr $mx+$ax*2] $ay"
test macFont-7.26 {Tk_MeasureChars: rest == NULL} {gothic} {
    .b.l config -wrap [expr $ax*20] -text "000000\u4e4e\u4e4e00"
    getsize
} "[expr $ax*8+$mx*2] $ay"
test macFont-7.27 {Tk_MeasureChars: rest != NULL in first segment} {gothic} {
    .b.l config -wrap [expr $ax*5] -text "000000\u4e4e\u4e4f00"
    getsize
} "[expr $ax*5] [expr $ay*3]"
test macFont-7.28 {Tk_MeasureChars: rest != NULL in next segment} {gothic} {
    # even some of the "0"s would fit after \u4e4d, they should all wrap to next line.  
    .b.l config -wrap [expr $ax*8] -text "\u4e4d\u4e4d000000\u4e4e\u4e4f00"
    getsize
} "[expr $ax*6+$mx] [expr $ay*3]"
test macFont-7.29 {Tk_MeasureChars: final measure} {gothic} {
    .b.l config -wrap [expr $ax*8] -text "\u4e4e00"
    getsize
} "[expr $mx+$ax*2] $ay"
test macFont-7.30 {Tk_MeasureChars: final measure (no chars)} {gothic} {
    .b.l config -wrap [expr $ax*8] -text "\u4e4e"
    getsize
} "$mx $ay"
test macFont-7.31 {Tk_MeasureChars: rest == NULL} {
    .b.l config -wrap [expr $ax*1000] -text 0000
    getsize
} "[expr $ax*4] $ay"
test macFont-7.32 {Tk_MeasureChars: rest != NULL} {
    .b.l config -wrap [expr $ax*6] -text "00000000"
    getsize
} "[expr $ax*6] [expr $ay*2]"

test macFont-8.1 {Tk_DrawChars procedure} {
    .b.l config -text "a"
    update
} {}

test macFont-9.1 {AllocMacFont: use old font} {
    font create xyz
    button .c -font xyz
    font configure xyz -family times
    update
    destroy .c
    font delete xyz
} {}
test macFont-9.2 {AllocMacFont: extract info from style} {
    font actual {Monaco 9 bold italic underline overstrike}
} {-family Monaco -size 9 -weight bold -slant italic -underline 1 -overstrike 0}
test macFont-9.3 {AllocMacFont: extract text metrics} {
    font metric {Geneva 10} -fixed
} {0}
test macFont-9.4 {AllocMacFont: extract text metrics} {
    font metric "Monaco 9" -fixed
} {1}

destroy .b

# cleanup
::tcltest::cleanupTests
return













Changes to tests/macMenu.test.

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
# This file is a Tcl script to test menus in Tk.  It is
# organized in the standard fashion for Tcl tests. This
# file tests the Macintosh-specific features of the menu
# system.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) macMenu.test 1.23 97/07/10 13:35:52




if {$tcl_platform(platform) != "macintosh"} {


    return
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"

    return
}

if {[info procs test] != "test"} {
    source defs
}

proc deleteWindows {} {
    foreach i [winfo children .] {
    	catch [destroy $i]
    }
}

deleteWindows






>
>

<
<
>
|
<
>
>
|
>

>
>







>



<
<
<
<







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
# This file is a Tcl script to test menus in Tk.  It is
# organized in the standard fashion for Tcl tests. This
# file tests the Macintosh-specific features of the menu
# system.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: macMenu.test,v 1.1.4.5 1999/03/26 00:07:59 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {$tcl_platform(platform) != "macintosh"} {
    puts "skipping: Mac only tests..."
    ::tcltest::cleanupTests
    return
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    ::tcltest::cleanupTests
    return
}





proc deleteWindows {} {
    foreach i [winfo children .] {
    	catch [destroy $i]
    }
}

deleteWindows
1557
1558
1559
1560
1561
1562
1563

1564


1565












    set tearoff [tkTearOffMenu .m1 40 40]
    $tearoff activate 0
    list [update] [destroy .m1]
} {{} {}}

test macMenu-45.1 {TkpMenuInit - called at boot time} {} {}


deleteWindows






















>

>
>

>
>
>
>
>
>
>
>
>
>
>
>
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
    set tearoff [tkTearOffMenu .m1 40 40]
    $tearoff activate 0
    list [update] [destroy .m1]
} {{} {}}

test macMenu-45.1 {TkpMenuInit - called at boot time} {} {}

# cleanup
deleteWindows
::tcltest::cleanupTests
return













Changes to tests/macWinMenu.test.

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















# This file is a Tcl script to test menus in Tk.  It is
# organized in the standard fashion for Tcl tests. It tests
# the common implementation of Macintosh and Windows menus.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) macWinMenu.test 1.13 97/04/10 14:41:29

if {$tcl_platform(platform) == "unix"} {
    return
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"

    return
}

if {[info procs test] != "test"} {
    source defs
}



proc deleteWindows {} {
    foreach i [winfo children .] {
    	catch [destroy $i]
    }
}

deleteWindows
wm geometry . {}
raise .

if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} {
    puts " Some tests were skipped because they could not be performed"
    puts " automatically on this platform. If you wish to execute them"
    puts " interactively, set the TCL variable INTERACTIVE and re-run"
    puts " the test."
}

test macWinMenu-1.1 {PreprocessMenu} {
    catch {destroy .m1}
    menu .m1 -postcommand "destroy .m1"
    .m1 add command -label "macWinMenu-1.1: Hit Escape"
    list [catch {.m1 post 40 40} msg] $msg
} {0 {}}
if {$tcl_platform(platform) != "windows" || [info exists INTERACTIVE]} {
    test macWinMenu-1.2 {PreprocessMenu} {
	catch {destroy .m1}
	catch {destroy .m2}
	set foo1 foo
	set foo2 foo
	menu .m1 -postcommand "set foo1 .m1"
	.m1 add cascade -menu .m2 -label "macWinMenu-1.2: Hit Escape"
	menu .m2 -postcommand "set foo2 .m2"
	update idletasks
	list [catch {.m1 post 40 40} msg] $msg [set foo1] [set foo2] [destroy .m1 .m2] [catch {unset foo1}] [catch {unset foo2}]

    } {0 .m2 .m1 .m2 {} 0 0}
}
test macWinMenu-1.3 {PreprocessMenu} {
    catch {destroy .l1}
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    label .l1 -text "Preparing menus..."
    pack .l1
    update idletasks
    menu .m1 -postcommand ".l1 configure -text \"Destroying .m1...\"; update idletasks; destroy .m1"
    menu .m2 -postcommand ".l1 configure -text \"Destroying .m2...\"; update idletasks; destroy .m2"
    menu .m3 -postcommand ".l1 configure -text \"Destroying .m3...\"; update idletasks; destroy .m3"
    .m1 add cascade -menu .m2 -label "macWinMenu-1.3: Hit Escape (.m2)"
    .m1 add cascade -menu .m3 -label ".m3"
    update idletasks
    list [catch {.m1 post 40 40} msg] $msg [destroy .l1 .m2 .m3]
} {0 {} {}}
test macWinMenu-1.4 {PreprocessMenu} {
    catch {destroy .l1}
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    catch {destroy .m4}
    label .l1 -text "Preparing menus..."
    pack .l1
    update idletasks
    menu .m1 -postcommand ".l1 configure -text \"Destroying .m1...\"; update idletasks; destroy .m1"
    .m1 add cascade -menu .m2 -label "macWinMenu-1.4: Hit Escape (.m2)"
    .m1 add cascade -menu .m3 -label ".m3"
    menu .m2 -postcommand ".l1 configure -text \"Destroying .m2...\"; update idletasks; destroy .m2"
    .m2 add cascade -menu .m4 -label ".m4"
    menu .m3 -postcommand ".l1 configure -text \"Destroying .m3...\"; update idletasks; destroy .m3"
    menu .m4 -postcommand ".l1 configure -text \"Destroying .m4...\"; update idletasks; destroy .m4"
    update idletasks
    list [catch {.m1 post 40 40} msg] $msg [destroy .l1 .m2 .m3 .m4]
} {0 {} {}}
test macWinMenu-1.5 {PreprocessMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -menu .m2 -label "You may need to hit Escape to get this menu to go away."
    menu .m2 -postcommand glorp
    list [catch {.m1 post 40 40} msg] $msg [destroy .m1 .m2]
} {1 {invalid command name "glorp"} {}}

if {$tcl_platform(platform) != "windows" || [info exists INTERACTIVE]} {
    test macWinMenu-2.1 {TkPreprocessMenu} {
	catch {destroy .m1}
	set foo test
	menu .m1 -postcommand "set foo 2.1"
	.m1 add command -label "macWinMenu-2.1: Hit Escape"
	list [catch {.m1 post 40 40} msg] $msg [set foo] [destroy .m1] [unset foo]
    } {0 2.1 2.1 {} {}}
}

deleteWindows




















>
>

<
<
>
|
<
|
|
<






>



|
|
<
>
>











<
<
<
<
<
<
<
|





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















|


















|








<
|
|
|
|
|
|
|
|
|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
# This file is a Tcl script to test menus in Tk.  It is
# organized in the standard fashion for Tcl tests. It tests
# the common implementation of Macintosh and Windows menus.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: macWinMenu.test,v 1.1.4.5 1999/03/26 00:08:00 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]

}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    ::tcltest::cleanupTests
    return
}

# Some tests require user interaction on non-unix platform
set ::tcltest::testConfig(nonUnixUserInteraction) \

    [expr {$::tcltest::testConfig(userInteraction) || \
	$::tcltest::testConfig(unixOnly)}]

proc deleteWindows {} {
    foreach i [winfo children .] {
    	catch [destroy $i]
    }
}

deleteWindows
wm geometry . {}
raise .








test macWinMenu-1.1 {PreprocessMenu} {macOrPc nonUnixUserInteraction} {
    catch {destroy .m1}
    menu .m1 -postcommand "destroy .m1"
    .m1 add command -label "macWinMenu-1.1: Hit Escape"
    list [catch {.m1 post 40 40} msg] $msg
} {0 {}}

test macWinMenu-1.2 {PreprocessMenu} {macOrPc nonUnixUserInteraction} {
    catch {destroy .m1}
    catch {destroy .m2}
    set foo1 foo
    set foo2 foo
    menu .m1 -postcommand "set foo1 .m1"
    .m1 add cascade -menu .m2 -label "macWinMenu-1.2: Hit Escape"
    menu .m2 -postcommand "set foo2 .m2"
    update idletasks
    list [catch {.m1 post 40 40} msg] $msg [set foo1] [set foo2] \
	    [destroy .m1 .m2] [catch {unset foo1}] [catch {unset foo2}]
} {0 .m2 .m1 .m2 {} 0 0}

test macWinMenu-1.3 {PreprocessMenu} {macOrPc nonUnixUserInteraction} {
    catch {destroy .l1}
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    label .l1 -text "Preparing menus..."
    pack .l1
    update idletasks
    menu .m1 -postcommand ".l1 configure -text \"Destroying .m1...\"; update idletasks; destroy .m1"
    menu .m2 -postcommand ".l1 configure -text \"Destroying .m2...\"; update idletasks; destroy .m2"
    menu .m3 -postcommand ".l1 configure -text \"Destroying .m3...\"; update idletasks; destroy .m3"
    .m1 add cascade -menu .m2 -label "macWinMenu-1.3: Hit Escape (.m2)"
    .m1 add cascade -menu .m3 -label ".m3"
    update idletasks
    list [catch {.m1 post 40 40} msg] $msg [destroy .l1 .m2 .m3]
} {0 {} {}}
test macWinMenu-1.4 {PreprocessMenu} {macOrPc} {
    catch {destroy .l1}
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    catch {destroy .m4}
    label .l1 -text "Preparing menus..."
    pack .l1
    update idletasks
    menu .m1 -postcommand ".l1 configure -text \"Destroying .m1...\"; update idletasks; destroy .m1"
    .m1 add cascade -menu .m2 -label "macWinMenu-1.4: Hit Escape (.m2)"
    .m1 add cascade -menu .m3 -label ".m3"
    menu .m2 -postcommand ".l1 configure -text \"Destroying .m2...\"; update idletasks; destroy .m2"
    .m2 add cascade -menu .m4 -label ".m4"
    menu .m3 -postcommand ".l1 configure -text \"Destroying .m3...\"; update idletasks; destroy .m3"
    menu .m4 -postcommand ".l1 configure -text \"Destroying .m4...\"; update idletasks; destroy .m4"
    update idletasks
    list [catch {.m1 post 40 40} msg] $msg [destroy .l1 .m2 .m3 .m4]
} {0 {} {}}
test macWinMenu-1.5 {PreprocessMenu} {macOrPc} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -menu .m2 -label "You may need to hit Escape to get this menu to go away."
    menu .m2 -postcommand glorp
    list [catch {.m1 post 40 40} msg] $msg [destroy .m1 .m2]
} {1 {invalid command name "glorp"} {}}


test macWinMenu-2.1 {TkPreprocessMenu} {macOrPc nonUnixUserInteraction} {
    catch {destroy .m1}
    set foo test
    menu .m1 -postcommand "set foo 2.1"
    .m1 add command -label "macWinMenu-2.1: Hit Escape"
    list [catch {.m1 post 40 40} msg] $msg [set foo] [destroy .m1] [unset foo]
} {0 2.1 2.1 {} {}}

# cleanup
deleteWindows
::tcltest::cleanupTests
return













Changes to tests/macscrollbar.test.

1
2
3
4
5
6


7
8
9

10
11


12

13
14
15
16
17
18
19
20
21
22
23
24
# This file is a Tcl script to test out scrollbar widgets and
# the "scrollbar" command of Tk.  This file only tests Macintosh
# specific features.  It is organized in the standard fashion for 
# Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) macscrollbar.test 1.3 97/06/24 13:48:34




# Only run this test on the Macintosh
if {$tcl_platform(platform) != "macintosh"} return

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .






>
>

<
<
>
|
<
>
>
|
>

|
|
|
|







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
# This file is a Tcl script to test out scrollbar widgets and
# the "scrollbar" command of Tk.  This file only tests Macintosh
# specific features.  It is organized in the standard fashion for 
# Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: macscrollbar.test,v 1.1.4.5 1999/03/26 00:08:00 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# Only run this test on the Macintosh
if {$tcl_platform(platform) != "macintosh"} {
    puts "skipping: Mac only tests..."
    ::tcltest::cleanupTests
    return
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
94
95
96
97
98
99
100
101
















    scrollbar .s2 -orient horizontal
    place .s2 -x 0 -y 284 -width 300
} {}

foreach i [winfo children .] {
    destroy $i
}
concat {}























|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
    scrollbar .s2 -orient horizontal
    place .s2 -x 0 -y 284 -width 300
} {}

foreach i [winfo children .] {
    destroy $i
}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/main.test.

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


















# This file contains tests for the tkMain.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) main.test 1.2 97/09/10 17:49:20

if {[info procs test] != "test"} {
    source defs
}

test main-1.1 {StdinProc} {unixOnly} {
    catch {removeFile script}
    set fd [open script w]
    puts $fd {
	close stdin; exit
    }
    close $fd
    if {[catch {exec $tktest <script} msg]} {
	set error 1
    } else {
	set error 0
    }

    list $error $msg
} {0 {}}

























|
|
<

|

|
|









|




>


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
# This file contains tests for the tkMain.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: main.test,v 1.1.4.6 1999/03/24 02:54:51 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test main-1.1 {StdinProc} {unixOnly} {
    catch {removeFile script}
    set fd [open script w]
    puts $fd {
	close stdin; exit
    }
    close $fd
    if {[catch {exec $::tcltest::tktest <script} msg]} {
	set error 1
    } else {
	set error 0
    }
    file delete -force script
    list $error $msg
} {0 {}}

# cleanup
catch {removeFile script}
::tcltest::cleanupTests
return













Changes to tests/menu.test.

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
# This file is a Tcl script to test menus in Tk.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) menu.test 1.43 97/10/28 13:51:13




if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"

    return
}

if {[info procs test] != "test"} {
    source defs
}

if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} {
    puts " Some tests were skipped because they could not be performed"
    puts " automatically on this platform. If you wish to execute them"
    puts " interactively, set the TCL variable INTERACTIVE and re-run"
    puts " the test."
    set testConfig(menuInteractive) 0
} else {
    set testConfig(menuInteractive) 1
}

proc deleteWindows {} {
    foreach i [winfo children .] {
    	catch [destroy $i]
    }
}





>
>

<
<
>
|
<
>
>
>





>



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







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
# This file is a Tcl script to test menus in Tk.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: menu.test,v 1.1.4.7 1999/03/26 00:08:01 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    ::tcltest::cleanupTests
    return
}




# Some tests require user interaction on non-unix platform



set ::tcltest::testConfig(nonUnixUserInteraction) \

    [expr {$::tcltest::testConfig(userInteraction) || \

	$::tcltest::testConfig(unixOnly)}]


proc deleteWindows {} {
    foreach i [winfo children .] {
    	catch [destroy $i]
    }
}

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
    wm geometry .t4 +0+0
    list [catch {menu .m1} msg] $msg [destroy .t2 .t3 .t4 .m1]
} {0 .m1 {}}

catch {destroy .m1}
menu .m1
set i 1
foreach test {
    {-activebackground #012345 #012345 non-existent
	    {unknown color name "non-existent"}}
    {-activeborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
    {-activeforeground #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-background #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-bg #110022 #110022 bogus {unknown color name "bogus"}}
    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
    {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
    {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
	    -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {}
	    {font "" doesn't exist}}
    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
    {-postcommand "any old string" "any old string" {} {}}
    {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
    {-selectcolor #110022 #110022 bogus {unknown color name "bogus"}}
    {-takefocus "any string" "any string" {} {}}
    {-tearoff 0 0}
    {-tearoff 1 1}
    {-tearoffcommand "any old string" "any old string" {} {}}
} {
    set name [lindex $test 0]


    test menu-2.$i {configuration options} {
	.m1 configure $name [lindex $test 1]
	lindex [.m1 configure $name] 4
    } [lindex $test 2]
    incr i
    if {[lindex $test 3] != ""} {


	test menu-2.$i {configuration options} {
	    list [catch {.m1 configure $name [lindex $test 3]} msg] $msg
	} [list 1 [lindex $test 4]]
    }
    .m1 configure $name [lindex [.m1 configure $name] 3]
    incr i
}
destroy .m1

# We need to test all of the options with all of the different types of







|


|





|








|






|
>
>
|
|

|

|
>
>
|
|
|







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
    wm geometry .t4 +0+0
    list [catch {menu .m1} msg] $msg [destroy .t2 .t3 .t4 .m1]
} {0 .m1 {}}

catch {destroy .m1}
menu .m1
set i 1
foreach configTest {
    {-activebackground #012345 #012345 non-existent
	    {unknown color name "non-existent"}}
    {-activeborderwidth 1.3 1.3 badValue {bad screen distance "badValue"}}
    {-activeforeground #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-background #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-bg #110022 #110022 bogus {unknown color name "bogus"}}
    {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"}}
    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
    {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
    {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
	    -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {}
	    {font "" doesn't exist}}
    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
    {-postcommand "any old string" "any old string" {} {}}
    {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
    {-selectcolor #110022 #110022 bogus {unknown color name "bogus"}}
    {-takefocus "any string" "any string" {} {}}
    {-tearoff 0 0}
    {-tearoff 1 1}
    {-tearoffcommand "any old string" "any old string" {} {}}
} {
    set name [lindex $configTest 0]
    set value [lindex $configTest 1]
    set result [lindex $configTest 2]
    test menu-2.$i [list configuration options $name $value $result] {
	.m1 configure $name $value
	lindex [.m1 configure $name] 4
    } $result
    incr i
    if {[lindex $configTest 3] != ""} {
	set value [lindex $configTest 3]
	set result [lindex $configTest 4]
	test menu-2.$i [list configuration options $name $value $result] {
	    list [catch {.m1 configure $name $value} msg] $msg
	} [list 1 $result]
    }
    .m1 configure $name [lindex [.m1 configure $name] 3]
    incr i
}
destroy .m1

# We need to test all of the options with all of the different types of
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
.m2 add command -label "test"
.m1 add cascade -label "cascade" -menu .m2
.m1 add separator
.m1 add checkbutton -label "checkbutton" -variable check -onvalue on -offvalue off
.m1 add radiobutton -label "radiobutton" -variable radio
image create photo image1 -file [file join $tk_library demos images earth.gif]

foreach test {
    {-activebackground 
        {{#012345 
            {{unknown option "-activebackground"} #012345 #012345 
            {unknown option "-activebackground"} #012345 #012345
            }
        }
        {non-existent 
            {{unknown option "-activebackground"} 
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    {unknown option "-activebackground"}
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    }
	}}
    }
    {-activeforeground
    	{{#ff0000 
    	    {{unknown option "-activeforeground"}
	    #ff0000 #ff0000 {unknown option "-activeforeground"} #ff0000 #ff0000
	    }
	}
	{non-existent
	    {{unknown option "-activeforeground"} 
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    {unknown option "-activeforeground"}
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    }
	}}
    }
    {-accelerator
    	{{"Ctrl+S" 
    	    {{unknown option "-accelerator"}
	    "Ctrl+S" "Ctrl+S" {unknown option "-accelerator"} 
	    "Ctrl+S" "Ctrl+S"
	    }
	}}
    }
    {-background
    	{{#ff0000 







|


















|















|







216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
.m2 add command -label "test"
.m1 add cascade -label "cascade" -menu .m2
.m1 add separator
.m1 add checkbutton -label "checkbutton" -variable check -onvalue on -offvalue off
.m1 add radiobutton -label "radiobutton" -variable radio
image create photo image1 -file [file join $tk_library demos images earth.gif]

foreach configTest {
    {-activebackground 
        {{#012345 
            {{unknown option "-activebackground"} #012345 #012345 
            {unknown option "-activebackground"} #012345 #012345
            }
        }
        {non-existent 
            {{unknown option "-activebackground"} 
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    {unknown option "-activebackground"}
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    }
	}}
    }
    {-activeforeground
    	{{#ff0000 
	    {{unknown option "-activeforeground"}
	    #ff0000 #ff0000 {unknown option "-activeforeground"} #ff0000 #ff0000
	    }
	}
	{non-existent
	    {{unknown option "-activeforeground"} 
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    {unknown option "-activeforeground"}
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    }
	}}
    }
    {-accelerator
    	{{"Ctrl+S" 
	    {{unknown option "-accelerator"}
	    "Ctrl+S" "Ctrl+S" {unknown option "-accelerator"} 
	    "Ctrl+S" "Ctrl+S"
	    }
	}}
    }
    {-background
    	{{#ff0000 
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298

299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    }
	}}
    }
    {-bitmap
    	{{questhead 
    	    {{unknown option "-bitmap"} questhead questhead 
    	    {unknown option "-bitmap"} questhead questhead
	    }
	}
	{badValue
	    {{unknown option "-bitmap"} 
	    {bitmap "badValue" not defined}
	    {bitmap "badValue" not defined}
	    {unknown option "-bitmap"}
	    {bitmap "badValue" not defined}
	    {bitmap "badValue" not defined}
	    }
	}}
    }
    {-columnbreak
	{{1
	    {{unknown option "-columnbreak"} 1 1 {unknown option "-columnbreak"} 1 1}

	}}
    }
    {-command
    	{{beep 
    	    {{unknown option "-command"} beep beep 
    	    {unknown option "-command"} beep beep
	    }
	}}
    }
    {-font
    	{{-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
    	    {{unknown option "-font"}
    	    -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
    	    -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
    	    {unknown option "-font"} 
    	    -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
    	    -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
	    }
	}
	{{kill rock stars}
	    {{unknown option "-font"}
	    {expected integer but got "rock"}
	    {expected integer but got "rock"}
	    {unknown option "-font"}
	    {expected integer but got "rock"}
	    {expected integer but got "rock"}
	    }
	}}
    }
    {-foreground
    	{{#110022 
    	    {{unknown option "-foreground"} #110022 #110022 
    	    {unknown option "-foreground"} #110022 #110022
	    }
	}
	{non-existent
	    {{unknown option "-foreground"} 
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    {unknown option "-foreground"}
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    }
	}}
    }
    {-image
    	{{image1 
    	    {{unknown option "-image"} image1 image1 
    	    {unknown option "-image"} image1 image1
	    }
	}
	{bogus
	    {{unknown option "-image"} 
	    {image "bogus" doesn't exist}
	    {image "bogus" doesn't exist}
	    {unknown option "-image"}







|
|














|
>




|
|





|


|
















|
|














|
|







274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    }
	}}
    }
    {-bitmap
    	{{questhead 
	    {{unknown option "-bitmap"} questhead questhead 
	    {unknown option "-bitmap"} questhead questhead
	    }
	}
	{badValue
	    {{unknown option "-bitmap"} 
	    {bitmap "badValue" not defined}
	    {bitmap "badValue" not defined}
	    {unknown option "-bitmap"}
	    {bitmap "badValue" not defined}
	    {bitmap "badValue" not defined}
	    }
	}}
    }
    {-columnbreak
	{{1
	    {{unknown option "-columnbreak"} 1 1 
	    {unknown option "-columnbreak"} 1 1}
	}}
    }
    {-command
    	{{beep 
	    {{unknown option "-command"} beep beep 
	    {unknown option "-command"} beep beep
	    }
	}}
    }
    {-font
    	{{-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
	    {{unknown option "-font"}
    	    -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
    	    -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
	    {unknown option "-font"} 
    	    -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
    	    -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
	    }
	}
	{{kill rock stars}
	    {{unknown option "-font"}
	    {expected integer but got "rock"}
	    {expected integer but got "rock"}
	    {unknown option "-font"}
	    {expected integer but got "rock"}
	    {expected integer but got "rock"}
	    }
	}}
    }
    {-foreground
    	{{#110022 
	    {{unknown option "-foreground"} #110022 #110022 
	    {unknown option "-foreground"} #110022 #110022
	    }
	}
	{non-existent
	    {{unknown option "-foreground"} 
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    {unknown option "-foreground"}
	    {unknown color name "non-existent"}
	    {unknown color name "non-existent"}
	    }
	}}
    }
    {-image
    	{{image1 
	    {{unknown option "-image"} image1 image1 
	    {unknown option "-image"} image1 image1
	    }
	}
	{bogus
	    {{unknown option "-image"} 
	    {image "bogus" doesn't exist}
	    {image "bogus" doesn't exist}
	    {unknown option "-image"}
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
	    {}
	    {}
	    }
	}}
    }
    {-indicatoron
    	{{1 
    	    {{unknown option "-indicatoron"}
    	    {unknown option "-indicatoron"}
    	    {unknown option "-indicatoron"} 
    	    {unknown option "-indicatoron"} 1 1
	    }
	}}
    }
    {-label
    	{{test 
    	    {{unknown option "-label"} test test 
    	    {unknown option "-label"} test test
	    }
	}}
    }
    {-menu
    	{{.m2 
    	    {{unknown option "-menu"}
    	    {unknown option "-menu"} .m2 
    	    {unknown option "-menu"}
    	    {unknown option "-menu"}
    	    {unknown option "-menu"}
	    }
	}}
    }
    {-offvalue
    	{{off
    	    {{unknown option "-offvalue"} 
    	    {unknown option "-offvalue"}
	    {unknown option "-offvalue"}
    	    {unknown option "-offvalue"}
    	    off
    	    {unknown option "-offvalue"}
	    }
	}}
    }
    {-onvalue
    	{{on
    	    {{unknown option "-onvalue"}
    	    {unknown option "-onvalue"}
    	    {unknown option "-onvalue"}
    	    {unknown option "-onvalue"}
    	    on 
      	    {unknown option "-onvalue"}
	    }
	}}
    }
    {-selectcolor
    	{{#110022 
    	    {{unknown option "-selectcolor"} 
    	    {unknown option "-selectcolor"}
    	    {unknown option "-selectcolor"} 
    	    {unknown option "-selectcolor"}
    	    #110022
    	    #110022
	    }
	}
	{non-existent
	    {{unknown option "-selectcolor"} 
	    {unknown option "-selectcolor"}







|
|
|
|





|
|





|
|
|
|
|





|
|

|

|





|
|
|
|

|





|
|
|
|







364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
	    {}
	    {}
	    }
	}}
    }
    {-indicatoron
    	{{1 
	    {{unknown option "-indicatoron"}
	    {unknown option "-indicatoron"}
	    {unknown option "-indicatoron"} 
	    {unknown option "-indicatoron"} 1 1
	    }
	}}
    }
    {-label
    	{{test 
	    {{unknown option "-label"} test test 
	    {unknown option "-label"} test test
	    }
	}}
    }
    {-menu
    	{{.m2 
	    {{unknown option "-menu"}
	    {unknown option "-menu"} .m2 
	    {unknown option "-menu"}
	    {unknown option "-menu"}
	    {unknown option "-menu"}
	    }
	}}
    }
    {-offvalue
    	{{off
	    {{unknown option "-offvalue"} 
	    {unknown option "-offvalue"}
	    {unknown option "-offvalue"}
	    {unknown option "-offvalue"}
    	    off
	    {unknown option "-offvalue"}
	    }
	}}
    }
    {-onvalue
    	{{on
	    {{unknown option "-onvalue"}
	    {unknown option "-onvalue"}
	    {unknown option "-onvalue"}
	    {unknown option "-onvalue"}
    	    on 
	    {unknown option "-onvalue"}
	    }
	}}
    }
    {-selectcolor
    	{{#110022 
	    {{unknown option "-selectcolor"} 
	    {unknown option "-selectcolor"}
	    {unknown option "-selectcolor"} 
	    {unknown option "-selectcolor"}
    	    #110022
    	    #110022
	    }
	}
	{non-existent
	    {{unknown option "-selectcolor"} 
	    {unknown option "-selectcolor"}
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
	    {}
	    {}
	    }
	}}
    }
    {-state
    	{{normal 
    	    {normal normal normal 
    	    {unknown option "-state"} normal normal
	    }
	}}
    }
    {-value
    	{{"any string"
    	    {{unknown option "-value"}
    	    {unknown option "-value"}







<
|







459
460
461
462
463
464
465

466
467
468
469
470
471
472
473
	    {}
	    {}
	    }
	}}
    }
    {-state
    	{{normal 

    	    {normal normal normal {unknown option "-state"} normal normal
	    }
	}}
    }
    {-value
    	{{"any string"
    	    {{unknown option "-value"}
    	    {unknown option "-value"}
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
	    {unknown option "-underline"}
	    {expected integer but got "3p"}
	    {expected integer but got "3p"}
	    }
	}}
    }
} {
    set name [lindex $test 0]
    foreach attempt [lindex $test 1] {
    	set value [lindex $attempt 0]
    	set options [lindex $attempt 1]
    	foreach item {0 1 2 3 4 5} {
    	    catch {unset msg}
    	    test menu-2.$i [list entry configuration options $name $item $value] {
            	set result [catch {.m1 entryconfigure $item $name $value} msg]
                if {$result == 1} {
            	    set msg
            	} else {
            	    lindex [.m1 entryconfigure $item $name] 4
            	}
    	    } [lindex $options $item]







|
|




|







501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
	    {unknown option "-underline"}
	    {expected integer but got "3p"}
	    {expected integer but got "3p"}
	    }
	}}
    }
} {
    set name [lindex $configTest 0]
    foreach attempt [lindex $configTest 1] {
    	set value [lindex $attempt 0]
    	set options [lindex $attempt 1]
    	foreach item {0 1 2 3 4 5} {
    	    catch {unset msg}
    	    test menu-2.$i [list entry configuration options $name $item $value [.m1 type $item]] {
            	set result [catch {.m1 entryconfigure $item $name $value} msg]
                if {$result == 1} {
            	    set msg
            	} else {
            	    lindex [.m1 entryconfigure $item $name] 4
            	}
    	    } [lindex $options $item]
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
destroy .m2

test menu-3.1 {MenuWidgetCmd procedure} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 option ?arg arg ...?"} {}}
test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} {menuInteractive} {
    catch {destroy .m1}
    menu .m1 -postcommand "destroy .m1"
    .m1 add command -label "menu-3.2: Hit Escape"
    list [catch {.m1 post 40 40} msg] $msg
} {0 {}}
test menu-3.3 {MenuWidgetCmd procedure, "activate" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 activate} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 activate index"} {}}
test menu-3.4 {MenuWidgetCmd procedure, "activate" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 activate "foo"} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
test menu-3.5 {MenuWidgetCmd procedure, "activate" option}  {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add separator
    list [catch {.m1 activate 2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.6 {MenuWidgetCmd procedure, "activate" option}  {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 entryconfigure 1 -state disabled
    list [catch {.m1 activate 1} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.7 {MenuWidgetCmd procedure, "activate" option}  {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 activate 1} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.8 {MenuWidgetCmd procedure, "add" option} {
    catch {destroy .m1}







|
















|






|






|







529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
destroy .m2

test menu-3.1 {MenuWidgetCmd procedure} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 option ?arg arg ...?"} {}}
test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} {nonUnixUserInteraction } {
    catch {destroy .m1}
    menu .m1 -postcommand "destroy .m1"
    .m1 add command -label "menu-3.2: Hit Escape"
    list [catch {.m1 post 40 40} msg] $msg
} {0 {}}
test menu-3.3 {MenuWidgetCmd procedure, "activate" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 activate} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 activate index"} {}}
test menu-3.4 {MenuWidgetCmd procedure, "activate" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 activate "foo"} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
test menu-3.5 {MenuWidgetCmd procedure, "activate" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add separator
    list [catch {.m1 activate 2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.6 {MenuWidgetCmd procedure, "activate" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 entryconfigure 1 -state disabled
    list [catch {.m1 activate 1} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.7 {MenuWidgetCmd procedure, "activate" option} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 activate 1} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.8 {MenuWidgetCmd procedure, "add" option} {
    catch {destroy .m1}
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
    list [catch {.m1 post foo 40} msg] $msg [destroy .m1]
} {1 {expected integer but got "foo"} {}}
test menu-3.49 {MenuWidgetCmd procedure, "post" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 post 40 bar} msg] $msg [destroy .m1]
} {1 {expected integer but got "bar"} {}}
test menu-3.50 {MenuWidgetCmd procedure, "post" option} {menuInteractive} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "menu-3.53: hit Escape" -command "puts hello"
    list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.51 {MenuWidgetCmd procedure, "postcascade" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 postcascade} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 postcascade index"} {}}
test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 postcascade foo} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {menuInteractive} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add command -label "menu-3.56 - hit Escape"
    menu .m2
    .m1 post 40 40
    .m1 add cascade -menu .m2







|















|







800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
    list [catch {.m1 post foo 40} msg] $msg [destroy .m1]
} {1 {expected integer but got "foo"} {}}
test menu-3.49 {MenuWidgetCmd procedure, "post" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 post 40 bar} msg] $msg [destroy .m1]
} {1 {expected integer but got "bar"} {}}
test menu-3.50 {MenuWidgetCmd procedure, "post" option} {nonUnixUserInteraction } {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "menu-3.53: hit Escape" -command "puts hello"
    list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.51 {MenuWidgetCmd procedure, "postcascade" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 postcascade} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 postcascade index"} {}}
test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 postcascade foo} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {nonUnixUserInteraction } {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add command -label "menu-3.56 - hit Escape"
    menu .m2
    .m1 post 40 40
    .m1 add cascade -menu .m2
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
    list [catch {.m1 type 0} msg] $msg [destroy .m1]
} {0 tearoff {}}
test menu-3.63 {MenuWidgetCmd procedure, "unpost" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 unpost foo} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 unpost"} {}}
test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} {menuInteractive} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "menu-3.68 - hit Escape"
    .m1 post 40 40 
    list [catch {.m1 unpost} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.65 {MenuWidgetCmd procedure, "yposition" option} {







|







885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
    list [catch {.m1 type 0} msg] $msg [destroy .m1]
} {0 tearoff {}}
test menu-3.63 {MenuWidgetCmd procedure, "unpost" option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 unpost foo} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 unpost"} {}}
test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} {nonUnixUserInteraction } {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "menu-3.68 - hit Escape"
    .m1 post 40 40 
    list [catch {.m1 unpost} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-3.65 {MenuWidgetCmd procedure, "yposition" option} {
909
910
911
912
913
914
915
916








917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935







936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962









963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
} {0 {}}
test menu-3.67 {MenuWidgetCmd procedure, bad option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 foo} msg] $msg [destroy .m1]
} {1 {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, or yposition} {}}

test menu-4.1 {TkInvokeMenu} {








    catch {destroy .m1}
    menu .m1
    list [catch {.m1 invoke 0} msg] [destroy .m1]
} {0 {}}
test menu-4.2 {TkInvokeMenu} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
    list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 on 0 {} {}}
test menu-4.3 {TkInvokeMenu} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
    .m1 invoke 1
    list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 off 0 {} {}}







test menu-4.4 {TkInvokeMenu} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add radiobutton -label "1" -variable foo -value one
    .m1 add radiobutton -label "2" -variable foo -value two
    .m1 add radiobutton -label "3" -variable foo -value three
    list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 one 0 {} {}}
test menu-4.5 {TkInvokeMenu} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add radiobutton -label "1" -variable foo -value one
    .m1 add radiobutton -label "2" -variable foo -value two
    .m1 add radiobutton -label "3" -variable foo -value three
    list [catch {.m1 invoke 2} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 two 0 {} {}}
test menu-4.6 {TkInvokeMenu} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add radiobutton -label "1" -variable foo -value one
    .m1 add radiobutton -label "2" -variable foo -value two
    .m1 add radiobutton -label "3" -variable foo -value three
    list [catch {.m1 invoke 3} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 three 0 {} {}}









test menu-4.7 {TkInvokeMenu} {
    catch {destroy .m1}
    catch {unset menu_test}
    menu .m1
    .m1 add command -label "test" -command "set menu_test menu-4.8"
    list [catch {.m1 invoke 1} msg] $msg [catch {set menu_test} msg2] $msg2 [catch {unset menu_test} msg3] $msg3 [destroy .m1]
} {0 menu-4.8 0 menu-4.8 0 {} {}}
test menu-4.8 {TkInvokeMenu} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label "test" -menu .m1.m2
    list [catch {.m1 invoke 1} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-4.9 {TkInvokeMenu} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test" -command ".m1 delete 1"
    list [catch {.m1 invoke 1} msg] $msg [catch {.m1 type "test"} msg2] $msg2 [destroy .m1]
} {0 {} 1 {bad menu entry index "test"} {}}

test menu-5.1 {DestroyMenuInstance} {







|
>
>
>
>
>
>
>
>




|






|







>
>
>
>
>
>
>
|








|








|








>
>
>
>
>
>
>
>
>
|






|





|







908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
} {0 {}}
test menu-3.67 {MenuWidgetCmd procedure, bad option} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 foo} msg] $msg [destroy .m1]
} {1 {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, or yposition} {}}

test menu-4.1 {TkInvokeMenu: disabled} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off \
	-state disabled
    list [catch {.m1 invoke 1} msg] [destroy .m1] $foo
} {0 {} off}
test menu-4.2 {TkInvokeMenu: tearoff} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 invoke 0} msg] [destroy .m1]
} {0 {}}
test menu-4.3 {TkInvokeMenu: checkbutton -on} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
    list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 on 0 {} {}}
test menu-4.4 {TkInvokeMenu: checkbutton -off} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
    .m1 invoke 1
    list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 off 0 {} {}}
test menu-4.5 {TkInvokeMenu: checkbutton array element} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add checkbutton -label "test" -variable foo(1) -onvalue on 
    list [catch {.m1 invoke 1} msg] $msg [catch {set foo(1)} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 on 0 {} {}}
test menu-4.6 {TkInvokeMenu: radiobutton} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add radiobutton -label "1" -variable foo -value one
    .m1 add radiobutton -label "2" -variable foo -value two
    .m1 add radiobutton -label "3" -variable foo -value three
    list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 one 0 {} {}}
test menu-4.7 {TkInvokeMenu: radiobutton} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add radiobutton -label "1" -variable foo -value one
    .m1 add radiobutton -label "2" -variable foo -value two
    .m1 add radiobutton -label "3" -variable foo -value three
    list [catch {.m1 invoke 2} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 two 0 {} {}}
test menu-4.8 {TkInvokeMenu: radiobutton} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add radiobutton -label "1" -variable foo -value one
    .m1 add radiobutton -label "2" -variable foo -value two
    .m1 add radiobutton -label "3" -variable foo -value three
    list [catch {.m1 invoke 3} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 three 0 {} {}}
test menu-4.9 {TkInvokeMenu: radiobutton array element} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add radiobutton -label "1" -variable foo(2) -value one
    .m1 add radiobutton -label "2" -variable foo(2) -value two
    .m1 add radiobutton -label "3" -variable foo(2) -value three
    list [catch {.m1 invoke 3} msg] $msg [catch {set foo(2)} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 three 0 {} {}}
test menu-4.10 {TkInvokeMenu} {
    catch {destroy .m1}
    catch {unset menu_test}
    menu .m1
    .m1 add command -label "test" -command "set menu_test menu-4.8"
    list [catch {.m1 invoke 1} msg] $msg [catch {set menu_test} msg2] $msg2 [catch {unset menu_test} msg3] $msg3 [destroy .m1]
} {0 menu-4.8 0 menu-4.8 0 {} {}}
test menu-4.11 {TkInvokeMenu} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label "test" -menu .m1.m2
    list [catch {.m1 invoke 1} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-4.12 {TkInvokeMenu} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test" -command ".m1 delete 1"
    list [catch {.m1 invoke 1} msg] $msg [catch {.m1 type "test"} msg2] $msg2 [destroy .m1]
} {0 {} 1 {bad menu entry index "test"} {}}

test menu-5.1 {DestroyMenuInstance} {
1427
1428
1429
1430
1431
1432
1433
















1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629











1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370






2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384

2385















} {0 {} red {}}
test menu-9.9 {ConfigureMenu} {
    catch {destroy .m1}
    menu .m1
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}

















test menu-10.1 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add checkbutton -variable foo -onvalue on -offvalue off -label "Nonsense"
    list [catch {.m1 entryconfigure 1 -variable bar} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
} {0 {} bar {}}
test menu-10.2 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 entryconfigure 1 -label ""} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
} {0 {} {} {}}
test menu-10.3 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command
    list [catch {.m1 entryconfigure 1 -label "test"} cmd] $cmd [.m1 entrycget 1 -label] [destroy .m1]
} {0 {} test {}}
test menu-10.4 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1 
    .m1 add command
    list [catch {.m1 entryconfigure 1 -accel "S"} msg] $msg [.m1 entrycget 1 -accel] [destroy .m1]
} {0 {} S {}}
test menu-10.5 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command
    list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
} {0 {} test {}}
test menu-10.6 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command
    list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-10.7 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m2
    menu .m1
    .m1 add cascade
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1 .m2]
} {0 {} {}}
test menu-10.8 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-10.9 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -menu .m3
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-10.10 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-10.11 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -menu .m2
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-10.12 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    catch {destroy .m4}
    catch {destroy .m5}
    menu .m1
    menu .m2 
    .m2 add cascade -menu .m1
    menu .m3 
    .m3 add cascade -menu .m1
    menu .m4 
    .m4 add cascade -menu .m1
    menu .m5 
    .m5 add cascade
    list [catch {.m5 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4 .m5]
} {0 {} {}}
test menu-10.13 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    catch {destroy .m4}
    menu .m1
    menu .m2 
    .m2 add cascade -menu .m1
    menu .m3 
    .m3 add cascade -menu .m1
    menu .m4 
    .m4 add cascade -menu .m1
    list [catch {.m3 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4]
} {0 {} {}}
test menu-10.14 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton
    list [catch {.m1 entryconfigure 1 -variable "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
} {0 {} test {}}
test menu-10.15 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add checkbutton -label "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
} {0 {} test {}}
test menu-10.16 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add radiobutton -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-10.17 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton
    list [catch {.m1 entryconfigure 1 -onvalue "test"} msg] $msg [.m1 entrycget 1 -onvalue] [destroy .m1]
} {0 {} test {}}
test menu-10.18 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {image delete image1}
    menu .m1
    .m1 add command
    image create test image1
    list [catch {.m1 entryconfigure 1 -image image1} msg] $msg [destroy .m1] [image delete image1]
} {0 {} {} {}}
test menu-10.19 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {image delete image1}
    catch {image delete image2}
    image create test image1
    image create photo image2 -file [file join $tk_library demos images earth.gif]
    menu .m1
    .m1 add command -image image1
    list [catch {.m1 entryconfigure 1 -image image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
} {0 {} {} {} {}}
test menu-10.20 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {image delete image1}
    catch {image delete image2}
    image create photo image1 -file [file join $tk_library demos images earth.gif]
    image create test image2
    menu .m1
    .m1 add checkbutton -image image1
    list [catch {.m1 entryconfigure 1 -selectimage image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
} {0 {} {} {} {}}
test menu-10.21 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {image delete image1}
    catch {image delete image2}
    catch {image delete image3}
    image create photo image1 -file [file join $tk_library demos images earth.gif]
    image create test image2
    image create test image3
    menu .m1
    .m1 add checkbutton -image image1 -selectimage image2
    list [catch {.m1 entryconfigure 1 -selectimage image3} msg] $msg [destroy .m1] [image delete image1] [image delete image2] [image delete image3]
} {0 {} {} {} {} {}}

test menu-11.1 {ConfigureMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    menu .m1
    .m1 clone .m2
    .m2 configure -tearoff 0
    .m1 clone .m3
    .m1 add command -label "test"
    .m1 add command -label "test2"
    list [list [catch {.m1 entryconfigure 1 -gork "foo"} msg] $msg] [destroy .m1]
} {{1 {unknown option "-gork"}} {}}
test menu-11.2 {ConfigureMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    catch {destroy .m4}
    menu .m1
    .m1 clone .m2
    menu .m3
    .m1 add cascade -menu .m3
    menu .m4
    list [catch {.m1 entryconfigure 1 -menu .m4} msg] $msg [destroy .m1] [destroy .m3] [destroy .m4]
} {0 {} {} {} {}}
test menu-11.3 {ConfigureMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 clone .m2
    .m1 add cascade -label dummy
    list [catch {.m1 entryconfigure dummy -menu .m3} msg] $msg [destroy .m1]
} {0 {} {}}












test menu-12.1 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "active"
    .m1 add command -label "test2"
    .m1 add command -label "test3"
    .m1 activate 2
    list [catch {.m1 entrycget active -label} msg] $msg [destroy .m1]
} {0 test2 {}}
test menu-12.2 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "last"
    .m1 add command -label "test2"
    .m1 add command -label "test3"
    .m1 activate 2
    list [catch {.m1 entrycget last -label} msg] $msg [destroy .m1]
} {0 test3 {}}
test menu-12.3 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "last"
    .m1 add command -label "test2"
    .m1 add command -label "test3"
    .m1 activate 2
    list [catch {.m1 entrycget end -label} msg] $msg [destroy .m1]
} {0 test3 {}}
test menu-12.4 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 insert last command -label "test2"} msg] $msg [.m1 entrycget last -label] [destroy .m1]
} {0 {} test2 {}}
test menu-12.5 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 insert end command -label "test2"} msg] $msg [.m1 entrycget end -label] [destroy .m1]
} {0 {} test2 {}}
test menu-12.6 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "active"
    .m1 add command -label "test2"
    .m1 add command -label "test3"
    .m1 activate 2
    list [catch {.m1 entrycget none -label} msg] $msg [destroy .m1]
} {0 {} {}}
#test menu-13.7 - Need to add @test here.
test menu-12.7 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "active"
    .m1 add command -label "test2"
    .m1 add command -label "test3"
    list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
} {0 active {}}
test menu-12.8 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "active"
    list [catch {.m1 entrycget -1 -label} msg] $msg [destroy .m1]
} {1 {bad menu entry index "-1"} {}}
test menu-12.9 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add command -label "test2"
    list [catch {.m1 entrycget 999 -label} msg] $msg [destroy .m1]
} {0 test2 {}}
test menu-12.10 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 insert 999 command -label "test"
    list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
} {0 test {}}
test menu-12.11 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "1test"
    list [catch {.m1 entrycget 1test -label} msg] $msg [destroy .m1]
} {0 1test {}}
test menu-12.12 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add command -label "test2" -command "beep"
    .m1 add command -label "test3"
    list [catch {.m1 entrycget test2 -command} msg] $msg [destroy .m1]
} {0 beep {}}

test menu-13.1 {MenuCmdDeletedProc} {
    catch {destroy .m1}
    menu .m1
    list [catch {destroy .m1} msg] $msg
} {0 {}}
test menu-13.2 {MenuCmdDeletedProc} {
    catch {destroy .m1}
    menu .m1
    .m1 clone .m2
    list [catch {destroy .m1} msg] $msg
} {0 {}}

test menu-14.1 {MenuNewEntry} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-14.2 {MenuNewEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add command -label "test3"
    list [catch {.m1 insert 2 command -label "test2"} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-14.3 {MenuNewEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 add command -label "test2"} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-14.4 {MenuNewEntry} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}

test menu-15.1 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 insert foo command -label "test"} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
test menu-15.2 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 insert test command -label "foo"} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-15.3 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 insert -1 command -label "test"} msg] $msg [destroy .m1]
} {1 {bad menu entry index "-1"} {}}
test menu-15.4 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 insert 0 command -label "test2"
    list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
} {0 test2 {}}
test menu-15.5 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add cascade} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-15.6 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add checkbutton} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-15.7 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-15.8 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add radiobutton} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-15.9 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add separator} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-15.10 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add blork} msg] $msg [destroy .m1]
} {1 {bad menu entry type "blork": must be cascade, checkbutton, command, radiobutton, or separator} {}}
test menu-15.11 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-15.12 {MenuAddOrInsert} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    menu .m1
    .m1 clone .m2
    .m2 clone .m3
    list [catch {.m2 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m3 entrycget 1 -label} msg3] $msg3 [destroy .m1]
} {0 {} 0 test 0 test {}}
test menu-15.13 {MenuAddOrInsert} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    menu .m1
    .m1 clone .m2
    .m2 clone .m3
    list [catch {.m3 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m2 entrycget 1 -label} msg3] $msg3 [destroy .m1]
} {0 {} 0 test 0 test {}}
test menu-15.14 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -blork} msg] $msg [destroy .m1]
} {1 {unknown option "-blork"} {}}
test menu-15.15 {MenuAddOrInsert} {
    catch {destroy .m1}
    catch {destroy .container}
    menu .m1
    .m1 add command -label "File"
    menu .container
    . configure -menu .container
    list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .container .m1]
} {0 {} {} {}}
test menu-15.16 {MenuAddOrInsert} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    menu .m2
    set tearoff [tkTearOffMenu .m2]
    list [catch {.m2 add cascade -menu .m1} msg] $msg [$tearoff unpost] [catch {destroy .m1} msg2] $msg2 [catch {destroy .m2} msg3] $msg3
} {0 {} {} 0 {} 0 {}}
test menu-15.17 {MenuAddOrInsert} {
    catch {destroy .m1}
    catch {destroy .container}
    menu .m1
    menu .container
    . configure -menu .container
    set tearoff [tkTearOffMenu .container]
    list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
} {0 {} {} {}}
test menu-15.18 {MenuAddOrInsert} {
    catch {destroy .m1}
    catch {destroy .container}
    menu .m1
    menu .container
    .container add cascade -menu .m1
    . configure -menu .container
    list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
} {0 {} {} {}}
test menu-15.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
    catch {destroy .menubar}
    menu .menubar
    menu .menubar.test -tearoff 0
    .menubar add cascade -label Test -underline 0 -menu .menubar.test
    menu .menubar.test.cascade -tearoff 0
    .menubar.test.cascade add command -label SubItem -command "puts SubItemSelected"
    . configure -menu .menubar
    list [catch {.menubar.test add cascade -label SubMenu \
	-menu .menubar.test.cascade} msg] \
	[info commands .\#menubar.\#menubar\#test.\#menubar\#test\#cascade] \
	[. configure -menu ""] [destroy .menubar]
} {0 .#menubar.#menubar#test.#menubar#test#cascade {} {}}

test menu-16.1 {MenuVarProc} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    set foo "hello"
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [catch {unset foo} msg2] $msg2 [destroy .m1]
} {0 {} 0 {} {}}
# menu-17.2 - Don't know how to generate the flags in the if
test menu-16.2 {MenuVarProc} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo ""] [destroy .m1]
} {0 {} {} {}}
test menu-16.3 {MenuVarProc} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    set foo "hello"
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
} {0 {} hello {} 0 {}}
test menu-16.4 {MenuVarProc} {
    catch {destroy .m1}
    menu .m1
    set foo "goodbye"
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
} {0 {} hello {} 0 {}}
test menu-16.5 {MenuVarProc} {
    catch {destroy .m1}
    menu .m1
    set foo "hello"
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "goodbye"] [destroy .m1] [catch {unset foo} msg2] $msg2
} {0 {} goodbye {} 0 {}}

test menu-17.1 {TkActivateMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 activate 1} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-17.2 {TkActivateMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 activate 0} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-17.3 {TkActivateMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add command -label "test2"
    .m1 activate 1
    list [catch {.m1 activate 2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-17.4 {TkActivateMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add command -label "test2"
    .m1 activate 1
    list [catch {.m1 activate 1} msg] $msg [destroy .m1]
} {0 {} {}}

test menu-18.1 {TkPostCommand} {menuInteractive} {
    catch {destroy .m1}
    menu .m1 -postcommand "set menu_test menu-19.1"
    .m1 add command -label "menu-19.1 - hit Escape"
    list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [set menu_test] [destroy .m1]
} {0 menu-19.1 {} menu-19.1 {}}
test menu-18.2 {TkPostCommand} {menuInteractive} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "menu-19.2 - hit Escape"
    list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [destroy .m1]
} {0 {} {} {}}

test menu-19.1 {CloneMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    list [catch {.m1 clone .m2} msg1] $msg1 [destroy .m1]
} {0 {} {}}
test menu-19.2 {CloneMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    list [catch {.m1 clone .m2 normal} msg1] $msg1 [destroy .m1]
} {0 {} {}}
test menu-19.3 {CloneMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    list [catch {.m1 clone .m2 tearoff} msg1] $msg1 [destroy .m1]
} {0 {} {}}
test menu-19.4 {CloneMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    list [catch {.m1 clone .m2 menubar} msg1] $msg1 [destroy .m1]
} {0 {} {}}
test menu-19.5 {CloneMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    list [catch {.m1 clone .m2 foo} msg1] $msg1 [destroy .m1]
} {1 {bad menu type - must be normal, tearoff, or menubar} {}}
test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    list [catch {.m1 clone .m2} msg] $msg [destroy .m1]
 } {0 {} {}}
 test menu-19.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    menu .m1
    .m1 clone .m2
    list [catch {.m1 clone .m3} msg] $msg [destroy .m1]
 } {0 {} {}}
 test menu-19.8 {CloneMenu - cascade entries} {
    catch {destroy .m1}
    catch {destroy .foo}
    menu .m1
    .m1 add cascade -menu .m2
    list [catch {.m1 clone .foo} msg] $msg [destroy .m1]
 } {0 {} {}}
 test menu-19.9 {CloneMenu - cascades entries} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .foo}
    menu .m1
    .m1 add cascade -menu .m2
    menu .m2
    list [catch {.m1 clone .foo} msg] $msg [destroy .m1 .m2]
 } {0 {} {}}
test menu-19.10 {CloneMenu - tearoff fields} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    list [catch {.m1 clone .m2 normal} msg1] $msg1 [catch {.m2 cget -tearoff} msg2] $msg2 [destroy .m1]
} {0 {} 0 1 {}}
test menu-19.11 {CloneMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    menu .m2
    list [catch {.m1 clone .m2} msg] $msg [destroy .m1 .m2]
} {1 {window name "m2" already exists in parent} {}}

test menu-20.1 {MenuDoYPosition} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 yposition glorp} msg] $msg [destroy .m1]
} {1 {bad menu entry index "glorp"} {}}
test menu-20.2 {MenuDoYPosition} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "Test"
    list [catch {.m1 yposition 1}] [destroy .m1]
} {0 {}}

test menu-21.1 {GetIndexFromCoords} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 configure -tearoff 0
    list [catch {.m1 index @5} msg] $msg [destroy .m1]
} {0 0 {}}
test menu-21.2 {GetIndexFromCoords} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 configure -tearoff 0
    list [catch {.m1 index @5,5} msg] $msg [destroy .m1]
} {0 0 {}}

test menu-22.1 {RecursivelyDeleteMenu} {
    catch {destroy .m1}
    menu .m1
    . configure -menu .m1
    list [catch {. configure -menu ""} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-22.2 {RecursivelyDeleteMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m2
    .m2 add command -label "test2"
    menu .m1
    .m1 add cascade -label "test1" -menu .m2
    . configure -menu .m1
    list [catch {. configure -menu ""} msg] $msg [destroy .m1 .m2]
} {0 {} {}}

test menu-23.1 {TkNewMenuName} {
    catch {destroy .m1}
    menu .m1
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test menu-23.2 {TkNewMenuName} {
    catch {destroy .m1}
    catch {destroy .m1\#0}
    menu .m1
    menu .m1\#0
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test menu-23.3 {TkNewMenuName} {
    catch {destroy .#m}
    menu .#m
    rename .#m hideme
    list [catch {. configure -menu [menu .m]} $msg] [. configure -menu ""] [destroy .#m] [destroy .m] [destroy hideme]
} {0 {} {} {} {}}

test menu-24.1 {TkSetWindowMenuBar} {
    . configure -menu ""
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
test menu-24.2 {TkSetWindowMenuBar} {
    . configure -menu ""
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
test menu-24.3 {TkSetWindowMenuBar} {
    . configure -menu ""
    catch {destroy .m1}
    menu .m1
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test menu-24.4 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    . configure -menu ""
    menu .m1
    . configure -menu .m1
    menu .m2
    list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
} {0 {} {} {}}
test menu-24.5 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    . configure -menu ""
    menu .m1
    . configure -menu .m1
    .m1 clone .m2
    menu .m3
    list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
} {0 {} {} {}}
test menu-24.6 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    . configure -menu ""
    menu .m1
    .m1 clone .m2
    . configure -menu .m2
    menu .m3
    list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
} {0 {} {} {}}
test menu-24.7 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    . configure -menu ""
    menu .m1
    menu .m2
    . configure -menu .m1
    toplevel .t2
    .t2 configure -menu .m1
    list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
} {0 {} {} {}}
test menu-24.8 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .t2}
    . configure -menu ""
    menu .m1
    menu .m2
    . configure -menu .m1
    toplevel .t2
    wm geometry .t2 +0+0
    .t2 configure -menu .m1
    list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
} {0 {} {} {}}
test menu-24.9 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .t2}
    catch {destroy .t3}
    . configure -menu ""
    menu .m1
    menu .m2
    . configure -menu .m1
    toplevel .t2 -menu .m1
    wm geometry .t2 +0+0
    toplevel .t3 -menu .m1
    wm geometry .t3 +0+0
    list [catch {.t3 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
} {0 {} {} {}}
test menu-24.10 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .t2}
    catch {destroy .t3}
    . configure -menu ""
    menu .m1
    menu .m2
    . configure -menu .m1
    toplevel .t2 -menu .m1
    wm geometry .t2 +0+0
    toplevel .t3 -menu .m1
    wm geometry .t3 +0+0
    list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
} {0 {} {} {}}
test menu-24.11 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .t2}
    catch {destroy .t3}
    . configure -menu ""
    menu .m1
    menu .m2
    . configure -menu .m1
    toplevel .t2 -menu .m1
    wm geometry .t2 +0+0
    toplevel .t3 -menu .m1
    wm geometry .t3 +0+0
    list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
} {0 {} {} {}}
test menu-24.12 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test menu-24.13 {TkSetWindowMenuBar} {
    . configure -menu ""
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
test menu-24.14 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test menu-24.15 {TkSetWindowMenuBar} {
    . configure -menu ""
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
test menu-24.16 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    . configure -menu .m1
    list [catch {toplevel .t2 -menu m1} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
} {0 .t2 {} {}}

test menu-25.1 {DestroyMenuHashTable} {
    catch {interp destroy testinterp}
    interp create testinterp
    load {} Tk testinterp
    interp eval testinterp {menu .m1}
    list [catch {interp delete testinterp} msg] $msg
} {0 {}}

test menu-26.1 {GetMenuHashTable} {
    catch {interp destroy testinterp}
    interp create testinterp
    load {} tk testinterp
    list [catch {interp eval testinterp {menu .m1}} msg] $msg [interp delete testinterp]
} {0 .m1 {}}

test menu-27.1 {TkCreateMenuReferences - not there before} {
    catch {destroy .m1}
    list [catch {menu .m1} msg] $msg [destroy .m1]
} {0 .m1 {}}
test menu-27.2 {TkCreateMenuReferences - there already} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -menu .m2
    list [catch {menu .m2} msg] $msg [destroy .m1 .m2]
} {0 .m2 {}}

test menu-28.1 {TkFindMenuReferences - not there} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    .m1 add cascade -menu .m2
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test menu-29.1 {TkFindMenuReferences - there already} {
    catch {destroy .m1}
    catch {destroy .m2}
    . configure -menu ""
    menu .m1
    menu .m2
    .m1 add cascade -menu .m2
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
} {0 {} {} {}}

test menu-30.1 {TkFreeMenuReferences - menuPtr} {
    catch {destroy .m1}
    menu .m1
    list [catch {destroy .m1} msg] $msg
} {0 {}}
test menu-30.2 {TkFreeMenuReferences - cascadePtr} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    .m1 add cascade -menu .m2
    list [catch {.m1 entryconfigure 1 -menu .m3} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-30.3 {TkFreeMenuReferences - topLevelListPtr} {
    . configure -menu .m1
    list [catch {. configure -menu ""} msg] $msg
} {0 {}}
test menu-30.4 {TkFreeMenuReferences - not empty} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -menu .m3
    menu .m2
    .m2 add cascade -menu .m3
    list [catch {.m2 entryconfigure 1 -menu ".foo"} msg] $msg [destroy .m1 .m2]
} {0 {} {}}

test menu-31.1 {DeleteMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add command -label foo
    .m1 clone .m2
    list [catch {.m1 delete 1} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-31.2 {DeleteMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add command -label one
    .m1 add command -label two
    .m1 add command -label three
    .m1 add command -label four
    .m1 clone .m2
    list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-31.3 {DeleteMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1 -tearoff 0
    .m1 add command -label one
    .m1 add command -label two
    .m1 add command -label three
    .m1 add command -label four
    .m1 clone .m2
    .m2 configure -tearoff 1
    list [catch {.m1 delete 1 2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-31.4 {DeleteMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add command -label one
    .m1 add command -label two
    .m1 add command -label three
    .m1 add command -label four
    .m1 clone .m2
    .m2 configure -tearoff 0
    list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-31.5 {DeleteMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add command -label one
    .m1 add command -label two
    .m1 clone .m2
    .m1 activate one
    list [catch {.m1 delete one} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-31.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label test -command ".m1 delete test ; .m1 add command -label test -command \".m1 delete test\"; .m1 delete test"
    list [catch {.m1 invoke test} msg] $msg [destroy .m1]
} {0 {} {}}







set l [interp hidden]
eval destroy [winfo children .]

test menu-32.1 {menu vs command hiding} {
    catch {destroy .m}
    menu .m
    interp hide {} .m
    destroy .m
    list [winfo children .] [interp hidden]
} [list {} $l]

# menu-34 MenuInit only called at boot time


deleteWindows






















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






|





|





|





|





|





|







|





|





|





|





|
















|













|





|




|




|





|







|









|









|












|











|











|








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








|








|








|





|





|









|







|





|






|





|





|








|




|






|




|






|





|





|




|





|




|






|




|




|




|




|




|




|




|








|








|




|








|







|








|








|













|







|





|






|





|






|





|





|







|








|





|






|





|





|





|





|




|
|





|







|






|








|





|







|




|






|






|







|





|










|




|






|






|



|



|





|








|










|










|










|












|














|














|














|





|



|





|



|







|







|






|



|







|






|









|




|






|



|









|







|










|











|











|









|





>
>
>
>
>
>




|









>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
} {0 {} red {}}
test menu-9.9 {ConfigureMenu} {
    catch {destroy .m1}
    menu .m1
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}

test menu-10.1 {PostProcessEntry: array variable} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    set foo(1) on
    .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense"
    list [catch {set foo(1)} msg] $msg [destroy .m1]
} {0 on {}}
test menu-10.2 {PostProcessEntry: array variable} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense"
    list [catch {set foo(1)} msg] $msg [destroy .m1]
} {0 off {}}

test menu-11.1 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add checkbutton -variable foo -onvalue on -offvalue off -label "Nonsense"
    list [catch {.m1 entryconfigure 1 -variable bar} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
} {0 {} bar {}}
test menu-11.2 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 entryconfigure 1 -label ""} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
} {0 {} {} {}}
test menu-11.3 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command
    list [catch {.m1 entryconfigure 1 -label "test"} cmd] $cmd [.m1 entrycget 1 -label] [destroy .m1]
} {0 {} test {}}
test menu-11.4 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1 
    .m1 add command
    list [catch {.m1 entryconfigure 1 -accel "S"} msg] $msg [.m1 entrycget 1 -accel] [destroy .m1]
} {0 {} S {}}
test menu-11.5 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command
    list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
} {0 {} test {}}
test menu-11.6 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command
    list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-11.7 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m2
    menu .m1
    .m1 add cascade
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1 .m2]
} {0 {} {}}
test menu-11.8 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-11.9 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -menu .m3
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-11.10 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-11.11 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -menu .m2
    list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-11.12 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    catch {destroy .m4}
    catch {destroy .m5}
    menu .m1
    menu .m2 
    .m2 add cascade -menu .m1
    menu .m3 
    .m3 add cascade -menu .m1
    menu .m4 
    .m4 add cascade -menu .m1
    menu .m5 
    .m5 add cascade
    list [catch {.m5 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4 .m5]
} {0 {} {}}
test menu-11.13 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    catch {destroy .m4}
    menu .m1
    menu .m2 
    .m2 add cascade -menu .m1
    menu .m3 
    .m3 add cascade -menu .m1
    menu .m4 
    .m4 add cascade -menu .m1
    list [catch {.m3 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4]
} {0 {} {}}
test menu-11.14 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton
    list [catch {.m1 entryconfigure 1 -variable "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
} {0 {} test {}}
test menu-11.15 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add checkbutton -label "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
} {0 {} test {}}
test menu-11.16 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add radiobutton -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-11.17 {ConfigureMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton
    list [catch {.m1 entryconfigure 1 -onvalue "test"} msg] $msg [.m1 entrycget 1 -onvalue] [destroy .m1]
} {0 {} test {}}
test menu-11.18 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {image delete image1}
    menu .m1
    .m1 add command
    image create test image1
    list [catch {.m1 entryconfigure 1 -image image1} msg] $msg [destroy .m1] [image delete image1]
} {0 {} {} {}}
test menu-11.19 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {image delete image1}
    catch {image delete image2}
    image create test image1
    image create photo image2 -file [file join $tk_library demos images earth.gif]
    menu .m1
    .m1 add command -image image1
    list [catch {.m1 entryconfigure 1 -image image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
} {0 {} {} {} {}}
test menu-11.20 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {image delete image1}
    catch {image delete image2}
    image create photo image1 -file [file join $tk_library demos images earth.gif]
    image create test image2
    menu .m1
    .m1 add checkbutton -image image1
    list [catch {.m1 entryconfigure 1 -selectimage image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
} {0 {} {} {} {}}
test menu-11.21 {ConfigureMenuEntry} {
    catch {destroy .m1}
    catch {image delete image1}
    catch {image delete image2}
    catch {image delete image3}
    image create photo image1 -file [file join $tk_library demos images earth.gif]
    image create test image2
    image create test image3
    menu .m1
    .m1 add checkbutton -image image1 -selectimage image2
    list [catch {.m1 entryconfigure 1 -selectimage image3} msg] $msg [destroy .m1] [image delete image1] [image delete image2] [image delete image3]
} {0 {} {} {} {} {}}

test menu-12.1 {ConfigureMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    menu .m1
    .m1 clone .m2
    .m2 configure -tearoff 0
    .m1 clone .m3
    .m1 add command -label "test"
    .m1 add command -label "test2"
    list [list [catch {.m1 entryconfigure 1 -gork "foo"} msg] $msg] [destroy .m1]
} {{1 {unknown option "-gork"}} {}}
test menu-12.2 {ConfigureMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    catch {destroy .m4}
    menu .m1
    .m1 clone .m2
    menu .m3
    .m1 add cascade -menu .m3
    menu .m4
    list [catch {.m1 entryconfigure 1 -menu .m4} msg] $msg [destroy .m1] [destroy .m3] [destroy .m4]
} {0 {} {} {} {}}
test menu-12.3 {ConfigureMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 clone .m2
    .m1 add cascade -label dummy
    list [catch {.m1 entryconfigure dummy -menu .m3} msg] $msg [destroy .m1]
} {0 {} {}}

test menu-12.4 {ConfigureMenuCloneEntries} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
     .m1 add cascade -label File -menu .m1.foo
     menu .m1.foo
     .m1.foo add command -label bar
     .m1 clone .m2
     list [catch {.m1 entryconfigure File -state disabled} msg1] $msg1 [destroy .m1]
} {0 {} {}}

test menu-13.1 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "active"
    .m1 add command -label "test2"
    .m1 add command -label "test3"
    .m1 activate 2
    list [catch {.m1 entrycget active -label} msg] $msg [destroy .m1]
} {0 test2 {}}
test menu-13.2 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "last"
    .m1 add command -label "test2"
    .m1 add command -label "test3"
    .m1 activate 2
    list [catch {.m1 entrycget last -label} msg] $msg [destroy .m1]
} {0 test3 {}}
test menu-13.3 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "last"
    .m1 add command -label "test2"
    .m1 add command -label "test3"
    .m1 activate 2
    list [catch {.m1 entrycget end -label} msg] $msg [destroy .m1]
} {0 test3 {}}
test menu-13.4 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 insert last command -label "test2"} msg] $msg [.m1 entrycget last -label] [destroy .m1]
} {0 {} test2 {}}
test menu-13.5 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 insert end command -label "test2"} msg] $msg [.m1 entrycget end -label] [destroy .m1]
} {0 {} test2 {}}
test menu-13.6 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "active"
    .m1 add command -label "test2"
    .m1 add command -label "test3"
    .m1 activate 2
    list [catch {.m1 entrycget none -label} msg] $msg [destroy .m1]
} {0 {} {}}
#test menu-13.7 - Need to add @test here.
test menu-13.7 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "active"
    .m1 add command -label "test2"
    .m1 add command -label "test3"
    list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
} {0 active {}}
test menu-13.8 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "active"
    list [catch {.m1 entrycget -1 -label} msg] $msg [destroy .m1]
} {1 {bad menu entry index "-1"} {}}
test menu-13.9 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add command -label "test2"
    list [catch {.m1 entrycget 999 -label} msg] $msg [destroy .m1]
} {0 test2 {}}
test menu-13.10 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 insert 999 command -label "test"
    list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
} {0 test {}}
test menu-13.11 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "1test"
    list [catch {.m1 entrycget 1test -label} msg] $msg [destroy .m1]
} {0 1test {}}
test menu-13.12 {TkGetMenuIndex} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add command -label "test2" -command "beep"
    .m1 add command -label "test3"
    list [catch {.m1 entrycget test2 -command} msg] $msg [destroy .m1]
} {0 beep {}}

test menu-14.1 {MenuCmdDeletedProc} {
    catch {destroy .m1}
    menu .m1
    list [catch {destroy .m1} msg] $msg
} {0 {}}
test menu-14.2 {MenuCmdDeletedProc} {
    catch {destroy .m1}
    menu .m1
    .m1 clone .m2
    list [catch {destroy .m1} msg] $msg
} {0 {}}

test menu-15.1 {MenuNewEntry} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-15.2 {MenuNewEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add command -label "test3"
    list [catch {.m1 insert 2 command -label "test2"} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-15.3 {MenuNewEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 add command -label "test2"} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-15.4 {MenuNewEntry} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}

test menu-16.1 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 insert foo command -label "test"} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
test menu-16.2 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 insert test command -label "foo"} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-16.3 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 insert -1 command -label "test"} msg] $msg [destroy .m1]
} {1 {bad menu entry index "-1"} {}}
test menu-16.4 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 insert 0 command -label "test2"
    list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
} {0 test2 {}}
test menu-16.5 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add cascade} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-16.6 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add checkbutton} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-16.7 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-16.8 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add radiobutton} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-16.9 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add separator} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-16.10 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add blork} msg] $msg [destroy .m1]
} {1 {bad menu entry type "blork": must be cascade, checkbutton, command, radiobutton, or separator} {}}
test menu-16.11 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-16.12 {MenuAddOrInsert} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    menu .m1
    .m1 clone .m2
    .m2 clone .m3
    list [catch {.m2 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m3 entrycget 1 -label} msg3] $msg3 [destroy .m1]
} {0 {} 0 test 0 test {}}
test menu-16.13 {MenuAddOrInsert} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    menu .m1
    .m1 clone .m2
    .m2 clone .m3
    list [catch {.m3 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m2 entrycget 1 -label} msg3] $msg3 [destroy .m1]
} {0 {} 0 test 0 test {}}
test menu-16.14 {MenuAddOrInsert} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -blork} msg] $msg [destroy .m1]
} {1 {unknown option "-blork"} {}}
test menu-16.15 {MenuAddOrInsert} {
    catch {destroy .m1}
    catch {destroy .container}
    menu .m1
    .m1 add command -label "File"
    menu .container
    . configure -menu .container
    list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .container .m1]
} {0 {} {} {}}
test menu-16.16 {MenuAddOrInsert} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    menu .m2
    set tearoff [tkTearOffMenu .m2]
    list [catch {.m2 add cascade -menu .m1} msg] $msg [$tearoff unpost] [catch {destroy .m1} msg2] $msg2 [catch {destroy .m2} msg3] $msg3
} {0 {} {} 0 {} 0 {}}
test menu-16.17 {MenuAddOrInsert} {
    catch {destroy .m1}
    catch {destroy .container}
    menu .m1
    menu .container
    . configure -menu .container
    set tearoff [tkTearOffMenu .container]
    list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
} {0 {} {} {}}
test menu-16.18 {MenuAddOrInsert} {
    catch {destroy .m1}
    catch {destroy .container}
    menu .m1
    menu .container
    .container add cascade -menu .m1
    . configure -menu .container
    list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
} {0 {} {} {}}
test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
    catch {destroy .menubar}
    menu .menubar
    menu .menubar.test -tearoff 0
    .menubar add cascade -label Test -underline 0 -menu .menubar.test
    menu .menubar.test.cascade -tearoff 0
    .menubar.test.cascade add command -label SubItem -command "puts SubItemSelected"
    . configure -menu .menubar
    list [catch {.menubar.test add cascade -label SubMenu \
	-menu .menubar.test.cascade} msg] \
	[info commands .\#menubar.\#menubar\#test.\#menubar\#test\#cascade] \
	[. configure -menu ""] [destroy .menubar]
} {0 .#menubar.#menubar#test.#menubar#test#cascade {} {}}

test menu-17.1 {MenuVarProc} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    set foo "hello"
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [catch {unset foo} msg2] $msg2 [destroy .m1]
} {0 {} 0 {} {}}
# menu-17.2 - Don't know how to generate the flags in the if
test menu-17.2 {MenuVarProc} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo ""] [destroy .m1]
} {0 {} {} {}}
test menu-17.3 {MenuVarProc} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    set foo "hello"
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
} {0 {} hello {} 0 {}}
test menu-17.4 {MenuVarProc} {
    catch {destroy .m1}
    menu .m1
    set foo "goodbye"
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
} {0 {} hello {} 0 {}}
test menu-17.5 {MenuVarProc} {
    catch {destroy .m1}
    menu .m1
    set foo "hello"
    list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "goodbye"] [destroy .m1] [catch {unset foo} msg2] $msg2
} {0 {} goodbye {} 0 {}}

test menu-18.1 {TkActivateMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 activate 1} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-18.2 {TkActivateMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [catch {.m1 activate 0} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-18.3 {TkActivateMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add command -label "test2"
    .m1 activate 1
    list [catch {.m1 activate 2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-18.4 {TkActivateMenuEntry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add command -label "test2"
    .m1 activate 1
    list [catch {.m1 activate 1} msg] $msg [destroy .m1]
} {0 {} {}}

test menu-19.1 {TkPostCommand} {nonUnixUserInteraction } {
    catch {destroy .m1}
    menu .m1 -postcommand "set menu_test menu-19.1"
    .m1 add command -label "menu-19.1 - hit Escape"
    list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [set menu_test] [destroy .m1]
} {0 menu-19.1 {} menu-19.1 {}}
test menu-19.2 {TkPostCommand} {nonUnixUserInteraction } {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "menu-19.2 - hit Escape"
    list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [destroy .m1]
} {0 {} {} {}}

test menu-20.1 {CloneMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    list [catch {.m1 clone .m2} msg1] $msg1 [destroy .m1]
} {0 {} {}}
test menu-20.2 {CloneMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    list [catch {.m1 clone .m2 normal} msg1] $msg1 [destroy .m1]
} {0 {} {}}
test menu-20.3 {CloneMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    list [catch {.m1 clone .m2 tearoff} msg1] $msg1 [destroy .m1]
} {0 {} {}}
test menu-20.4 {CloneMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    list [catch {.m1 clone .m2 menubar} msg1] $msg1 [destroy .m1]
} {0 {} {}}
test menu-20.5 {CloneMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    list [catch {.m1 clone .m2 foo} msg1] $msg1 [destroy .m1]
} {1 {bad menu type "foo": must be normal, tearoff, or menubar} {}}
test menu-20.6 {CloneMenu - hooking up bookeeping ptrs} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    list [catch {.m1 clone .m2} msg] $msg [destroy .m1]
 } {0 {} {}}
 test menu-20.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    menu .m1
    .m1 clone .m2
    list [catch {.m1 clone .m3} msg] $msg [destroy .m1]
 } {0 {} {}}
 test menu-20.8 {CloneMenu - cascade entries} {
    catch {destroy .m1}
    catch {destroy .foo}
    menu .m1
    .m1 add cascade -menu .m2
    list [catch {.m1 clone .foo} msg] $msg [destroy .m1]
 } {0 {} {}}
 test menu-20.9 {CloneMenu - cascades entries} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .foo}
    menu .m1
    .m1 add cascade -menu .m2
    menu .m2
    list [catch {.m1 clone .foo} msg] $msg [destroy .m1 .m2]
 } {0 {} {}}
test menu-20.10 {CloneMenu - tearoff fields} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    list [catch {.m1 clone .m2 normal} msg1] $msg1 [catch {.m2 cget -tearoff} msg2] $msg2 [destroy .m1]
} {0 {} 0 1 {}}
test menu-20.11 {CloneMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    menu .m2
    list [catch {.m1 clone .m2} msg] $msg [destroy .m1 .m2]
} {1 {window name "m2" already exists in parent} {}}

test menu-21.1 {MenuDoYPosition} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 yposition glorp} msg] $msg [destroy .m1]
} {1 {bad menu entry index "glorp"} {}}
test menu-21.2 {MenuDoYPosition} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "Test"
    list [catch {.m1 yposition 1}] [destroy .m1]
} {0 {}}

test menu-22.1 {GetIndexFromCoords} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 configure -tearoff 0
    list [catch {.m1 index @5} msg] $msg [destroy .m1]
} {0 0 {}}
test menu-22.2 {GetIndexFromCoords} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 configure -tearoff 0
    list [catch {.m1 index @5,5} msg] $msg [destroy .m1]
} {0 0 {}}

test menu-23.1 {RecursivelyDeleteMenu} {
    catch {destroy .m1}
    menu .m1
    . configure -menu .m1
    list [catch {. configure -menu ""} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-23.2 {RecursivelyDeleteMenu} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m2
    .m2 add command -label "test2"
    menu .m1
    .m1 add cascade -label "test1" -menu .m2
    . configure -menu .m1
    list [catch {. configure -menu ""} msg] $msg [destroy .m1 .m2]
} {0 {} {}}

test menu-24.1 {TkNewMenuName} {
    catch {destroy .m1}
    menu .m1
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test menu-24.2 {TkNewMenuName} {
    catch {destroy .m1}
    catch {destroy .m1\#0}
    menu .m1
    menu .m1\#0
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test menu-24.3 {TkNewMenuName} {
    catch {destroy .#m}
    menu .#m
    rename .#m hideme
    list [catch {. configure -menu [menu .m]} $msg] [. configure -menu ""] [destroy .#m] [destroy .m] [destroy hideme]
} {0 {} {} {} {}}

test menu-25.1 {TkSetWindowMenuBar} {
    . configure -menu ""
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
test menu-25.2 {TkSetWindowMenuBar} {
    . configure -menu ""
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
test menu-25.3 {TkSetWindowMenuBar} {
    . configure -menu ""
    catch {destroy .m1}
    menu .m1
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test menu-25.4 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    . configure -menu ""
    menu .m1
    . configure -menu .m1
    menu .m2
    list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
} {0 {} {} {}}
test menu-25.5 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    . configure -menu ""
    menu .m1
    . configure -menu .m1
    .m1 clone .m2
    menu .m3
    list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
} {0 {} {} {}}
test menu-25.6 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .m3}
    . configure -menu ""
    menu .m1
    .m1 clone .m2
    . configure -menu .m2
    menu .m3
    list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
} {0 {} {} {}}
test menu-25.7 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    . configure -menu ""
    menu .m1
    menu .m2
    . configure -menu .m1
    toplevel .t2
    .t2 configure -menu .m1
    list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
} {0 {} {} {}}
test menu-25.8 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .t2}
    . configure -menu ""
    menu .m1
    menu .m2
    . configure -menu .m1
    toplevel .t2
    wm geometry .t2 +0+0
    .t2 configure -menu .m1
    list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
} {0 {} {} {}}
test menu-25.9 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .t2}
    catch {destroy .t3}
    . configure -menu ""
    menu .m1
    menu .m2
    . configure -menu .m1
    toplevel .t2 -menu .m1
    wm geometry .t2 +0+0
    toplevel .t3 -menu .m1
    wm geometry .t3 +0+0
    list [catch {.t3 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
} {0 {} {} {}}
test menu-25.10 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .t2}
    catch {destroy .t3}
    . configure -menu ""
    menu .m1
    menu .m2
    . configure -menu .m1
    toplevel .t2 -menu .m1
    wm geometry .t2 +0+0
    toplevel .t3 -menu .m1
    wm geometry .t3 +0+0
    list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
} {0 {} {} {}}
test menu-25.11 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    catch {destroy .m2}
    catch {destroy .t2}
    catch {destroy .t3}
    . configure -menu ""
    menu .m1
    menu .m2
    . configure -menu .m1
    toplevel .t2 -menu .m1
    wm geometry .t2 +0+0
    toplevel .t3 -menu .m1
    wm geometry .t3 +0+0
    list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
} {0 {} {} {}}
test menu-25.12 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test menu-25.13 {TkSetWindowMenuBar} {
    . configure -menu ""
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
test menu-25.14 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test menu-25.15 {TkSetWindowMenuBar} {
    . configure -menu ""
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
test menu-25.16 {TkSetWindowMenuBar} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    . configure -menu .m1
    list [catch {toplevel .t2 -menu m1} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
} {0 .t2 {} {}}

test menu-26.1 {DestroyMenuHashTable} {
    catch {interp destroy testinterp}
    interp create testinterp
    load {} Tk testinterp
    interp eval testinterp {menu .m1}
    list [catch {interp delete testinterp} msg] $msg
} {0 {}}

test menu-27.1 {GetMenuHashTable} {
    catch {interp destroy testinterp}
    interp create testinterp
    load {} tk testinterp
    list [catch {interp eval testinterp {menu .m1}} msg] $msg [interp delete testinterp]
} {0 .m1 {}}

test menu-28.1 {TkCreateMenuReferences - not there before} {
    catch {destroy .m1}
    list [catch {menu .m1} msg] $msg [destroy .m1]
} {0 .m1 {}}
test menu-28.2 {TkCreateMenuReferences - there already} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -menu .m2
    list [catch {menu .m2} msg] $msg [destroy .m1 .m2]
} {0 .m2 {}}

test menu-29.1 {TkFindMenuReferences - not there} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    .m1 add cascade -menu .m2
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test menu-30.1 {TkFindMenuReferences - there already} {
    catch {destroy .m1}
    catch {destroy .m2}
    . configure -menu ""
    menu .m1
    menu .m2
    .m1 add cascade -menu .m2
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
} {0 {} {} {}}

test menu-31.1 {TkFreeMenuReferences - menuPtr} {
    catch {destroy .m1}
    menu .m1
    list [catch {destroy .m1} msg] $msg
} {0 {}}
test menu-31.2 {TkFreeMenuReferences - cascadePtr} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    .m1 add cascade -menu .m2
    list [catch {.m1 entryconfigure 1 -menu .m3} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-31.3 {TkFreeMenuReferences - topLevelListPtr} {
    . configure -menu .m1
    list [catch {. configure -menu ""} msg] $msg
} {0 {}}
test menu-31.4 {TkFreeMenuReferences - not empty} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -menu .m3
    menu .m2
    .m2 add cascade -menu .m3
    list [catch {.m2 entryconfigure 1 -menu ".foo"} msg] $msg [destroy .m1 .m2]
} {0 {} {}}

test menu-32.1 {DeleteMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add command -label foo
    .m1 clone .m2
    list [catch {.m1 delete 1} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-32.2 {DeleteMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add command -label one
    .m1 add command -label two
    .m1 add command -label three
    .m1 add command -label four
    .m1 clone .m2
    list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-32.3 {DeleteMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1 -tearoff 0
    .m1 add command -label one
    .m1 add command -label two
    .m1 add command -label three
    .m1 add command -label four
    .m1 clone .m2
    .m2 configure -tearoff 1
    list [catch {.m1 delete 1 2} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-32.4 {DeleteMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add command -label one
    .m1 add command -label two
    .m1 add command -label three
    .m1 add command -label four
    .m1 clone .m2
    .m2 configure -tearoff 0
    list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-32.5 {DeleteMenuCloneEntries} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add command -label one
    .m1 add command -label two
    .m1 clone .m2
    .m1 activate one
    list [catch {.m1 delete one} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-32.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label test -command ".m1 delete test ; .m1 add command -label test -command \".m1 delete test\"; .m1 delete test"
    list [catch {.m1 invoke test} msg] $msg [destroy .m1]
} {0 {} {}}
test menu-32.7 {DeleteMenuCloneEntries - one entry} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label Hello
    list [catch {.m1 delete Hello} msg] $msg [destroy .m1]
} {0 {} {}}

set l [interp hidden]
eval destroy [winfo children .]

test menu-33.1 {menu vs command hiding} {
    catch {destroy .m}
    menu .m
    interp hide {} .m
    destroy .m
    list [winfo children .] [interp hidden]
} [list {} $l]

# menu-34 MenuInit only called at boot time

# cleanup
deleteWindows
::tcltest::cleanupTests
return













Changes to tests/menuDraw.test.

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
# This file is a Tcl script to test drawing of menus in Tk.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) menuDraw.test 1.11 97/06/24 13:50:34




if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"

    return
}

if {[info procs test] != "test"} {
    source defs
}

proc deleteWindows {} {
    foreach i [winfo children .] {
    	catch [destroy $i]
    }
}

deleteWindows
wm geometry . {}
raise .

if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} {
    puts " Some tests were skipped because they could not be performed"
    puts " automatically on this platform. If you wish to execute them"
    puts " interactively, set the TCL variable INTERACTIVE and re-run"
    puts " the test."
    set testConfig(menuInteractive) 0
} else {
    set testConfig(menuInteractive) 1
}

test menuDraw-1.1 {TkMenuInitializeDrawingFields} {
    catch {destroy .m1}
    list [menu .m1] [destroy .m1]
} {.m1 {}}

test menuDraw-2.1 {TkIntializeMenuEntryDrawingFields} {
    catch {destroy .m1}




>
>

<
<
>
|
<
>
>
>





>



<
<
<
<










<
<
<
<
<
<
<
<
<
<







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
# This file is a Tcl script to test drawing of menus in Tk.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: menuDraw.test,v 1.1.4.6 1999/03/26 00:08:02 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    ::tcltest::cleanupTests
    return
}





proc deleteWindows {} {
    foreach i [winfo children .] {
    	catch [destroy $i]
    }
}

deleteWindows
wm geometry . {}
raise .











test menuDraw-1.1 {TkMenuInitializeDrawingFields} {
    catch {destroy .m1}
    list [menu .m1] [destroy .m1]
} {.m1 {}}

test menuDraw-2.1 {TkIntializeMenuEntryDrawingFields} {
    catch {destroy .m1}
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
    list [.m1 entryconfigure 1 -state normal] [destroy .m1]
} {{} {}}
test menuDraw-6.6 {TkMenuConfigureEntryDrawOptions - bad state} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "foo"
    list [catch {.m1 entryconfigure 1 -state foo} msg] $msg [destroy .m1]
} {1 {bad state value "foo": must be normal, active, or disabled} {}}
test menuDraw-6.7 {TkMenuConfigureEntryDrawOptions - tkfont specified} {
    catch {destroy .m1}
    menu .m1
    list [.m1 add command -label "foo" -font "Courier 12"] [destroy .m1]
} {{} {}}
test menuDraw-6.8 {TkMenuConfigureEntryDrawOptions - border specified} {
    catch {destroy .m1}







|







104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
    list [.m1 entryconfigure 1 -state normal] [destroy .m1]
} {{} {}}
test menuDraw-6.6 {TkMenuConfigureEntryDrawOptions - bad state} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "foo"
    list [catch {.m1 entryconfigure 1 -state foo} msg] $msg [destroy .m1]
} {1 {bad state "foo": must be active, normal, or disabled} {}}
test menuDraw-6.7 {TkMenuConfigureEntryDrawOptions - tkfont specified} {
    catch {destroy .m1}
    menu .m1
    list [.m1 add command -label "foo" -font "Courier 12"] [destroy .m1]
} {{} {}}
test menuDraw-6.8 {TkMenuConfigureEntryDrawOptions - border specified} {
    catch {destroy .m1}
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
    menu .m1
    .m1 add command -label "This is a long label"
    set tearoff [tkTearOffMenu .m1]
    list [.m1 entryconfigure 1 -label "foo"] [destroy .m1]
} {{} {}}


test menuDraw-8.1 {TkRecomputeMenu} {menuInteractive} {
    catch {destroy .m1}
    menu .m1
    .m1 configure -postcommand [.m1 add command -label foo]
    .m1 add command -label "Hit ESCAPE to make this menu go away."
    list [.m1 post 0 0] [destroy .m1]
} {{} {}}








|







177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
    menu .m1
    .m1 add command -label "This is a long label"
    set tearoff [tkTearOffMenu .m1]
    list [.m1 entryconfigure 1 -label "foo"] [destroy .m1]
} {{} {}}


test menuDraw-8.1 {TkRecomputeMenu} {pcOnly userInteraction} {
    catch {destroy .m1}
    menu .m1
    .m1 configure -postcommand [.m1 add command -label foo]
    .m1 add command -label "Hit ESCAPE to make this menu go away."
    list [.m1 post 0 0] [destroy .m1]
} {{} {}}

502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -label test -menu .m2
    menu .m2 -postcommand "glorp"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [catch {$tearoff postcascade test} msg] $msg [destroy .m1] [destroy .m2]
} {1 {invalid command name "glorp"} {} {}}
test menuDraw-16.6 {TkPostSubMenu} {menuInteractive} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -label test -menu .m2
    menu .m2
    .m2 add command -label "Hit ESCAPE to get rid of this menu"
    set tearoff [tkTearOffMenu .m1 40 40]







|







492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -label test -menu .m2
    menu .m2 -postcommand "glorp"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [catch {$tearoff postcascade test} msg] $msg [destroy .m1] [destroy .m2]
} {1 {invalid command name "glorp"} {} {}}
test menuDraw-16.6 {TkPostSubMenu} {pcOnly userInteraction} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -label test -menu .m2
    menu .m2
    .m2 add command -label "Hit ESCAPE to get rid of this menu"
    set tearoff [tkTearOffMenu .m1 40 40]
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545

546















    foreach w [winfo children .] {
	if {[$w cget -type] == "menubar"} {
		break
	}
    }
    list [$w postcascade 0] [. configure -menu ""] [destroy .m1] [destroy .m2]
} {{} {} {} {}}
test menuDraw-17.2 {AdjustMenuCoords - menu} {menuInteractive} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -label test -menu .m2
    menu .m2
    .m2 add command -label "Hit ESCAPE to make this menu go away"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [$tearoff postcascade 0] [destroy .m1] [destroy .m2]
} {{} {} {}}


deleteWindows






















|










>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
    foreach w [winfo children .] {
	if {[$w cget -type] == "menubar"} {
		break
	}
    }
    list [$w postcascade 0] [. configure -menu ""] [destroy .m1] [destroy .m2]
} {{} {} {} {}}
test menuDraw-17.2 {AdjustMenuCoords - menu} {pcOnly userInteraction} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1
    .m1 add cascade -label test -menu .m2
    menu .m2
    .m2 add command -label "Hit ESCAPE to make this menu go away"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [$tearoff postcascade 0] [destroy .m1] [destroy .m2]
} {{} {} {}}

# cleanup
deleteWindows
::tcltest::cleanupTests
return













Changes to tests/menubut.test.

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
# This file is a Tcl script to test menubuttons in Tk.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) menubut.test 1.26 97/07/31 10:08:50

# XXX This test file is woefully incomplete right now.  If any part
# XXX of a procedure has tests then the whole procedure has tests,
# XXX but many procedures have no tests.





if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"

    return
}

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

# Create entries in the option database to be sure that geometry options





|
|
<

|




>
>
>
>





>



<
<
<
<







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
# This file is a Tcl script to test menubuttons in Tk.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: menubut.test,v 1.1.4.6 1999/03/26 00:08:02 hershey Exp $

# XXX This test file is woefully incomplete right now.  If any part
# XXX of a procedure has tests then the whole procedure has tests,
# XXX but many procedures have no tests.

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    ::tcltest::cleanupTests
    return
}





foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

# Create entries in the option database to be sure that geometry options
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
update
set i 1
foreach test {
    {-activebackground #012345 #012345 non-existent
	    {unknown color name "non-existent"}}
    {-activeforeground #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-anchor nw nw bogus {bad anchor position "bogus": must be n, ne, e, se, s, sw, w, nw, or center}}
    {-background #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-bd 4 4 badValue {bad screen distance "badValue"}}
    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
    {-bitmap questhead questhead badValue {bitmap "badValue" not defined}}
    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
    {-direction below below badValue {bad direction value "badValue": must be above, below, left, right, or flush}}
    {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
    {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}}
    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
    {-height 18 18 20.0 {expected integer but got "20.0"}}
    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
    {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}}
    {-highlightthickness 18 18 badValue {bad screen distance "badValue"}}
    {-image image1 image1 bogus {image "bogus" doesn't exist}}
    {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}}
    {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
    {-menu "any old string" "any old string" {} {}}
    {-padx 12 12 420x {bad screen distance "420x"}}
    {-pady 12 12 420x {bad screen distance "420x"}}
    {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
    {-state normal normal bogus {bad state value "bogus": must be normal, active, or disabled}}
    {-takefocus "any string" "any string" {} {}}
    {-text "Sample text" {Sample text} {} {}}
    {-textvariable i i {} {}}
    {-underline 5 5 3p {expected integer but got "3p"}}
    {-width 402 402 3p {expected integer but got "3p"}}
    {-wraplength 100 100 6x {bad screen distance "6x"}}
} {







|







|














|
|







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
update
set i 1
foreach test {
    {-activebackground #012345 #012345 non-existent
	    {unknown color name "non-existent"}}
    {-activeforeground #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-anchor nw nw bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center}}
    {-background #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-bd 4 4 badValue {bad screen distance "badValue"}}
    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
    {-bitmap questhead questhead badValue {bitmap "badValue" not defined}}
    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
    {-direction below below badValue {bad direction "badValue": must be above, below, flush, left, or right}}
    {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
    {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}}
    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
    {-height 18 18 20.0 {expected integer but got "20.0"}}
    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
    {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}}
    {-highlightthickness 18 18 badValue {bad screen distance "badValue"}}
    {-image image1 image1 bogus {image "bogus" doesn't exist}}
    {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}}
    {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
    {-menu "any old string" "any old string" {} {}}
    {-padx 12 12 420x {bad screen distance "420x"}}
    {-pady 12 12 420x {bad screen distance "420x"}}
    {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
    {-state normal normal bogus {bad state "bogus": must be active, disabled, or normal}}
    {-takefocus "any string" "any string" {} {}}
    {-text "Sample text" {Sample text} {} {}}
    {-textvariable i i {} {}}
    {-underline 5 5 3p {expected integer but got "3p"}}
    {-width 402 402 3p {expected integer but got "3p"}}
    {-wraplength 100 100 6x {bad screen distance "6x"}}
} {
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
menubutton .mb -text "Test Menu"
pack .mb
test menubutton-3.1 {MenuButtonWidgetCmd procedure} {
    list [catch {.mb} msg] $msg
} {1 {wrong # args: should be ".mb option ?arg arg ...?"}}
test menubutton-3.2 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.mb c} msg] $msg
} {1 {bad option "c": must be cget or configure}}
test menubutton-3.3 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.mb cget} msg] $msg
} {1 {wrong # args: should be ".mb cget option"}}
test menubutton-3.4 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.mb cget a b} msg] $msg
} {1 {wrong # args: should be ".mb cget option"}}
test menubutton-3.5 {ButtonWidgetCmd procedure, "cget" option} {







|







118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
menubutton .mb -text "Test Menu"
pack .mb
test menubutton-3.1 {MenuButtonWidgetCmd procedure} {
    list [catch {.mb} msg] $msg
} {1 {wrong # args: should be ".mb option ?arg arg ...?"}}
test menubutton-3.2 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.mb c} msg] $msg
} {1 {ambiguous option "c": must be cget or configure}}
test menubutton-3.3 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.mb cget} msg] $msg
} {1 {wrong # args: should be ".mb cget option"}}
test menubutton-3.4 {ButtonWidgetCmd procedure, "cget" option} {
    list [catch {.mb cget a b} msg] $msg
} {1 {wrong # args: should be ".mb cget option"}}
test menubutton-3.5 {ButtonWidgetCmd procedure, "cget" option} {
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
    lappend result [winfo reqwidth .mb1] [winfo reqheight .mb1]
} {102 46 20 12}
test menubutton-4.6 {ConfigureMenuButton procedure - bad direction} {
    catch {destroy .mb}
    menubutton .mb -text "Test"
    list [catch {.mb configure -direction badValue} msg] $msg \
	[.mb cget -direction] [destroy .mb]
} {1 {bad direction value "badValue": must be above, below, left, right, or flush} below {}}

# XXX Need to add tests for several procedures here. XXX

test menubutton-5.1 {MenuButtonEventProc procedure} {
    eval destroy [winfo children .]
    menubutton .mb1 -bg #543210
    rename .mb1 .mb2







|







200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
    lappend result [winfo reqwidth .mb1] [winfo reqheight .mb1]
} {102 46 20 12}
test menubutton-4.6 {ConfigureMenuButton procedure - bad direction} {
    catch {destroy .mb}
    menubutton .mb -text "Test"
    list [catch {.mb configure -direction badValue} msg] $msg \
	[.mb cget -direction] [destroy .mb]
} {1 {bad direction "badValue": must be above, below, flush, left, or right} below {}}

# XXX Need to add tests for several procedures here. XXX

test menubutton-5.1 {MenuButtonEventProc procedure} {
    eval destroy [winfo children .]
    menubutton .mb1 -bg #543210
    rename .mb1 .mb2
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {fonts} {
    catch {destroy .mb}
    menubutton .mb -text String -bd 2 -relief raised \
	    -highlightthickness 1 -indicatoron 1
    pack .mb
    list [winfo reqwidth .mb] [winfo reqheight .mb]
} {78 28}
test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unix nonPortable} {
    # The following test is non-portable because the indicator's pixel
    # size varies to maintain constant absolute size.

    catch {destroy .mb}
    menubutton .mb -image image1 -bd 2 -relief raised \
	    -highlightthickness 2 -indicatoron 1
    pack .mb
    list [winfo reqwidth .mb] [winfo reqheight .mb]
} {64 23}
test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pc nonPortable} {
    # The following test is non-portable because the indicator's pixel
    # size varies to maintain constant absolute size.

    catch {destroy .mb}
    menubutton .mb -image image1 -bd 2 -relief raised \
	    -highlightthickness 2 -indicatoron 1
    pack .mb







|









|







310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {fonts} {
    catch {destroy .mb}
    menubutton .mb -text String -bd 2 -relief raised \
	    -highlightthickness 1 -indicatoron 1
    pack .mb
    list [winfo reqwidth .mb] [winfo reqheight .mb]
} {78 28}
test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unixOnly nonPortable} {
    # The following test is non-portable because the indicator's pixel
    # size varies to maintain constant absolute size.

    catch {destroy .mb}
    menubutton .mb -image image1 -bd 2 -relief raised \
	    -highlightthickness 2 -indicatoron 1
    pack .mb
    list [winfo reqwidth .mb] [winfo reqheight .mb]
} {64 23}
test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pcOnly nonPortable} {
    # The following test is non-portable because the indicator's pixel
    # size varies to maintain constant absolute size.

    catch {destroy .mb}
    menubutton .mb -image image1 -bd 2 -relief raised \
	    -highlightthickness 2 -indicatoron 1
    pack .mb
345
346
347
348
349
350
351
352
















    destroy .mb
    list [winfo children .] [interp hidden]
} [list {} $l]

eval image delete [image names]
eval destroy [winfo children .]
option clear

























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
    destroy .mb
    list [winfo children .] [interp hidden]
} [list {} $l]

eval image delete [image names]
eval destroy [winfo children .]
option clear

# cleanup
::tcltest::cleanupTests
return













Changes to tests/msgbox.test.

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
# This file is a Tcl script to test out Tk's "tk_messageBox" command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) msgbox.test 1.7 97/07/31 10:05:25
#



if {[string compare test [info procs test]] == 1} {
    source defs
}





test msgbox-1.1 {tk_messageBox command} {
    list [catch {tk_messageBox -foo} msg] $msg
} {1 {unknown option "-foo", must be -default, -icon, -message, -parent, -title or -type}}
test msgbox-1.2 {tk_messageBox command} {
    list [catch {tk_messageBox -foo bar} msg] $msg
} {1 {unknown option "-foo", must be -default, -icon, -message, -parent, -title or -type}}

catch {tk_messageBox -foo bar} msg
regsub -all ,      $msg "" options
regsub \"-foo\" $options "" options

foreach option $options {
    if {[string index $option 0] == "-"} {
	test msgbox-1.3 {tk_messageBox command} {
	    list [catch {tk_messageBox $option} msg] $msg
	} [list 1 "value for \"$option\" missing"]
    }
}

test msgbox-1.4 {tk_messageBox command} {
    list [catch {tk_messageBox -default} msg] $msg
} {1 {value for "-default" missing}}

test msgbox-1.5 {tk_messageBox command} {
    list [catch {tk_messageBox -type foo} msg] $msg
} {1 {invalid message box type "foo", must be abortretryignore, ok, okcancel, retrycancel, yesno or yesnocancel}}









test msgbox-1.6 {tk_messageBox command} {
    list [catch {tk_messageBox -default 1.1} msg] $msg
} {1 {invalid default button "1.1"}}

test msgbox-1.7 {tk_messageBox command} {
    list [catch {tk_messageBox -default foo} msg] $msg
} {1 {invalid default button "foo"}}

test msgbox-1.8 {tk_messageBox command} {
    list [catch {tk_messageBox -type yesno -default 3} msg] $msg
} {1 {invalid default button "3"}}

test msgbox-1.9 {tk_messageBox command} {
    list [catch {tk_messageBox -icon foo} msg] $msg
} {1 {invalid icon "foo", must be error, info, question or warning}}

test msgbox-1.10 {tk_messageBox command} {
    list [catch {tk_messageBox -parent foo.bar} msg] $msg
} {1 {bad window path name "foo.bar"}}

if {[info commands tkMessageBox] == ""} {
    set isNative 1
} else {
    set isNative 0
}

if {$isNative && ![info exists INTERACTIVE]} {
    puts " Some tests were skipped because they could not be performed"
    puts " automatically on this platform. If you wish to execute them"
    puts " interactively, set the TCL variable INTERACTIVE and re-run"
    puts " the test"
    return
}

proc ChooseMsg {parent btn} {
    global isNative
    if {!$isNative} {
	after 100 SendEventToMsg $parent $btn mouse
    }
}





>
>

<
<
>

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



|


|



















|
>
>
>
>
>
>
>
>



|



|



|



|











<
<
<
<
<
<
<
<







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
# This file is a Tcl script to test out Tk's "tk_messageBox" command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: msgbox.test,v 1.1.4.7 1999/03/26 00:08:03 hershey Exp $
#


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}



# Some tests require user interaction on non-unix platform
set ::tcltest::testConfig(nonUnixUserInteraction) \
    [expr {$::tcltest::testConfig(userInteraction) || \
	$::tcltest::testConfig(unixOnly)}]

test msgbox-1.1 {tk_messageBox command} {
    list [catch {tk_messageBox -foo} msg] $msg
} {1 {bad option "-foo": must be -default, -icon, -message, -parent, -title, or -type}}
test msgbox-1.2 {tk_messageBox command} {
    list [catch {tk_messageBox -foo bar} msg] $msg
} {1 {bad option "-foo": must be -default, -icon, -message, -parent, -title, or -type}}

catch {tk_messageBox -foo bar} msg
regsub -all ,      $msg "" options
regsub \"-foo\" $options "" options

foreach option $options {
    if {[string index $option 0] == "-"} {
	test msgbox-1.3 {tk_messageBox command} {
	    list [catch {tk_messageBox $option} msg] $msg
	} [list 1 "value for \"$option\" missing"]
    }
}

test msgbox-1.4 {tk_messageBox command} {
    list [catch {tk_messageBox -default} msg] $msg
} {1 {value for "-default" missing}}

test msgbox-1.5 {tk_messageBox command} {
    list [catch {tk_messageBox -type foo} msg] $msg
} {1 {bad -type value "foo": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel}}

proc createPlatformMsg {val} {
    global tcl_platform
    if {$tcl_platform(platform) == "unix"} {
	return "invalid default button \"$val\""
    }
    return "bad -default value \"$val\": must be abort, retry, ignore, ok, cancel, no, or yes"
}

test msgbox-1.6 {tk_messageBox command} {
    list [catch {tk_messageBox -default 1.1} msg] $msg
} [list 1 [createPlatformMsg "1.1"]]

test msgbox-1.7 {tk_messageBox command} {
    list [catch {tk_messageBox -default foo} msg] $msg
} [list 1 [createPlatformMsg "foo"]]

test msgbox-1.8 {tk_messageBox command} {
    list [catch {tk_messageBox -type yesno -default 3} msg] $msg
} [list 1 [createPlatformMsg "3"]]

test msgbox-1.9 {tk_messageBox command} {
    list [catch {tk_messageBox -icon foo} msg] $msg
} {1 {bad -icon value "foo": must be error, info, question, or warning}}

test msgbox-1.10 {tk_messageBox command} {
    list [catch {tk_messageBox -parent foo.bar} msg] $msg
} {1 {bad window path name "foo.bar"}}

if {[info commands tkMessageBox] == ""} {
    set isNative 1
} else {
    set isNative 0
}









proc ChooseMsg {parent btn} {
    global isNative
    if {!$isNative} {
	after 100 SendEventToMsg $parent $btn mouse
    }
}

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

















    {"yesnocancel" 	 MB_YESNOCANCEL       3  {"yes"    "no"     "cancel"}}
}

#
# Try out all combinations of (type) x (default button) and
# (type) x (icon).
#

foreach spec $specs {
    set type [lindex $spec 0]
    set buttons [lindex $spec 3]

    set button [lindex $buttons 0]
    test msgbox-2.1 {tk_messageBox command} {
	ChooseMsg $parent $button
	tk_messageBox -title Hi -message "Please press $button" \
	    -type $type
    } $button


    foreach icon {warning error info question} {
	test msgbox-2.2 {tk_messageBox command -icon option} {

	    ChooseMsg $parent $button
	    tk_messageBox -title Hi -message "Please press $button" \
		-type $type -icon $icon
	} $button

    }

    foreach button $buttons {
	test msgbox-2.3 {tk_messageBox command} {
	    ChooseMsg $parent $button
	    tk_messageBox -title Hi -message "Please press $button" \
		-type $type -default $button
	} "$button"

    }
}
























>





|




>


|
>




>



|




>


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
    {"yesnocancel" 	 MB_YESNOCANCEL       3  {"yes"    "no"     "cancel"}}
}

#
# Try out all combinations of (type) x (default button) and
# (type) x (icon).
#
set count 1
foreach spec $specs {
    set type [lindex $spec 0]
    set buttons [lindex $spec 3]

    set button [lindex $buttons 0]
    test msgbox-2.$count {tk_messageBox command} {nonUnixUserInteraction} {
	ChooseMsg $parent $button
	tk_messageBox -title Hi -message "Please press $button" \
	    -type $type
    } $button
    incr count

    foreach icon {warning error info question} {
	test msgbox-2.$count {tk_messageBox command -icon option} \
		{nonUnixUserInteraction} {
	    ChooseMsg $parent $button
	    tk_messageBox -title Hi -message "Please press $button" \
		-type $type -icon $icon
	} $button
        incr count
    }

    foreach button $buttons {
	test msgbox-2.$count {tk_messageBox command} {nonUnixUserInteraction} {
	    ChooseMsg $parent $button
	    tk_messageBox -title Hi -message "Please press $button" \
		-type $type -default $button
	} "$button"
        incr count
    }
}

# cleanup
::tcltest::cleanupTests
return













Added tests/obj.test.









































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
# This file is a Tcl script to test new object types in Tk.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: obj.test,v 1.1.2.5 1999/03/24 02:54:54 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

test obj-1.1 {TkGetPixelsFromObj} {
} {}

test obj-2.1 {FreePixelInternalRep} {
} {}

test obj-3.1 {DupPixelInternalRep} {
} {}

test obj-4.1 {SetPixelFromAny} {
} {}



eval destroy [winfo children .]

# cleanup
::tcltest::cleanupTests
return














Changes to tests/oldpack.test.

1
2
3
4
5
6


7
8
9

10
11


12
13
14
15
16
17
18
19
20
21
# This file is a Tcl script to test out the old syntax of Tk's
# "pack" command (before release 3.3).  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) oldpack.test 1.10 97/06/24 13:32:16



if {[string compare test [info procs test]] == 1} then \
  {source defs}

# First, test a single window packed in various ways in a parent

catch {destroy .pack}
frame .pack
place .pack -width 100 -height 100
frame .pack.red -width 10 -height 20






>
>

<
<
>
|
<
>
>
|
<
<







1
2
3
4
5
6
7
8
9


10
11

12
13
14


15
16
17
18
19
20
21
# This file is a Tcl script to test out the old syntax of Tk's
# "pack" command (before release 3.3).  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: oldpack.test,v 1.1.4.4 1999/03/24 02:54:54 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}



# First, test a single window packed in various ways in a parent

catch {destroy .pack}
frame .pack
place .pack -width 100 -height 100
frame .pack.red -width 10 -height 20
501
502
503
504
505
506
507
508
















    pack append .pack .pack.blue {frame center} .pack.red {frame center} \
	.pack.green {frame c} .pack.violet {frame c}
    list [pack slaves .pack] [pack info .pack.blue] [pack info .pack.red] \
	    [pack info .pack.green] [pack info .pack.violet]
} {{.pack.blue .pack.red .pack.green .pack.violet} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top}}

catch {destroy .pack}
concat {}























|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
    pack append .pack .pack.blue {frame center} .pack.red {frame center} \
	.pack.green {frame c} .pack.violet {frame c}
    list [pack slaves .pack] [pack info .pack.blue] [pack info .pack.red] \
	    [pack info .pack.green] [pack info .pack.violet]
} {{.pack.blue .pack.red .pack.green .pack.violet} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top}}

catch {destroy .pack}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/option.test.

1
2
3
4
5


6
7
8

9
10


11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out the option-handling facilities
# of Tk.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) option.test 1.20 97/08/07 15:54:37



if {[string compare test [info procs test]] == 1} then \
  {source defs}

catch {destroy .op1}
catch {destroy .op2}
set appName [winfo name .]

# First, test basic retrievals, being sure to trigger all the various
# types of NodeElements (EXACT_LEAF_NAME, WILDCARD_NODE_CLASS, and





>
>

<
<
>
|
<
>
>
|
<
<







1
2
3
4
5
6
7
8


9
10

11
12
13


14
15
16
17
18
19
20
# This file is a Tcl script to test out the option-handling facilities
# of Tk.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: option.test,v 1.1.4.5 1999/03/26 00:08:04 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}



catch {destroy .op1}
catch {destroy .op2}
set appName [winfo name .]

# First, test basic retrievals, being sure to trigger all the various
# types of NodeElements (EXACT_LEAF_NAME, WILDCARD_NODE_CLASS, and
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
test option-14.11 {error conditions} {
    list [catch {option get 3 4 5 6} msg] $msg
} {1 {wrong # args: should be "option get window name class"}}
test option-14.12 {error conditions} {
    list [catch {option get .gorp.gorp a A} msg] $msg
} {1 {bad window path name ".gorp.gorp"}}

if {$tcl_platform(os) == "Win32s"} {
    set option1 OPTION~2.FIL
    set option2 OPTION~1.FIL
    set option3 OPTION~3.FIL
} else {
    set option1 option.file1
    set option2 option.file2
    set option3 option.file3
}

test option-15.1 {database files} {
    list [catch {option read non-existent} msg] $msg
} {1 {couldn't open "non-existent": no such file or directory}}
option read $option1
test option-15.2 {database files} {option get . x1 color} blue
if {$appName == "tktest"} {







<
|
|
|
<
<
<
<
<







181
182
183
184
185
186
187

188
189
190





191
192
193
194
195
196
197
test option-14.11 {error conditions} {
    list [catch {option get 3 4 5 6} msg] $msg
} {1 {wrong # args: should be "option get window name class"}}
test option-14.12 {error conditions} {
    list [catch {option get .gorp.gorp a A} msg] $msg
} {1 {bad window path name ".gorp.gorp"}}


set option1 [file join $::tcltest::testsDir option.file1]
set option2 [file join $::tcltest::testsDir option.file2]
set option3 [file join $::tcltest::testsDir option.file3]






test option-15.1 {database files} {
    list [catch {option read non-existent} msg] $msg
} {1 {couldn't open "non-existent": no such file or directory}}
option read $option1
test option-15.2 {database files} {option get . x1 color} blue
if {$appName == "tktest"} {
225
226
227
228
229
230
231
232
















    set result [list [option get . x7 color] [option get . x8 color]]
    removeFile $option3
    set result
} {true false}

catch {destroy .op1}
catch {destroy .op2}
concat {}























|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
    set result [list [option get . x7 color] [option get . x8 color]]
    removeFile $option3
    set result
} {true false}

catch {destroy .op1}
catch {destroy .op2}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/pack.test.

1
2
3
4
5


6
7
8

9
10


11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out the "pack" command
# of Tk.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) pack.test 1.27 97/07/01 18:06:56



if {[string compare test [info procs test]] == 1} then \
  {source defs}

# Utility procedures:

proc pack1 {args} {
    pack forget .pack.a .pack.b .pack.c .pack.d
    eval pack .pack.a $args
    pack .pack.b -expand yes -fill both





>
>

<
<
>
|
<
>
>
|
<
<







1
2
3
4
5
6
7
8


9
10

11
12
13


14
15
16
17
18
19
20
# This file is a Tcl script to test out the "pack" command
# of Tk.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: pack.test,v 1.1.4.4 1999/03/24 02:54:56 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}



# Utility procedures:

proc pack1 {args} {
    pack forget .pack.a .pack.b .pack.c .pack.d
    eval pack .pack.a $args
    pack .pack.b -expand yes -fill both
963
964
965
966
967
968
969

















    update
    lappend result [winfo ismapped .pack.b]
} {1 0 100 30 0 1}
destroy .pack
foreach i {pack1 pack2 pack3 pack4} {
    rename $i {}
}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
    update
    lappend result [winfo ismapped .pack.b]
} {1 0 100 30 0 1}
destroy .pack
foreach i {pack1 pack2 pack3 pack4} {
    rename $i {}
}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/place.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
# This file is a Tcl script to test out the "place" command.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) place.test 1.6 96/02/16 10:56:01

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .




|
|
<

|

|
|







1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
# This file is a Tcl script to test out the "place" command.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: place.test,v 1.1.4.4 1999/03/24 02:54:56 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
214
215
216
217
218
219
220
221
















    lappend result [winfo x .t.f2] [winfo y .t.f2] [winfo ismapped .t.f2]
    wm deiconify .t
    update
    lappend result [winfo ismapped .t.f2]
} {1 0 42 32 0 1}

catch {destroy .t}
concat























|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
    lappend result [winfo x .t.f2] [winfo y .t.f2] [winfo ismapped .t.f2]
    wm deiconify .t
    update
    lappend result [winfo ismapped .t.f2]
} {1 0 42 32 0 1}

catch {destroy .t}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/raise.test.

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
# This file is a Tcl script to test out Tk's "raise" and
# "lower" commands, plus associated code to manage window
# stacking order.  It is organized in the standard fashion
# for Tcl tests.
#
# Copyright (c) 1993-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) raise.test 1.8 96/02/16 10:55:18

if {[info commands testmakeexist] == {}} {
    puts "This application hasn't been compiled with the \"testmakeexist\""
    puts "command, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    return
}

if {[string compare test [info procs test]] == 1} then \
  {source defs}


# Procedure to create a bunch of overlapping windows, which should
# make it easy to detect differences in order.

proc raise_setup {} {
    foreach i [winfo child .raise] {
	destroy $i







|
|
<

|








|
|
>







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
# This file is a Tcl script to test out Tk's "raise" and
# "lower" commands, plus associated code to manage window
# stacking order.  It is organized in the standard fashion
# for Tcl tests.
#
# Copyright (c) 1993-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: raise.test,v 1.1.4.4 1999/03/24 02:54:57 hershey Exp $

if {[info commands testmakeexist] == {}} {
    puts "This application hasn't been compiled with the \"testmakeexist\""
    puts "command, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    return
}

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# Procedure to create a bunch of overlapping windows, which should
# make it easy to detect differences in order.

proc raise_setup {} {
    foreach i [winfo child .raise] {
	destroy $i
293
294
295
296
297
298
299

















test raise-7.8 {errors in raise/lower commands} {
    list [catch {lower . badName4} msg] $msg
} {1 {bad window path name "badName4"}}

foreach i [winfo child .] {
    destroy $i
}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
test raise-7.8 {errors in raise/lower commands} {
    list [catch {lower . badName4} msg] $msg
} {1 {bad window path name "badName4"}}

foreach i [winfo child .] {
    destroy $i
}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/safe.test.

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
# This file is a Tcl script to test the Safe Tk facility. It is organized
# in the standard fashion for Tk tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) safe.test 1.15 97/08/13 16:05:17

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}

# The set of hidden commands is platform dependent:

if {"$tcl_platform(platform)" == "macintosh"} {
    set hidden_cmds {beep bell cd clipboard echo exit fconfigure file glob grab load ls menu open pwd selection socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
} elseif {"$tcl_platform(platform)" == "windows"} {
    set hidden_cmds {bell cd clipboard exec exit fconfigure file glob grab load menu open pwd selection socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
} else {
    set hidden_cmds {bell cd clipboard exec exit fconfigure file glob grab load menu open pwd selection send socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
}

test safe-1.1 {Safe Tk loading into an interpreter} {
    catch {safe::interpDelete a}
    safe::loadTk [safe::interpCreate a]
    safe::interpDelete a
    set x {}





|
|
<

|

|
|









|

|

|







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
# This file is a Tcl script to test the Safe Tk facility. It is organized
# in the standard fashion for Tk tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: safe.test,v 1.1.4.7 1999/04/06 04:50:58 rjohnson Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}

# The set of hidden commands is platform dependent:

if {"$tcl_platform(platform)" == "macintosh"} {
    set hidden_cmds {beep bell cd clipboard echo encoding exit fconfigure file glob grab load ls menu open pwd selection send socket source tk tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile toplevel wm}
} elseif {"$tcl_platform(platform)" == "windows"} {
    set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
} else {
    set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source tk toplevel wm}
}

test safe-1.1 {Safe Tk loading into an interpreter} {
    catch {safe::interpDelete a}
    safe::loadTk [safe::interpCreate a]
    safe::interpDelete a
    set x {}
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
test safe-1.3 {Safe Tk loading into an interpreter} {
    catch {safe::interpDelete a}
    safe::interpCreate a
    safe::loadTk a
    set l [lsort [interp aliases a]]
    safe::interpDelete a
    set l
} {exit file load source}

test safe-2.1 {Unsafe commands not available} {
    catch {safe::interpDelete a}
    safe::interpCreate a
    safe::loadTk a
    set status broken
    if {[catch {interp eval a {toplevel .t}} msg]} {







|







44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
test safe-1.3 {Safe Tk loading into an interpreter} {
    catch {safe::interpDelete a}
    safe::interpCreate a
    safe::loadTk a
    set l [lsort [interp aliases a]]
    safe::interpDelete a
    set l
} {encoding exit file load source}

test safe-2.1 {Unsafe commands not available} {
    catch {safe::interpDelete a}
    safe::interpCreate a
    safe::loadTk a
    set status broken
    if {[catch {interp eval a {toplevel .t}} msg]} {
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















} ok

test safe-4.1 {testing loadTk} {
    # no error shall occur, the user will
    # eventually see a new toplevel
    set i [safe::loadTk [safe::interpCreate]]
    interp eval $i {button .b -text "hello world!"; pack .b}
# lets don't update because it might impy that the user has
# to position the window (if the wm does not do it automatically)
# and thus make the test suite not runable non interactively
    safe::interpDelete $i
} {}

test safe-4.2 {testing loadTk -use} {
    set w .safeTkFrame
    catch {destroy $w}
    frame $w -container 1;
    pack .safeTkFrame
    set i [safe::loadTk [safe::interpCreate] -use [winfo id $w]]
    interp eval $i {button .b -text "hello world!"; pack .b}
    safe::interpDelete $i
    destroy $w
} {}
























































unset hidden_cmds






















|
|
|














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

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
} ok

test safe-4.1 {testing loadTk} {
    # no error shall occur, the user will
    # eventually see a new toplevel
    set i [safe::loadTk [safe::interpCreate]]
    interp eval $i {button .b -text "hello world!"; pack .b}
    # lets don't update because it might imply that the user has
    # to position the window (if the wm does not do it automatically)
    # and thus make the test suite not runable non interactively
    safe::interpDelete $i
} {}

test safe-4.2 {testing loadTk -use} {
    set w .safeTkFrame
    catch {destroy $w}
    frame $w -container 1;
    pack .safeTkFrame
    set i [safe::loadTk [safe::interpCreate] -use [winfo id $w]]
    interp eval $i {button .b -text "hello world!"; pack .b}
    safe::interpDelete $i
    destroy $w
} {}

test safe-5.1 {loading Tk in safe interps without master's clearance} {
    set i [safe::interpCreate]
    catch {interp eval $i {load {} Tk}} msg
    safe::interpDelete $i
    set msg
} {not allowed to start Tk by master's safe::TkInit}

test safe-5.2 {multi-level Tk loading with clearance} {
    # No error shall occur in that test and no window
    # shall remain at the end.
    set i [safe::interpCreate]
    set j [list $i x]
    set j [safe::interpCreate $j]
    safe::loadTk $j
    interp eval $j {
	button .b -text Ok -command {destroy .}
	pack .b
#	tkwait window . ; # for interactive testing/debugging
    }
    safe::interpDelete $j
    safe::interpDelete $i
} {}

test safe-6.1 {loadTk -use windowPath} {
    set w .safeTkFrame
    catch {destroy $w}
    frame $w -container 1;
    pack .safeTkFrame
    set i [safe::loadTk [safe::interpCreate] -use $w]
    interp eval $i {button .b -text "hello world!"; pack .b}
    safe::interpDelete $i
    destroy $w
} {}

test safe-6.2 {loadTk -use windowPath, conflicting -display} {
    set w .safeTkFrame
    catch {destroy $w}
    frame $w -container 1;
    pack .safeTkFrame
    set i     [safe::interpCreate]
    catch {safe::loadTk $i -use $w -display :23.56} msg
    safe::interpDelete $i
    destroy $w
    string range $msg 0 36
} {conflicting -display :23.56 and -use }


test safe-7.1 {canvas printing} {
    set i [safe::loadTk [safe::interpCreate]]
    set r [catch {interp eval $i {canvas .c; .c postscript}}]
    safe::interpDelete $i
    set r
} 0

# cleanup
unset hidden_cmds
::tcltest::cleanupTests
return













Changes to tests/scale.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out the "scale" command
# of Tk.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) scale.test 1.28 97/07/31 10:20:43

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .





|
|
<

|

|
|







1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18
19
# This file is a Tcl script to test out the "scale" command
# of Tk.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: scale.test,v 1.1.4.7 1999/03/24 02:54:58 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
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
    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
    {-highlightcolor #123456 #123456 non-existent
	    {unknown color name "non-existent"}}
    {-highlightthickness 2 2 badValue {bad screen distance "badValue"}}
    {-label "Some text" {Some text} {} {}}
    {-length 130 130 badValue {bad screen distance "badValue"}}
    {-orient horizontal horizontal badValue
	    {bad orientation "badValue": must be vertical or horizontal}}
    {-orient horizontal horizontal {} {}}
    {-relief ridge ridge badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
    {-repeatdelay 14 14 bogus {expected integer but got "bogus"}}
    {-repeatinterval 14 14 bogus {expected integer but got "bogus"}}
    {-resolution 2.0 2.0 badValue
	    {expected floating-point number but got "badValue"}}
    {-showvalue 0 0 badValue {expected boolean value but got "badValue"}}
    {-sliderlength 86 86 badValue {bad screen distance "badValue"}}
    {-sliderrelief raised raised badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
    {-state disabled disabled badValue
	    {bad state value "badValue": must be normal, active, or disabled}}
    {-state normal normal {} {}}
    {-takefocus "any string" "any string" {} {}}
    {-tickinterval 4.3 4.0 badValue
	    {expected floating-point number but got "badValue"}}
    {-to 14.9 15.0 badValue
	    {expected floating-point number but got "badValue"}}
    {-troughcolor #ff0000 #ff0000 non-existent







|

|






|

|







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
    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
    {-highlightcolor #123456 #123456 non-existent
	    {unknown color name "non-existent"}}
    {-highlightthickness 2 2 badValue {bad screen distance "badValue"}}
    {-label "Some text" {Some text} {} {}}
    {-length 130 130 badValue {bad screen distance "badValue"}}
    {-orient horizontal horizontal badValue
	    {bad orient "badValue": must be horizontal or vertical}}
    {-orient horizontal horizontal {} {}}
    {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
    {-repeatdelay 14 14 bogus {expected integer but got "bogus"}}
    {-repeatinterval 14 14 bogus {expected integer but got "bogus"}}
    {-resolution 2.0 2.0 badValue
	    {expected floating-point number but got "badValue"}}
    {-showvalue 0 0 badValue {expected boolean value but got "badValue"}}
    {-sliderlength 86 86 badValue {bad screen distance "badValue"}}
    {-sliderrelief raised raised badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
    {-state disabled disabled badValue
	    {bad state "badValue": must be active, disabled, or normal}}
    {-state normal normal {} {}}
    {-takefocus "any string" "any string" {} {}}
    {-tickinterval 4.3 4.0 badValue
	    {expected floating-point number but got "badValue"}}
    {-to 14.9 15.0 badValue
	    {expected floating-point number but got "badValue"}}
    {-troughcolor #ff0000 #ff0000 non-existent
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
    .s get
} {118}
test scale-3.29 {ScaleWidgetCmd procedure} {
    list [catch {.s dumb} msg] $msg
} {1 {bad option "dumb": must be cget, configure, coords, get, identify, or set}}
test scale-3.30 {ScaleWidgetCmd procedure} {
    list [catch {.s c} msg] $msg
} {1 {bad option "c": must be cget, configure, coords, get, identify, or set}}
test scale-3.31 {ScaleWidgetCmd procedure} {
    list [catch {.s co} msg] $msg
} {1 {bad option "co": must be cget, configure, coords, get, identify, or set}}
test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} {
    proc kill args {
	destroy .s
    }
    catch {destroy .s}
    scale .s -variable x -from 0 -to 100 -orient horizontal
    pack .s







|


|







207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
    .s get
} {118}
test scale-3.29 {ScaleWidgetCmd procedure} {
    list [catch {.s dumb} msg] $msg
} {1 {bad option "dumb": must be cget, configure, coords, get, identify, or set}}
test scale-3.30 {ScaleWidgetCmd procedure} {
    list [catch {.s c} msg] $msg
} {1 {ambiguous option "c": must be cget, configure, coords, get, identify, or set}}
test scale-3.31 {ScaleWidgetCmd procedure} {
    list [catch {.s co} msg] $msg
} {1 {ambiguous option "co": must be cget, configure, coords, get, identify, or set}}
test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} {
    proc kill args {
	destroy .s
    }
    catch {destroy .s}
    scale .s -variable x -from 0 -to 100 -orient horizontal
    pack .s
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
    unset x
    lappend result [catch {set x} msg] $msg
} {0 0 92 3 0 3}
test scale-5.4 {ConfigureScale procedure} {
    catch {destroy .s}
    scale .s -from 0 -to 100
    list [catch {.s configure -orient dumb} msg] $msg
} {1 {bad orientation "dumb": must be vertical or horizontal}}
test scale-5.5 {ConfigureScale procedure} {
    catch {destroy .s}
    scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76
    list [format %.1f [.s cget -from]] [format %.1f [.s cget -to]] \
	    [format %.1f [.s cget -tickinterval]]
} {1.1 1.9 0.8}
test scale-5.6 {ConfigureScale procedure} {
    catch {destroy .s}
    scale .s -from 1 -to 10 -tickinterval -2
    pack .s
    set result [lindex [.s configure -tickinterval] 4]
    .s configure -from 10 -to 1 -tickinterval 2
    lappend result [lindex [.s configure -tickinterval] 4]
} {2.0 -2.0}
test scale-5.7 {ConfigureScale procedure} {
    catch {destroy .s}
    list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg
} {1 {bad state value "bogus": must be normal, active, or disabled}}

catch {destroy .s}
scale .s -orient horizontal -length 200
pack .s
test scale-6.1 {ComputeFormat procedure} {
    .s configure -from 10 -to 100 -resolution 10
    .s set 49.3







|

















|







265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
    unset x
    lappend result [catch {set x} msg] $msg
} {0 0 92 3 0 3}
test scale-5.4 {ConfigureScale procedure} {
    catch {destroy .s}
    scale .s -from 0 -to 100
    list [catch {.s configure -orient dumb} msg] $msg
} {1 {bad orient "dumb": must be horizontal or vertical}}
test scale-5.5 {ConfigureScale procedure} {
    catch {destroy .s}
    scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76
    list [format %.1f [.s cget -from]] [format %.1f [.s cget -to]] \
	    [format %.1f [.s cget -tickinterval]]
} {1.1 1.9 0.8}
test scale-5.6 {ConfigureScale procedure} {
    catch {destroy .s}
    scale .s -from 1 -to 10 -tickinterval -2
    pack .s
    set result [lindex [.s configure -tickinterval] 4]
    .s configure -from 10 -to 1 -tickinterval 2
    lappend result [lindex [.s configure -tickinterval] 4]
} {2.0 -2.0}
test scale-5.7 {ConfigureScale procedure} {
    catch {destroy .s}
    list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg
} {1 {bad state "bogus": must be active, disabled, or normal}}

catch {destroy .s}
scale .s -orient horizontal -length 200
pack .s
test scale-6.1 {ComputeFormat procedure} {
    .s configure -from 10 -to 100 -resolution 10
    .s set 49.3
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
    .s configure -from 1000000 -to 10000000 -resolution 1000000
    .s set 4930000
    .s get
} {5000000}
test scale-6.7 {ComputeFormat procedure} {
    .s configure -from 1000000000 -to 10000000000 -resolution 1000000000
    .s set 4930000000
    .s get
} {5.0e+09}
test scale-6.8 {ComputeFormat procedure} {
    .s configure -from .1 -to 1 -resolution .1
    .s set .6
    .s get
} {0.6}
test scale-6.9 {ComputeFormat procedure} {
    .s configure -from .01 -to .1 -resolution .01







|
|







324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
    .s configure -from 1000000 -to 10000000 -resolution 1000000
    .s set 4930000
    .s get
} {5000000}
test scale-6.7 {ComputeFormat procedure} {
    .s configure -from 1000000000 -to 10000000000 -resolution 1000000000
    .s set 4930000000
    expr {[.s get] == 5.0e+09}
} 1
test scale-6.8 {ComputeFormat procedure} {
    .s configure -from .1 -to 1 -resolution .1
    .s set .6
    .s get
} {0.6}
test scale-6.9 {ComputeFormat procedure} {
    .s configure -from .01 -to .1 -resolution .01
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
    .s configure -from .00001 -to .0001 -resolution .00001
    .s set .00006
    .s get
} {0.00006}
test scale-6.13 {ComputeFormat procedure} {
    .s configure -from .000001 -to .00001 -resolution .000001
    .s set .000006
    .s get
} {6.0e-06}
test scale-6.14 {ComputeFormat procedure} {
    .s configure -to .00001 -from .0001 -resolution .00001
    .s set .00006
    .s get
} {0.00006}
test scale-6.15 {ComputeFormat procedure} {
    .s configure -to .000001 -from .00001 -resolution .000001
    .s set .000006
    .s get
} {6.0e-06}
test scale-6.16 {ComputeFormat procedure} {
    .s configure -from .00001 -to .0001 -resolution .00001 -digits 1
    .s set .00006
    .s get
} {6e-05}
test scale-6.17 {ComputeFormat procedure} {
    .s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3
    .s set 49300000
    .s get
} {50000000}
test scale-6.18 {ComputeFormat procedure} {
    .s configure -length 200 -from 0 -to 10 -resolution 0 -digits 0







|
|








|
|



|
|







354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
    .s configure -from .00001 -to .0001 -resolution .00001
    .s set .00006
    .s get
} {0.00006}
test scale-6.13 {ComputeFormat procedure} {
    .s configure -from .000001 -to .00001 -resolution .000001
    .s set .000006
    expr {[.s get] == 6.0e-06}
} {1}
test scale-6.14 {ComputeFormat procedure} {
    .s configure -to .00001 -from .0001 -resolution .00001
    .s set .00006
    .s get
} {0.00006}
test scale-6.15 {ComputeFormat procedure} {
    .s configure -to .000001 -from .00001 -resolution .000001
    .s set .000006
    expr {[.s get] == 6.0e-06}
} {1}
test scale-6.16 {ComputeFormat procedure} {
    .s configure -from .00001 -to .0001 -resolution .00001 -digits 1
    .s set .00006
    expr {[.s get] == 6e-05}
} {1}
test scale-6.17 {ComputeFormat procedure} {
    .s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3
    .s set 49300000
    .s get
} {50000000}
test scale-6.18 {ComputeFormat procedure} {
    .s configure -length 200 -from 0 -to 10 -resolution 0 -digits 0
795
796
797
798
799
800
801

















    interp hide {} .s
    destroy .s
    list [winfo children .] [interp hidden]
} [list {} $l]

catch {destroy .s}
option clear
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
    interp hide {} .s
    destroy .s
    list [winfo children .] [interp hidden]
} [list {} $l]

catch {destroy .s}
option clear

# cleanup
::tcltest::cleanupTests
return













Changes to tests/scrollbar.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# This file is a Tcl script to test out scrollbar widgets and
# the "scrollbar" command of Tk.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) scrollbar.test 1.33 97/08/13 17:37:19

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .






|
|
<

|

|
|







1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out scrollbar widgets and
# the "scrollbar" command of Tk.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: scrollbar.test,v 1.1.4.5 1999/03/26 00:08:04 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
test scrollbar-3.9 {ScrollbarWidgetCmd procedure, "activate" option} {
    list [catch {.s activate trough1} msg] $msg
} {0 {}}
test scrollbar-3.10 {ScrollbarWidgetCmd procedure, "cget" option} {
    list [catch {.s cget -orient} msg] $msg
} {0 vertical}
scrollbar .s2
test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} {pc} {
    list [catch {.s2 cget -bd} msg] $msg
} {0 0}
test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} {!pc} {
    list [catch {.s2 cget -bd} msg] $msg
} {0 2}
test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} {pc} {
    list [catch {.s2 cget -highlightthickness} msg] $msg
} {0 0}
test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {!pc} {
    list [catch {.s2 cget -highlightthickness} msg] $msg
} {0 1}
destroy .s2
test scrollbar-3.15 {ScrollbarWidgetCmd procedure, "configure" option} {
    llength [.s configure]
} {20}
test scrollbar-3.16 {ScrollbarWidgetCmd procedure, "configure" option} {







|


|


|


|







165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
test scrollbar-3.9 {ScrollbarWidgetCmd procedure, "activate" option} {
    list [catch {.s activate trough1} msg] $msg
} {0 {}}
test scrollbar-3.10 {ScrollbarWidgetCmd procedure, "cget" option} {
    list [catch {.s cget -orient} msg] $msg
} {0 vertical}
scrollbar .s2
test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} {
    list [catch {.s2 cget -bd} msg] $msg
} {0 0}
test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} {
    list [catch {.s2 cget -bd} msg] $msg
} {0 2}
test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} {
    list [catch {.s2 cget -highlightthickness} msg] $msg
} {0 0}
test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} {
    list [catch {.s2 cget -highlightthickness} msg] $msg
} {0 1}
destroy .s2
test scrollbar-3.15 {ScrollbarWidgetCmd procedure, "configure" option} {
    llength [.s configure]
} {20}
test scrollbar-3.16 {ScrollbarWidgetCmd procedure, "configure" option} {
658
659
660
661
662
663
664
665
















    interp hide {} .s
    destroy .s
    list [winfo children .] [interp hidden]
} [list {} $l]

catch {destroy .s}
catch {destroy .t}
concat {}























|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
    interp hide {} .s
    destroy .s
    list [winfo children .] [interp hidden]
} [list {} $l]

catch {destroy .s}
catch {destroy .t}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/select.test.

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
# This file is a Tcl script to test out Tk's selection management code,
# especially the "selection" command.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) select.test 1.17 96/12/09 17:25:48

#
# Note: Multiple display selection handling will only be tested if the
# environment variable TK_ALT_DISPLAY is set to an alternate display.
#

if {[string compare test [info procs test]] == 1} {
    source defs
}

eval destroy [winfo child .]

global longValue selValue selInfo

set selValue {}





|
|
<

|






|
|







1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
# This file is a Tcl script to test out Tk's selection management code,
# especially the "selection" command.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: select.test,v 1.1.4.4 1999/03/24 02:54:59 hershey Exp $

#
# Note: Multiple display selection handling will only be tested if the
# environment variable TK_ALT_DISPLAY is set to an alternate display.
#

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

eval destroy [winfo child .]

global longValue selValue selInfo

set selValue {}
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
    setupbg
    selection handle -selection PRIMARY .f1 {handler TEST} TEST
    update
    set selValue "Test value"
    set selInfo ""
    selection own .f1
    set result ""
    fileevent $fd readable {}
    puts $fd {catch {selection get TEST} msg; update; puts $msg; flush stdout}
    flush $fd
    lappend result [gets $fd]
    cleanupbg
    lappend result $selInfo
} {{selection owner didn't respond} {}}

# multiple display tests
if {[info exists env(TK_ALT_DISPLAY)]} {
    test select-5.11 {Tk_GetSelection procedure} {







|
|
|
|







444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
    setupbg
    selection handle -selection PRIMARY .f1 {handler TEST} TEST
    update
    set selValue "Test value"
    set selInfo ""
    selection own .f1
    set result ""
    fileevent $::tcltest::fd readable {}
    puts $::tcltest::fd {catch {selection get TEST} msg; update; puts $msg; flush stdout}
    flush $::tcltest::fd
    lappend result [gets $::tcltest::fd]
    cleanupbg
    lappend result $selInfo
} {{selection owner didn't respond} {}}

# multiple display tests
if {[info exists env(TK_ALT_DISPLAY)]} {
    test select-5.11 {Tk_GetSelection procedure} {
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
test select-10.1 {ConvertSelection procedure, race with selection clear} {unixOnly} {
    setup
    setupbg
    set selValue "Just a simple test"
    set selInfo ""
    selection handle .f1 {handler STRING}
    update
    puts $fd {puts "[catch {selection get} msg] $msg"; puts **DONE**; flush stdout}
    flush $fd
    after 200
    selection own .
    set bgData {}
    tkwait variable bgDone
    cleanupbg
    list $bgData $selInfo
} {{1 PRIMARY selection doesn't exist or form "STRING" not defined} {}}
test select-10.2 {ConvertSelection procedure} {unixOnly} {
    setup
    setupbg
    set selValue [string range $longValue 0 3999]
    set selInfo ""
    selection handle .f1 {handler STRING}







|
|


|
|

|







809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
test select-10.1 {ConvertSelection procedure, race with selection clear} {unixOnly} {
    setup
    setupbg
    set selValue "Just a simple test"
    set selInfo ""
    selection handle .f1 {handler STRING}
    update
    puts $::tcltest::fd {puts "[catch {selection get} msg] $msg"; puts **DONE**; flush stdout}
    flush $::tcltest::fd
    after 200
    selection own .
    set ::tcltest::bgData {}
    tkwait variable ::tcltest::bgDone
    cleanupbg
    list $::tcltest::bgData $selInfo
} {{1 PRIMARY selection doesn't exist or form "STRING" not defined} {}}
test select-10.2 {ConvertSelection procedure} {unixOnly} {
    setup
    setupbg
    set selValue [string range $longValue 0 3999]
    set selInfo ""
    selection handle .f1 {handler STRING}
980
981
982
983
984
985
986
987
















    set abortCount 2
    lappend result [dobg {selection get}]
    cleanupbg
    lappend result $selInfo
} {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000 .f1 STRING 4000 4000}}

catch {rename weirdHandler {}}
concat























|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
    set abortCount 2
    lappend result [dobg {selection get}]
    cleanupbg
    lappend result $selInfo
} {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000 .f1 STRING 4000 4000}}

catch {rename weirdHandler {}}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/send.test.

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
# This file is a Tcl script to test out the "send" command and the
# other procedures in the file tkSend.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) send.test 1.26 96/12/09 17:26:42




if {$tcl_platform(platform) == "macintosh"} {
    puts "send is not available on the Mac - skipping tests"

    return
}
if {$tcl_platform(platform) == "window"} {
    puts "send is not available under Windows - skipping tests"

    return
}
if {[auto_execok xhost] == ""} {
    puts "xhost application isn't available - skipping tests"

    return
}

if {[info procs test] != "test"} {
    source defs
}
if {[info commands testsend] == "testsend"} {
    set gotTestCmds 1
} else {
    set gotTestCmds 0
}

foreach i [winfo children .] {






>
>

<
<
>
|
<
>
>
>



>




>




>



<
<
<







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
# This file is a Tcl script to test out the "send" command and the
# other procedures in the file tkSend.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: send.test,v 1.1.4.8 1999/04/05 18:36:04 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {$tcl_platform(platform) == "macintosh"} {
    puts "send is not available on the Mac - skipping tests"
    ::tcltest::cleanupTests
    return
}
if {$tcl_platform(platform) == "window"} {
    puts "send is not available under Windows - skipping tests"
    ::tcltest::cleanupTests
    return
}
if {[auto_execok xhost] == ""} {
    puts "xhost application isn't available - skipping tests"
    ::tcltest::cleanupTests
    return
}




if {[info commands testsend] == "testsend"} {
    set gotTestCmds 1
} else {
    set gotTestCmds 0
}

foreach i [winfo children .] {
44
45
46
47
48
49
50

51
52
53
54
55
56
57
setupbg
set app [dobg {tk appname}]
if {[catch {send $app set a 0} msg] == 1} {
    if [string match "X server insecure *" $msg] {
	puts -nonewline "Your X server is insecure, so \"send\" can't be used;"
	puts " skipping \"send\" tests."
	cleanupbg

	return
    }
}
cleanupbg

# Compute a script that will load Tk into a child interpreter.








>







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
setupbg
set app [dobg {tk appname}]
if {[catch {send $app set a 0} msg] == 1} {
    if [string match "X server insecure *" $msg] {
	puts -nonewline "Your X server is insecure, so \"send\" can't be used;"
	puts " skipping \"send\" tests."
	cleanupbg
	::tcltest::cleanupTests
	return
    }
}
cleanupbg

# Compute a script that will load Tk into a child interpreter.

320
321
322
323
324
325
326


327
328
329
330
331
332
333
    interp delete t_s_2
    test send-8.15 {Tk_SendCmd procedure, local interp, error info} {
	catch {error foo}
	list [catch {send t_s_1 {if 1 {open bogus_file_name}}} msg] $msg $errorInfo $errorCode
    } {1 {couldn't open "bogus_file_name": no such file or directory} {couldn't open "bogus_file_name": no such file or directory
    while executing
"open bogus_file_name"


    invoked from within
"send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}}
    test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} {
	testsend prop root InterpRegistry "10234 bogus\n"
	set result [list [catch {send bogus bogus command} msg] $msg]
	winfo interps
	tk appname tktest







>
>







324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
    interp delete t_s_2
    test send-8.15 {Tk_SendCmd procedure, local interp, error info} {
	catch {error foo}
	list [catch {send t_s_1 {if 1 {open bogus_file_name}}} msg] $msg $errorInfo $errorCode
    } {1 {couldn't open "bogus_file_name": no such file or directory} {couldn't open "bogus_file_name": no such file or directory
    while executing
"open bogus_file_name"
    invoked from within
"if 1 {open bogus_file_name}"
    invoked from within
"send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}}
    test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} {
	testsend prop root InterpRegistry "10234 bogus\n"
	set result [list [catch {send bogus bogus command} msg] $msg]
	winfo interps
	tk appname tktest
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
	cleanupbg
	set x
    } {0 {}}
    test send-10.19 {SendEventProc procedure, send exits} {
	setupbg
	dobg {tk appname t_s_3}
	set x [list [catch {send t_s_3 exit} msg] $msg]
	close $fd
	set x
    } {1 {target application died}}

    test send-11.1 {AppendPropCarefully and AppendErrorProc procedures} {
	testsend prop root InterpRegistry "0x21447 dummy\n"
	list [catch {send dummy foo} msg] $msg
    } {1 {no application named "dummy"}}







|







548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
	cleanupbg
	set x
    } {0 {}}
    test send-10.19 {SendEventProc procedure, send exits} {
	setupbg
	dobg {tk appname t_s_3}
	set x [list [catch {send t_s_3 exit} msg] $msg]
	close $::tcltest::fd
	set x
    } {1 {target application died}}

    test send-11.1 {AppendPropCarefully and AppendErrorProc procedures} {
	testsend prop root InterpRegistry "0x21447 dummy\n"
	list [catch {send dummy foo} msg] $msg
    } {1 {no application named "dummy"}}
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
    testsend prop root InterpRegistry ""
}
test send-12.2 {TimeoutProc procedure} {
    winfo interps
    tk appname tktest
    update
    setupbg
    puts $fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
    set bgDone 0
    set bgData {}
    flush $fd
    tkwait variable bgDone
    set app $bgData
    after 200
    set result [list [catch {send $app foo} msg] $msg]
    close $fd
    set result
} {1 {target application died}}

winfo interps
tk appname tktest
test send-13.1 {DeleteProc procedure} {
    setupbg







|
|
|
|
|
|


|







579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
    testsend prop root InterpRegistry ""
}
test send-12.2 {TimeoutProc procedure} {
    winfo interps
    tk appname tktest
    update
    setupbg
    puts $::tcltest::fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
    set ::tcltest::bgDone 0
    set ::tcltest::bgData {}
    flush $::tcltest::fd
    tkwait variable ::tcltest::bgDone
    set app $::tcltest::bgData
    after 200
    set result [list [catch {send $app foo} msg] $msg]
    close $::tcltest::fd
    set result
} {1 {target application died}}

winfo interps
tk appname tktest
test send-13.1 {DeleteProc procedure} {
    setupbg
650
651
652
653
654
655
656

















if $gotTestCmds {
    testsend prop root InterpRegistry $registry
}
if $gotTestCmds {
    testdeleteapps
}
rename newApp {}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
if $gotTestCmds {
    testsend prop root InterpRegistry $registry
}
if $gotTestCmds {
    testdeleteapps
}
rename newApp {}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/text.test.

1
2
3
4
5


6
7
8

9
10


11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test the code in the file tkText.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) text.test 1.46 97/10/13 15:18:31



if {[string compare test [info procs test]] == 1} then \
  {source defs}

eval destroy [winfo child .]

# Create entries in the option database to be sure that geometry options
# like border width have predictable values.

option add *Text.borderWidth 2





>
>

<
<
>
|
<
>
>
|
<
<







1
2
3
4
5
6
7
8


9
10

11
12
13


14
15
16
17
18
19
20
# This file is a Tcl script to test the code in the file tkText.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: text.test,v 1.1.4.6 1999/04/02 23:51:49 stanton Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}



eval destroy [winfo child .]

# Create entries in the option database to be sure that geometry options
# like border width have predictable values.

option add *Text.borderWidth 2
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
    list [catch {.t search abc 1.0 lousy} msg] $msg
} {1 {bad text index "lousy"}}
test text-20.17 {TextSearchCmd procedure, pattern case conversion} {
    list [.t search -nocase BAR 1.1] [.t search BAR 1.1]
} {2.13 {}}
test text-20.18 {TextSearchCmd procedure, bad regular expression pattern} {
    list [catch {.t search -regexp a( 1.0} msg] $msg
} {1 {couldn't compile regular expression pattern: unmatched ()}}
test text-20.19 {TextSearchCmd procedure, skip dummy last line} {
    .t search -backwards BaR end 1.0
} {2.23}
test text-20.20 {TextSearchCmd procedure, skip dummy last line} {
    .t search -backwards \n end 1.0
} {3.9}
test text-20.21 {TextSearchCmd procedure, skip dummy last line} {







|







902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
    list [catch {.t search abc 1.0 lousy} msg] $msg
} {1 {bad text index "lousy"}}
test text-20.17 {TextSearchCmd procedure, pattern case conversion} {
    list [.t search -nocase BAR 1.1] [.t search BAR 1.1]
} {2.13 {}}
test text-20.18 {TextSearchCmd procedure, bad regular expression pattern} {
    list [catch {.t search -regexp a( 1.0} msg] $msg
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test text-20.19 {TextSearchCmd procedure, skip dummy last line} {
    .t search -backwards BaR end 1.0
} {2.23}
test text-20.20 {TextSearchCmd procedure, skip dummy last line} {
    .t search -backwards \n end 1.0
} {3.9}
test text-20.21 {TextSearchCmd procedure, skip dummy last line} {
1078
1079
1080
1081
1082
1083
1084





















1085
1086
1087
1088
1089
1090
1091
    # a core leak if the pattern copy isn't properly freed.

    set p abcdefg1234567890
    set p $p$p$p$p$p$p$p$p
    set p $p$p$p$p$p
    .t search -nocase $p 1.0
} {}






















eval destroy [winfo child .]
text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100
pack .t2
.t2 insert end "1\t2\t3\t4\t55.5"
test text-21.1 {TkTextGetTabs procedure} {
    list [catch {.t2 configure -tabs "\{{}"} msg] $msg







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







1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
    # a core leak if the pattern copy isn't properly freed.

    set p abcdefg1234567890
    set p $p$p$p$p$p$p$p$p
    set p $p$p$p$p$p
    .t search -nocase $p 1.0
} {}
test text-20.63 {TextSearchCmd, unicode} {
    .t delete 1.0 end
    .t insert end "foo\u30c9\u30cabar"
    .t search \u30c9\u30ca 1.0
} 1.3
test text-20.64 {TextSearchCmd, unicode} {
    .t delete 1.0 end
    .t insert end "foo\u30c9\u30cabar"
    list [.t search -count n \u30c9\u30ca 1.0] $n
} {1.3 2}
test text-20.65 {TextSearchCmd, unicode with non-text segments} {
    .t delete 1.0 end
    button .b1 -text baz
    .t insert end "foo\u30c9"
    .t window create end -window .b1
    .t insert end "\u30cabar"
    set result [list [.t search -count n \u30c9\u30ca 1.0] $n]
    destroy .b1
    set result
} {1.3 3}


eval destroy [winfo child .]
text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100
pack .t2
.t2 insert end "1\t2\t3\t4\t55.5"
test text-21.1 {TkTextGetTabs procedure} {
    list [catch {.t2 configure -tabs "\{{}"} msg] $msg
1256
1257
1258
1259
1260
1261
1262

















    interp hide {} .t
    destroy .t
    list [winfo children .] [interp hidden]
} [list {} $l]

eval destroy [winfo child .]
option clear
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
    interp hide {} .t
    destroy .t
    list [winfo children .] [interp hidden]
} [list {} $l]

eval destroy [winfo child .]
option clear

# cleanup
::tcltest::cleanupTests
return













Changes to tests/textBTree.test.

1
2
3
4
5
6
7


8
9
10

11
12


13
14
15
16
17
18
19
20
21
22
# This file is a Tcl script to test out the B-tree facilities of
# Tk's text widget (the contents of the file "tkTextBTree.c".  There are
# several file with additional tests for other features of text widgets.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) textBTree.test 1.8 96/03/21 15:51:12



if {[string compare test [info procs test]] == 1} then \
  {source defs}

catch {destroy .t}
text .t
.t debug on

test btree-1.1 {basic insertions} {
    .t delete 1.0 100000.0







>
>

<
<
>
|
<
>
>
|
<
<







1
2
3
4
5
6
7
8
9
10


11
12

13
14
15


16
17
18
19
20
21
22
# This file is a Tcl script to test out the B-tree facilities of
# Tk's text widget (the contents of the file "tkTextBTree.c".  There are
# several file with additional tests for other features of text widgets.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: textBTree.test,v 1.1.4.4 1999/03/24 02:55:01 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}



catch {destroy .t}
text .t
.t debug on

test btree-1.1 {basic insertions} {
    .t delete 1.0 100000.0
889
890
891
892
893
894
895

896



897












    .t tag remove x 1.0 end
    .t tag add x 1.3 1.end
    .t tag add x 200.0 220.0
    .t tag add x 500.0 520.0
    list [.t tag prev x end] [.t tag prev x 433.0]
} {{500.0 520.0} {200.0 220.0}}






destroy .t



















>

>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
    .t tag remove x 1.0 end
    .t tag add x 1.3 1.end
    .t tag add x 200.0 220.0
    .t tag add x 500.0 520.0
    list [.t tag prev x end] [.t tag prev x 433.0]
} {{500.0 520.0} {200.0 220.0}}

destroy .t

# cleanup
::tcltest::cleanupTests
return













Changes to tests/textDisp.test.

1
2
3
4
5


6
7
8

9
10


11
12
13
14
15
16
17
18
19
20
21
22
23
# This file is a Tcl script to test the code in the file tkTextDisp.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) textDisp.test 1.55 97/07/24 15:15:43



if {[string compare test [info procs test]] == 1} {
    source defs
    if {$testConfig(fonts) == 0} {
	puts "skipping font-sensitive tests"
    }
}

# The procedure below is used as the scrolling command for the text;
# it just saves the scrolling information in a variable "scrollInfo".

proc scroll args {
    global scrollInfo





>
>

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







1
2
3
4
5
6
7
8


9
10

11
12
13


14
15

16
17
18
19
20
21
22
# This file is a Tcl script to test the code in the file tkTextDisp.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: textDisp.test,v 1.1.4.5 1999/03/24 02:55:02 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}


if {$::tcltest::testConfig(fonts) == 0} {
    puts "skipping font-sensitive tests"

}

# The procedure below is used as the scrolling command for the text;
# it just saves the scrolling information in a variable "scrollInfo".

proc scroll args {
    global scrollInfo
2862
2863
2864
2865
2866
2867
2868

















    list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
} {{0.536667 1} 300x50+-156+18 {}}

foreach i [winfo children .] {
    catch {destroy $i}
}
option clear
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
    list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
} {{0.536667 1} 300x50+-156+18 {}}

foreach i [winfo children .] {
    catch {destroy $i}
}
option clear

# cleanup
::tcltest::cleanupTests
return













Changes to tests/textImage.test.

1
2








3

4

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
# SCCS: @(#) textImage.test 1.8 97/07/01 18:11:54









if {[string compare test [info procs test]] == 1} then \

  {source ../tests/defs}


# Test Arguments:
# name -                Name of test, in the form foo-1.2.
# description -         Short textual description of the test, to
#                       help humans understand what it does.
# constraints -         A list of one or more keywords, each of
#                       which must be the name of an element in
#                       the array "testConfig".  If any of these
#                       elements is zero, the test is skipped.
#                       This argument may be omitted.
# script -              Script to run to carry out the test.  It must
#                       return a result that can be checked for
#                       correctness.
# answer -              Expected result from script.

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







|







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
# textImage.test -- test images embedded in text widgets
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: textImage.test,v 1.1.4.4 1999/03/24 02:55:03 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# Test Arguments:
# name -                Name of test, in the form foo-1.2.
# description -         Short textual description of the test, to
#                       help humans understand what it does.
# constraints -         A list of one or more keywords, each of
#                       which must be the name of an element in
#                       the array "::tcltest::testConfig".  If any of these
#                       elements is zero, the test is skipped.
#                       This argument may be omitted.
# script -              Script to run to carry out the test.  It must
#                       return a result that can be checked for
#                       correctness.
# answer -              Expected result from script.

347
348
349
350
351
352
353

















    set result
} {{default:55 22 5 5} {top:55 10 5 5} {bottom:55 35 5 5} {center:55 22 5 5} {baseline:55 22 5 5}}
# cleanup

catch {destroy .t}
foreach image [image names] {image delete $image}
font delete test_font
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
    set result
} {{default:55 22 5 5} {top:55 10 5 5} {bottom:55 35 5 5} {center:55 22 5 5} {baseline:55 22 5 5}}
# cleanup

catch {destroy .t}
foreach image [image names] {image delete $image}
font delete test_font

# cleanup
::tcltest::cleanupTests
return













Changes to tests/textIndex.test.

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
# This file is a Tcl script to test the code in the file tkTextIndex.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) textIndex.test 1.9 96/06/24 16:46:55



if {[string compare test [info procs test]] == 1} then \

  {source defs}



catch {destroy .t}
if [catch {text .t -font {Courier 12} -width 20 -height 10}] {
    puts "The font needed by these tests isn't available, so I'm"
    puts "going to skip the tests."
    return
}
pack append . .t {top expand fill}
update
.t debug on
wm geometry . {}
  
# The statements below reset the main window;  it's needed if the window
# manager is mwm to make mwm forget about a previous minimum size setting.

wm withdraw .
wm minsize . 1 1
wm positionfrom . user
wm deiconify .

.t insert 1.0 "Line 1
abcdefghijklm
12345
Line 4
bOy GIrl .#@? x_yz
!@#$%
Line 7"




test textIndex-1.1 {TkTextMakeIndex} {






























































































    .t index -1.3
} 1.0
test textIndex-1.2 {TkTextMakeIndex} {

    .t index 0.3
} 1.0
test textIndex-1.3 {TkTextMakeIndex} {

    .t index 1.3
} 1.3
test textIndex-1.4 {TkTextMakeIndex} {

    .t index 3.-1
} 3.0
test textIndex-1.5 {TkTextMakeIndex} {

    .t index 3.3
} 3.3
test textIndex-1.6 {TkTextMakeIndex} {
    .t index 3.5
} 3.5
test textIndex-1.7 {TkTextMakeIndex} {
    .t index 3.6
} 3.5
test textIndex-1.8 {TkTextMakeIndex} {
    .t index 3.7
} 3.5
test textIndex-1.9 {TkTextMakeIndex} {
    .t index 7.2
} 7.2
test textIndex-1.10 {TkTextMakeIndex} {
    .t index 8.0
} 8.0
test textIndex-1.11 {TkTextMakeIndex} {
    .t index 8.1
} 8.0
test textIndex-1.12 {TkTextMakeIndex} {
    .t index 9.0
} 8.0



.t tag add x 2.3 2.6


test textIndex-2.1 {TkTextIndexToSeg} {

    .t get 2.0
} a
test textIndex-2.2 {TkTextIndexToSeg} {

    .t get 2.2
} c
test textIndex-2.3 {TkTextIndexToSeg} {
    .t get 2.3
} d
test textIndex-2.4 {TkTextIndexToSeg} {

    .t get 2.6
} g


test textIndex-2.5 {TkTextIndexToSeg} {


    .t get 2.7
} h
test textIndex-2.6 {TkTextIndexToSeg} {
    .t get 2.12
} m
test textIndex-2.7 {TkTextIndexToSeg} {

    .t get 2.13
} \n

test textIndex-2.8 {TkTextIndexToSeg} {

    .t get 2.14
} \n
.t tag delete x

.t mark set foo 3.2
.t tag add x 2.8 2.11
.t tag add x 6.0 6.2
set weirdTag "funny . +- 22.1\n\t{"
.t tag add $weirdTag 2.1  2.6
set weirdMark "asdf \n{-+ 66.2\t"





>
>

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


|
<
<
<
<

















|



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


|
>


|
>


|
>


|
>


|
|
<
<
|
|
|
|
<
<


|
|
|
|
|
|
|
|
|

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







1
2
3
4
5
6
7
8


9
10

11
12
13
14
15
16
17
18
19
20
21




22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160


161
162
163
164


165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203

204
205
206
207
208

209
210
211
212
213

214
215
216
217
218
219
220
# This file is a Tcl script to test the code in the file tkTextIndex.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: textIndex.test,v 1.1.4.8 1999/04/06 19:03:29 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# Some tests require the testtext command

set ::tcltest::testConfig(testtext) \
	[expr {[info commands testtext] != {}}]

catch {destroy .t}
text .t -font {Courier -12} -width 20 -height 10




pack append . .t {top expand fill}
update
.t debug on
wm geometry . {}
  
# The statements below reset the main window;  it's needed if the window
# manager is mwm to make mwm forget about a previous minimum size setting.

wm withdraw .
wm minsize . 1 1
wm positionfrom . user
wm deiconify .

.t insert 1.0 "Line 1
abcdefghijklm
12345
Line 4
b\u4e4fy GIrl .#@? x_yz
!@#$%
Line 7"

image create photo textimage -width 10 -height 10
textimage put red -to 0 0 9 9

test textIndex-1.1 {TkTextMakeByteIndex} {testtext} {
    # (lineIndex < 0)
    testtext .t byteindex -1 3
} {1.0 0}
test textIndex-1.2 {TkTextMakeByteIndex} {testtext} {
    # (lineIndex < 0), because lineIndex == strtol(argv[2]) - 1
    testtext .t byteindex 0 3
} {1.0 0}
test textIndex-1.3 {TkTextMakeByteIndex} {testtext} {
    # not (lineIndex < 0)
    testtext .t byteindex 1 3
} {1.3 3}
test textIndex-1.4 {TkTextMakeByteIndex} {testtext} {
    # (byteIndex < 0)
    testtext .t byteindex 3 -1
} {3.0 0}
test textIndex-1.5 {TkTextMakeByteIndex} {testtext} {
    # not (byteIndex < 0)
    testtext .t byteindex 3 3
} {3.3 3}
test textIndex-1.6 {TkTextMakeByteIndex} {testtext} {
    # (indexPtr->linePtr == NULL)
    testtext .t byteindex 9 2
} {8.0 0}
test textIndex-1.7 {TkTextMakeByteIndex} {testtext} {
    # not (indexPtr->linePtr == NULL)
    testtext .t byteindex 7 2
} {7.2 2}
test textIndex-1.8 {TkTextMakeByteIndex: shortcut for 0} {testtext} {
    # (byteIndex == 0)
    testtext .t byteindex 1 0
} {1.0 0}
test textIndex-1.9 {TkTextMakeByteIndex: shortcut for 0} {testtext} {
    # not (byteIndex == 0)
    testtext .t byteindex 3 80
} {3.5 5}
test textIndex-1.10 {TkTextMakeByteIndex: verify index is in range} {testtext} {
    # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) 
    # one segment

    testtext .t byteindex 3 5
} {3.5 5}
test textIndex-1.11 {TkTextMakeByteIndex: verify index is in range} {testtext} {
    # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
    #     index += segPtr->size
    # Multiple segments, make sure add segment size to index.

    .t mark set foo 3.2 
    set x [testtext .t byteindex 3 7]
    .t mark unset foo
    set x
} {3.5 5}
test textIndex-1.12 {TkTextMakeByteIndex: verify index is in range} {testtext} {
    # (segPtr == NULL)
    testtext .t byteindex 3 7
} {3.5 5}
test textIndex-1.13 {TkTextMakeByteIndex: verify index is in range} {testtext} {
    # not (segPtr == NULL)
    testtext .t byteindex 3 4
} {3.4 4}
test textIndex-1.14 {TkTextMakeByteIndex: verify index is in range} {testtext} {
    # (index + segPtr->size > byteIndex)
    # in this segment.

    testtext .t byteindex 3 4
} {3.4 4}
test textIndex-1.15 {TkTextMakeByteIndex: verify index is in range} {testtext} {
    # (index + segPtr->size > byteIndex), index != 0
    # in this segment.

    .t mark set foo 3.2
    set x [testtext .t byteindex 3 4]
    .t mark unset foo
    set x
} {3.4 4}
test textIndex-1.16 {TkTextMakeByteIndex: UTF-8 characters} {testtext} {
    testtext .t byteindex 5 100
} {5.18 20}
test textIndex-1.17 {TkTextMakeByteIndex: prevent splitting UTF-8 character} \
	{testtext} {
    # ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType)) 
    # Wrong answer would be \xb9 (the 2nd byte of UTF rep of 0x4e4f).

    set x [testtext .t byteindex 5 2]
    list $x [.t get insert]
} {{5.2 4} y}
test textIndex-1.18 {TkTextMakeByteIndex: prevent splitting UTF-8 character} \
	{testtext} {
    # ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType)) 
    testtext .t byteindex 5 1
    .t get insert
} "\u4e4f"

test textIndex-2.1 {TkTextMakeCharIndex} {
    # (lineIndex < 0)
    .t index -1.3
} 1.0
test textIndex-2.2 {TkTextMakeCharIndex} {
    # (lineIndex < 0), because lineIndex == strtol(argv[2]) - 1
    .t index 0.3
} 1.0
test textIndex-2.3 {TkTextMakeCharIndex} {
    # not (lineIndex < 0)
    .t index 1.3
} 1.3
test textIndex-2.4 {TkTextMakeCharIndex} {
    # (charIndex < 0)
    .t index 3.-1
} 3.0
test textIndex-2.5 {TkTextMakeCharIndex} {
    # (charIndex < 0)
    .t index 3.3
} 3.3
test textIndex-2.6 {TkTextMakeCharIndex} {
    # (indexPtr->linePtr == NULL)


    .t index 9.2
} 8.0
test textIndex-2.7 {TkTextMakeCharIndex} {
    # not (indexPtr->linePtr == NULL)


    .t index 7.2
} 7.2
test textIndex-2.8 {TkTextMakeCharIndex: verify index is in range} {
    # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
    # one segment

    .t index 3.5
} 3.5
test textIndex-2.9 {TkTextMakeCharIndex: verify index is in range} {
    # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
    # Multiple segments, make sure add segment size to index.

    .t mark set foo 3.2 
    set x [.t index 3.7]
    .t mark unset foo
    set x
} 3.5
test textIndex-2.10 {TkTextMakeCharIndex: verify index is in range} {
    # (segPtr == NULL)
    .t index 3.7
} 3.5
test textIndex-2.11 {TkTextMakeCharIndex: verify index is in range} {
    # not (segPtr == NULL)
    .t index 3.4
} 3.4
test textIndex-2.12 {TkTextMakeCharIndex: verify index is in range} {
    # (segPtr->typePtr == &tkTextCharType)
    # Wrong answer would be \xb9 (the 2nd byte of UTF rep of 0x4e4f).

    .t mark set insert 5.2
    .t get insert
} y
test textIndex-2.13 {TkTextMakeCharIndex: verify index is in range} {
    # not (segPtr->typePtr == &tkTextCharType)

    .t image create 5.2 -image textimage
    .t mark set insert 5.5
    set x [.t get insert]
    .t delete 5.2

    set x
} "G"
test textIndex-2.14 {TkTextMakeCharIndex: verify index is in range} {
    # (charIndex < segPtr->size)


    .t image create 5.0 -image textimage
    set x [.t index 5.0]
    .t delete 5.0
    set x
} 5.0


.t mark set foo 3.2
.t tag add x 2.8 2.11
.t tag add x 6.0 6.2
set weirdTag "funny . +- 22.1\n\t{"
.t tag add $weirdTag 2.1  2.6
set weirdMark "asdf \n{-+ 66.2\t"
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255








256
257























258
259
260

261
262
263
















264
265
266



267
268
269

270
271

































272

273
274
275

276
277
278



















279

280
281
282

283
284
285



286
287
288






















289
290
291



292







































293
294









295
296









297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347





















348


349












test textIndex-10.3 {ForwBack} {
    list [catch {.t index {2.3 + 2c}} msg] $msg
} {0 2.5}
test textIndex-10.4 {ForwBack} {
    list [catch {.t index {2.3 - 3ch}} msg] $msg
} {0 2.0}
test textIndex-10.5 {ForwBack} {
    list [catch {.t index {2.3 + 3 lines}} msg] $msg
} {0 5.3}
test textIndex-10.6 {ForwBack} {
    list [catch {.t index {2.3 -1l}} msg] $msg
} {0 1.3}
test textIndex-10.7 {ForwBack} {
    list [catch {.t index {2.3 -1 gorp}} msg] $msg
} {1 {bad text index "2.3 -1 gorp"}}
test textIndex-10.8 {ForwBack} {
    list [catch {.t index {2.3 - 4 lines}} msg] $msg
} {0 1.3}









test textIndex-11.1 {TkTextIndexForwChars} {























    .t index {2.3 + -7 chars}
} 1.3
test textIndex-11.2 {TkTextIndexForwChars} {

    .t index {2.3 + 5 chars}
} 2.8
test textIndex-11.3 {TkTextIndexForwChars} {
















    .t index {2.3 + 10 chars}
} 2.13
test textIndex-11.4 {TkTextIndexForwChars} {



    .t index {2.3 + 11 chars}
} 3.0
test textIndex-11.5 {TkTextIndexForwChars} {

    .t index {2.3 + 55 chars}
} 7.6

































test textIndex-11.6 {TkTextIndexForwChars} {

    .t index {2.3 + 56 chars}
} 8.0
test textIndex-11.7 {TkTextIndexForwChars} {

    .t index {2.3 + 57 chars}
} 8.0




















test textIndex-12.1 {TkTextIndexBackChars} {

    .t index {3.2 - -10 chars}
} 4.6
test textIndex-12.2 {TkTextIndexBackChars} {

    .t index {3.2 - 2 chars}
} 3.0
test textIndex-12.3 {TkTextIndexBackChars} {



    .t index {3.2 - 3 chars}
} 2.13
test textIndex-12.4 {TkTextIndexBackChars} {






















    .t index {3.2 - 22 chars}
} 1.1
test textIndex-12.5 {TkTextIndexBackChars} {



    .t index {3.2 - 23 chars}







































} 1.0
test textIndex-12.6 {TkTextIndexBackChars} {









    .t index {3.2 - 24 chars}
} 1.0










proc getword index {
    .t get [.t index "$index wordstart"] [.t index "$index wordend"]
}
test textIndex-13.1 {StartEnd} {
    list [catch {.t index {2.3 lineend}} msg] $msg
} {0 2.13}
test textIndex-13.2 {StartEnd} {
    list [catch {.t index {2.3 linee}} msg] $msg
} {0 2.13}
test textIndex-13.3 {StartEnd} {
    list [catch {.t index {2.3 line}} msg] $msg
} {1 {bad text index "2.3 line"}}
test textIndex-13.4 {StartEnd} {
    list [catch {.t index {2.3 linestart}} msg] $msg
} {0 2.0}
test textIndex-13.5 {StartEnd} {
    list [catch {.t index {2.3 lines}} msg] $msg
} {0 2.0}
test textIndex-13.6 {StartEnd} {
    getword 5.3
} { }
test textIndex-13.7 {StartEnd} {
    getword 5.4
} GIrl
test textIndex-13.8 {StartEnd} {
    getword 5.7
} GIrl
test textIndex-13.9 {StartEnd} {
    getword 5.8
} { }
test textIndex-13.10 {StartEnd} {
    getword 5.14
} x_yz
test textIndex-13.11 {StartEnd} {
    getword 6.2
} #
test textIndex-13.12 {StartEnd} {
    getword 3.4
} 12345
.t tag add x 2.8 2.11
test textIndex-13.13 {StartEnd} {
    list [catch {.t index {2.2 worde}} msg] $msg
} {0 2.13}
test textIndex-13.14 {StartEnd} {
    list [catch {.t index {2.12 words}} msg] $msg
} {0 2.0}
test textIndex-13.15 {StartEnd} {
    list [catch {.t index {2.12 word}} msg] $msg
} {1 {bad text index "2.12 word"}}






















catch {destroy .t}


concat



















|
|









>
>
>
>
>
>
>
>

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


|
>


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


|
>
>
>


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


|
>



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


|
>


|
>
>
>


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


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

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




|


|


|


|


|


|


|


|


|


|


|


|



|


|


|



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

>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
test textIndex-10.3 {ForwBack} {
    list [catch {.t index {2.3 + 2c}} msg] $msg
} {0 2.5}
test textIndex-10.4 {ForwBack} {
    list [catch {.t index {2.3 - 3ch}} msg] $msg
} {0 2.0}
test textIndex-10.5 {ForwBack} {
    list [catch {.t index {1.3 + 3 lines}} msg] $msg
} {0 4.3}
test textIndex-10.6 {ForwBack} {
    list [catch {.t index {2.3 -1l}} msg] $msg
} {0 1.3}
test textIndex-10.7 {ForwBack} {
    list [catch {.t index {2.3 -1 gorp}} msg] $msg
} {1 {bad text index "2.3 -1 gorp"}}
test textIndex-10.8 {ForwBack} {
    list [catch {.t index {2.3 - 4 lines}} msg] $msg
} {0 1.3}
test textIndex-10.9 {ForwBack} {
    .t mark set insert 2.0
    list [catch {.t index {insert -0 chars}} msg] $msg
} {0 2.0}
test textIndex-10.10 {ForwBack} {
    .t mark set insert 2.end
    list [catch {.t index {insert +0 chars}} msg] $msg
} {0 2.13}

test textIndex-11.1 {TkTextIndexForwBytes} {testtext} {
    testtext .t forwbytes 2.3 -7
} {1.3 3}
test textIndex-11.2 {TkTextIndexForwBytes} {testtext} {
    testtext .t forwbytes 2.3 5
} {2.8 8}
test textIndex-11.3 {TkTextIndexForwBytes} {testtext} {
    testtext .t forwbytes 2.3 10
} {2.13 13}
test textIndex-11.4 {TkTextIndexForwBytes} {testtext} {
    testtext .t forwbytes 2.3 11
} {3.0 0}
test textIndex-11.5 {TkTextIndexForwBytes} {testtext} {
    testtext .t forwbytes 2.3 57
} {7.6 6}
test textIndex-11.6 {TkTextIndexForwBytes} {testtext} {
    testtext .t forwbytes 2.3 58
} {8.0 0}
test textIndex-11.7 {TkTextIndexForwBytes} {testtext} {
    testtext .t forwbytes 2.3 59
} {8.0 0}

test textIndex-12.1 {TkTextIndexForwChars} {
    # (charCount < 0)
    .t index {2.3 + -7 chars}
} 1.3
test textIndex-12.2 {TkTextIndexForwChars} {
    # not (charCount < 0)
    .t index {2.3 + 5 chars}
} 2.8
test textIndex-12.3 {TkTextIndexForwChars: find index} {
    # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr)
    # one loop
    .t index {2.3 + 9 chars}
} 2.12
test textIndex-12.4 {TkTextIndexForwChars: find index} {
    # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr)
    # multiple loops
    .t mark set foo 2.5
    set x [.t index {2.3 + 9 chars}]
    .t mark unset foo
    set x
} 2.12
test textIndex-12.5 {TkTextIndexForwChars: find index} {
    # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr)
    # border condition: last char

    .t index {2.3 + 10 chars}
} 2.13
test textIndex-12.6 {TkTextIndexForwChars: find index} {
    # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr)
    # border condition: segPtr == NULL -> beginning of next line
    
    .t index {2.3 + 11 chars}
} 3.0
test textIndex-12.7 {TkTextIndexForwChars: find index} {
    # (segPtr->typePtr == &tkTextCharType)
    .t index {2.3 + 2 chars}
} 2.5
test textIndex-12.8 {TkTextIndexForwChars: find index} {
    # (charCount == 0)
    # No more chars, so we found byte offset.

    .t index {2.3 + 2 chars}
} 2.5
test textIndex-12.9 {TkTextIndexForwChars: find index} {
    # not (segPtr->typePtr == &tkTextCharType)

    .t image create 2.4 -image textimage
    set x [.t get {2.3 + 3 chars}]
    .t delete 2.4
    set x    
} "f"
test textIndex-12.10 {TkTextIndexForwChars: find index} {
    # dstPtr->byteIndex += segPtr->size - byteOffset
    # When moving to next segment, account for bytes in last segment.
    # Wrong answer would be 2.4

    .t mark set foo 2.4
    set x [.t index {2.3 + 5 chars}]
    .t mark unset foo
    set x
} 2.8
test textIndex-12.11 {TkTextIndexForwChars: go to next line} {
    # (linePtr == NULL)
    .t index {7.6 + 3 chars}
} 8.0
test textIndex-12.12 {TkTextIndexForwChars: go to next line} {
    # Reset byteIndex to 0 now that we are on a new line.
    # Wrong answer would be 2.9
    .t index {1.3 + 6 chars}
} 2.2
test textIndex-12.13 {TkTextIndexForwChars} {
    # right to end
    .t index {2.3 + 56 chars}
} 8.0
test textIndex-12.14 {TkTextIndexForwChars} {
    # try to go past end
    .t index {2.3 + 57 chars}
} 8.0

test textIndex-13.1 {TkTextIndexBackBytes} {testtext} {
    testtext .t backbytes 3.2 -10
} {4.6 6}
test textIndex-13.2 {TkTextIndexBackBytes} {testtext} {
    testtext .t backbytes 3.2 2
} {3.0 0}
test textIndex-13.3 {TkTextIndexBackBytes} {testtext} {
    testtext .t backbytes 3.2 3
} {2.13 13}
test textIndex-13.4 {TkTextIndexBackBytes} {testtext} {
    testtext .t backbytes 3.2 22
} {1.1 1}
test textIndex-13.5 {TkTextIndexBackBytes} {testtext} {
    testtext .t backbytes 3.2 23
} {1.0 0}
test textIndex-13.6 {TkTextIndexBackBytes} {testtext} {
    testtext .t backbytes 3.2 24
} {1.0 0}

test textIndex-14.1 {TkTextIndexBackChars} {
    # (charCount < 0)
    .t index {3.2 - -10 chars}
} 4.6
test textIndex-14.2 {TkTextIndexBackChars} {
    # not (charCount < 0)
    .t index {3.2 - 2 chars}
} 3.0
test textIndex-14.3 {TkTextIndexBackChars: find starting segment} {
    # for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
    # single loop

    .t index {3.2 - 3 chars}
} 2.13
test textIndex-14.4 {TkTextIndexBackChars: find starting segment} {
    # for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
    # multiple loop

    .t mark set foo1 2.5
    .t mark set foo2 2.7
    .t mark set foo3 2.10
    set x [.t index {2.9 - 1 chars}]
    .t mark unset foo1 foo2 foo3
    set x
} 2.8
test textIndex-14.5 {TkTextIndexBackChars: find starting seg and offset} {
    # for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
    # Make sure segSize was decremented.  Wrong answer would be 2.10

    .t mark set foo 2.2
    set x [.t index {2.9 - 1 char}]
    .t mark unset foo
    set x
} 2.8
test textIndex-14.6 {TkTextIndexBackChars: back over characters} {
    # (segPtr->typePtr == &tkTextCharType)

    .t index {3.2 - 22 chars}
} 1.1
test textIndex-14.7 {TkTextIndexBackChars: loop backwards over chars} {
    # (charCount == 0)
    # No more chars, so we found byte offset.

    .t index {3.4 - 2 chars}
} 3.2
test textIndex-14.8 {TkTextIndexBackChars: loop backwards over chars} {
    # (p == start)
    # Still more chars, but we reached beginning of segment

    .t image create 5.6 -image textimage
    set x [.t index {5.8 - 3 chars}]
    .t delete 5.6
    set x
} 5.5
test textIndex-14.9 {TkTextIndexBackChars: back over image} {
    # not (segPtr->typePtr == &tkTextCharType)

    .t image create 5.6 -image textimage
    set x [.t get {5.8 - 4 chars}]
    .t delete 5.6
    set x
} "G"
test textIndex-14.10 {TkTextIndexBackChars: move to previous segment} {
    # (segPtr != oldPtr)
    # More segments to go

    .t mark set foo 3.4
    set x [.t index {3.5 - 2 chars}]
    .t mark unset foo
    set x
} 3.3
test textIndex-14.11 {TkTextIndexBackChars: move to previous segment} {
    # not (segPtr != oldPtr)
    # At beginning of line.

    .t mark set foo 3.4
    set x [.t index {3.5 - 10 chars}]
    .t mark unset foo
    set x
} 2.9
test textIndex-14.12 {TkTextIndexBackChars: move to previous line} {
    # (lineIndex == 0) 
    .t index {1.5 - 10 chars}
} 1.0
test textIndex-14.13 {TkTextIndexBackChars: move to previous line} {
    # not (lineIndex == 0) 
    .t index {2.5 - 10 chars}
} 1.2
test textIndex-14.14 {TkTextIndexBackChars: move to previous line} {
    # for (segPtr = oldPtr; segPtr != NULL; segPtr = segPtr->nextPtr)
    # Set byteIndex to end of previous line so we can subtract more
    # bytes from it.  Otherwise we get an TkTextIndex with a negative
    # byteIndex.

    .t index {2.5 - 6 chars}
} 1.6
test textIndex-14.15 {TkTextIndexBackChars: UTF} {
    .t get {5.3 - 1 chars}
} y
test textIndex-14.16 {TkTextIndexBackChars: UTF} {
    .t get {5.3 - 2 chars}
} \u4e4f
test textIndex-14.17 {TkTextIndexBackChars: UTF} {
    .t get {5.3 - 3 chars}
} b

proc getword index {
    .t get [.t index "$index wordstart"] [.t index "$index wordend"]
}
test textIndex-15.1 {StartEnd} {
    list [catch {.t index {2.3 lineend}} msg] $msg
} {0 2.13}
test textIndex-15.2 {StartEnd} {
    list [catch {.t index {2.3 linee}} msg] $msg
} {0 2.13}
test textIndex-15.3 {StartEnd} {
    list [catch {.t index {2.3 line}} msg] $msg
} {1 {bad text index "2.3 line"}}
test textIndex-15.4 {StartEnd} {
    list [catch {.t index {2.3 linestart}} msg] $msg
} {0 2.0}
test textIndex-15.5 {StartEnd} {
    list [catch {.t index {2.3 lines}} msg] $msg
} {0 2.0}
test textIndex-15.6 {StartEnd} {
    getword 5.3
} { }
test textIndex-15.7 {StartEnd} {
    getword 5.4
} GIrl
test textIndex-15.8 {StartEnd} {
    getword 5.7
} GIrl
test textIndex-15.9 {StartEnd} {
    getword 5.8
} { }
test textIndex-15.10 {StartEnd} {
    getword 5.14
} x_yz
test textIndex-15.11 {StartEnd} {
    getword 6.2
} #
test textIndex-15.12 {StartEnd} {
    getword 3.4
} 12345
.t tag add x 2.8 2.11
test textIndex-15.13 {StartEnd} {
    list [catch {.t index {2.2 worde}} msg] $msg
} {0 2.13}
test textIndex-15.14 {StartEnd} {
    list [catch {.t index {2.12 words}} msg] $msg
} {0 2.0}
test textIndex-15.15 {StartEnd} {
    list [catch {.t index {2.12 word}} msg] $msg
} {1 {bad text index "2.12 word"}}

test testIndex-16.1 {TkTextPrintIndex} {
    set t [text .t2]
    $t insert end \n
    $t window create end -window [button $t.b]
    set result [$t index end-2c]
    pack $t
    catch {destroy $t}
} 0


test testIndex-16.2 {TkTextPrintIndex} {
    set t [text .t2]
    $t insert end \n
    $t window create end -window [button $t.b]
    set result [$t tag add {} end-2c]
    pack $t
    catch {destroy $t}
} 0

# cleanup
rename textimage {}
catch {destroy .t}
::tcltest::cleanupTests
return













Changes to tests/textMark.test.

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
# This file is a Tcl script to test the code in the file tkTextMark.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) textMark.test 1.8 97/10/20 11:13:00



if {[string compare test [info procs test]] == 1} then \
  {source defs}

catch {destroy .t}
if [catch {text .t -font {Courier 12} -width 20 -height 10}] {
    puts "The font needed by these tests isn't available, so I'm"
    puts "going to skip the tests."

    return
}
pack append . .t {top expand fill}
update
.t debug on
wm geometry . {}
  





>
>

<
<
>
|
<
>
>
|
<
<





>







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
# This file is a Tcl script to test the code in the file tkTextMark.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: textMark.test,v 1.1.4.6 1999/03/26 00:08:06 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}



catch {destroy .t}
if [catch {text .t -font {Courier 12} -width 20 -height 10}] {
    puts "The font needed by these tests isn't available, so I'm"
    puts "going to skip the tests."
    ::tcltest::cleanupTests
    return
}
pack append . .t {top expand fill}
update
.t debug on
wm geometry . {}
  
215
216
217
218
219
220
221
222
















test textMark-8.8 {MarkFindPrev - no previous mark} {
    .t mark set current 1.0
    .t mark set insert 3.0
    .t mark prev current
} {}

catch {destroy .t}
concat {}























|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
test textMark-8.8 {MarkFindPrev - no previous mark} {
    .t mark set current 1.0
    .t mark set insert 3.0
    .t mark prev current
} {}

catch {destroy .t}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/textTag.test.

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
# This file is a Tcl script to test the code in the file tkTextTag.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) textTag.test 1.30 97/11/06 16:57:02



if {[string compare test [info procs test]] == 1} then \
  {source defs}

catch {destroy .t}
if [catch {text .t -font {Courier 12} -width 20 -height 10}] {
    puts "The font needed by these tests isn't available, so I'm"
    puts "going to skip the tests."

    return
}
pack append . .t {top expand fill}
update
.t debug on
wm geometry . {}
set bigFont {Helvetica 24}





>
>

<
<
>
|
<
>
>
|
<
<





>







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
# This file is a Tcl script to test the code in the file tkTextTag.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: textTag.test,v 1.1.4.6 1999/03/26 00:08:06 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}



catch {destroy .t}
if [catch {text .t -font {Courier 12} -width 20 -height 10}] {
    puts "The font needed by these tests isn't available, so I'm"
    puts "going to skip the tests."
    ::tcltest::cleanupTests
    return
}
pack append . .t {top expand fill}
update
.t debug on
wm geometry . {}
set bigFont {Helvetica 24}
179
180
181
182
183
184
185
186







187
188
189
190
191
192
193
test textTag-3.7 {TkTextTagCmd - "bind" option} {
    .t tag delete x
    .t tag bind x <Enter> script1
    .t tag bind x <Enter> +script2
    .t tag bind x <Enter>
} {script1
script2}









test textTag-4.1 {TkTextTagCmd - "cget" option} {
    list [catch {.t tag cget a} msg] $msg
} {1 {wrong # args: should be ".t tag cget tagName option"}}
test textTag-4.2 {TkTextTagCmd - "cget" option} {
    list [catch {.t tag cget a b c} msg] $msg
} {1 {wrong # args: should be ".t tag cget tagName option"}}







|
>
>
>
>
>
>
>







180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
test textTag-3.7 {TkTextTagCmd - "bind" option} {
    .t tag delete x
    .t tag bind x <Enter> script1
    .t tag bind x <Enter> +script2
    .t tag bind x <Enter>
} {script1
script2}
test textTag-3.7 {TkTextTagCmd - "bind" option} {
    .t tag delete x
    list [catch {.t tag bind x <Enter>} msg] $msg
} {0 {}}
test textTag-3.8 {TkTextTagCmd - "bind" option} {
    .t tag delete x
    list [catch {.t tag bind x <} msg] $msg
} {1 {no event type or button # or keysym}}

test textTag-4.1 {TkTextTagCmd - "cget" option} {
    list [catch {.t tag cget a} msg] $msg
} {1 {wrong # args: should be ".t tag cget tagName option"}}
test textTag-4.2 {TkTextTagCmd - "cget" option} {
    list [catch {.t tag cget a b c} msg] $msg
} {1 {wrong # args: should be ".t tag cget tagName option"}}
749
750
751
752
753
754
755
756
















    .t tag bind a <Leave> {.t tag add big 3.0 3.2}
    .t tag add a 2.1
    event gen .t <Motion> -x $x2 -y $y2
    .t index current
} {3.1}

catch {destroy .t}
concat {}























|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
    .t tag bind a <Leave> {.t tag add big 3.0 3.2}
    .t tag add a 2.1
    event gen .t <Motion> -x $x2 -y $y2
    .t index current
} {3.1}

catch {destroy .t}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/textWind.test.

1
2
3
4
5


6
7
8

9
10


11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test the code in the file tkTextWind.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) textWind.test 1.25 97/07/01 18:16:38



if {[string compare test [info procs test]] == 1} then \
  {source defs}

foreach i [winfo child  .] {
    catch {destroy $i}
}


# Create entries in the option database to be sure that geometry options





>
>

<
<
>
|
<
>
>
|
<
<







1
2
3
4
5
6
7
8


9
10

11
12
13


14
15
16
17
18
19
20
# This file is a Tcl script to test the code in the file tkTextWind.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: textWind.test,v 1.1.4.4 1999/03/24 02:55:05 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}



foreach i [winfo child  .] {
    catch {destroy $i}
}


# Create entries in the option database to be sure that geometry options
820
821
822
823
824
825
826

















    update
    list [winfo ismapped .t.f] [.t bbox .t.f]
} {1 {47 5 30 20}}
pack .t

catch {destroy .t}
option clear
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
    update
    list [winfo ismapped .t.f] [.t bbox .t.f]
} {1 {47 5 30 20}}
pack .t

catch {destroy .t}
option clear

# cleanup
::tcltest::cleanupTests
return













Changes to tests/tk.test.

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
# This file is a Tcl script to test the tk command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) tk.test 1.3 97/05/20 15:17:44

if {[info commands test] == ""} {
    source defs
}

test tk-1.1 {tk command: general} {
    list [catch {tk} msg] $msg
} {1 {wrong # args: should be "tk option ?arg?"}}
test tk-1.2 {tk command: general} {
    list [catch {tk xyz} msg] $msg
} {1 {bad option "xyz": must be appname, or scaling}}

set appname [tk appname]
test tk-2.1 {tk command: appname} {
    list [catch {tk appname xyz abc} msg] $msg
} {1 {wrong # args: should be "tk appname ?newName?"}}
test tk-2.2 {tk command: appname} {
    tk appname foobazgarply




|
|
<

|

|
|







|







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
# This file is a Tcl script to test the tk command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: tk.test,v 1.1.4.5 1999/03/24 02:55:06 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test tk-1.1 {tk command: general} {
    list [catch {tk} msg] $msg
} {1 {wrong # args: should be "tk option ?arg?"}}
test tk-1.2 {tk command: general} {
    list [catch {tk xyz} msg] $msg
} {1 {bad option "xyz": must be appname or scaling}}

set appname [tk appname]
test tk-2.1 {tk command: appname} {
    list [catch {tk appname xyz abc} msg] $msg
} {1 {wrong # args: should be "tk appname ?newName?"}}
test tk-2.2 {tk command: appname} {
    tk appname foobazgarply
74
75
76
77
78
79
80

















    expr {int((25.4*[winfo screenwidth .])/(72*1.25)+0.5)-[winfo screenmmwidth .]}
} {0}
test tk-3.11 {tk command: scaling: heightmm} {
    tk scaling 1.25
    expr {int((25.4*[winfo screenheight .])/(72*1.25)+0.5)-[winfo screenmmheight .]}
} {0}
tk scaling $scaling
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
    expr {int((25.4*[winfo screenwidth .])/(72*1.25)+0.5)-[winfo screenmmwidth .]}
} {0}
test tk-3.11 {tk command: scaling: heightmm} {
    tk scaling 1.25
    expr {int((25.4*[winfo screenheight .])/(72*1.25)+0.5)-[winfo screenmmheight .]}
} {0}
tk scaling $scaling

# cleanup
::tcltest::cleanupTests
return













Changes to tests/unixButton.test.

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
# This file is a Tcl script to test the Unix specific behavior of
# labels, buttons, checkbuttons, and radiobuttons in Tk (i.e., all the
# widgets defined in tkUnixButton.c).  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) unixButton.test 1.6 97/07/01 18:11:30




if {$tcl_platform(platform)!="unix"} {


    return
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\""
    puts "image, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"

    return
}

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

# Create entries in the option database to be sure that geometry options







>
>

<
<
>
|
<
>
>
|
>

>
>







>



<
<
<
<







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
# This file is a Tcl script to test the Unix specific behavior of
# labels, buttons, checkbuttons, and radiobuttons in Tk (i.e., all the
# widgets defined in tkUnixButton.c).  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: unixButton.test,v 1.1.4.5 1999/03/26 00:08:07 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {$tcl_platform(platform)!="unix"} {
    puts "skipping: Unix only tests..."
    ::tcltest::cleanupTests
    return
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\""
    puts "image, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    ::tcltest::cleanupTests
    return
}





foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

# Create entries in the option database to be sure that geometry options
176
177
178
179
180
181
182

















test unixbutton-1.11 {TkpComputeButtonGeometry procedure} {
    eval destroy [winfo children .]
    button .b2 -bitmap question -default disabled
    list [winfo reqwidth .b2] [winfo reqheight .b2]
} {27 37}

eval destroy [winfo children .]
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
test unixbutton-1.11 {TkpComputeButtonGeometry procedure} {
    eval destroy [winfo children .]
    button .b2 -bitmap question -default disabled
    list [winfo reqwidth .b2] [winfo reqheight .b2]
} {27 37}

eval destroy [winfo children .]

# cleanup
::tcltest::cleanupTests
return













Changes to tests/unixEmbed.test.

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
# This file is a Tcl script to test out the procedures in the file 
# tkUnixEmbed.c.  It is organized in the standard fashion for Tcl
# tests.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) unixEmbed.test 1.7 97/08/13 11:13:21




if {$tcl_platform(platform) != "unix"} {


    return
}

if {[info procs test] != "test"} {
    source defs
}

eval destroy [winfo children .]
wm geometry . {}
raise .

setupbg
dobg {wm withdraw .}






>
>

<
<
>
|
<
>
>
|
>

>
>



<
<
<
<







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
# This file is a Tcl script to test out the procedures in the file 
# tkUnixEmbed.c.  It is organized in the standard fashion for Tcl
# tests.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: unixEmbed.test,v 1.1.4.7 1999/04/02 18:06:44 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {$tcl_platform(platform) != "unix"} {
    puts "skipping: Unix only tests..."
    ::tcltest::cleanupTests
    return
}





eval destroy [winfo children .]
wm geometry . {}
raise .

setupbg
dobg {wm withdraw .}

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
    catch {destroy .t}
    list [catch {toplevel .t -use xyz} msg] $msg
} {1 {expected integer but got "xyz"}}
test unixEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {
    catch {destroy .t}
    list [catch {toplevel .t -use 47} msg] $msg
} {1 {couldn't create child of window "47"}}
test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} {
    catch {destroy .t}
    catch {destroy .x}
    toplevel .t -colormap new
    wm geometry .t +0+0
    eatColors .t.t
    frame .t.f -container 1
    toplevel .x -use [winfo id .t.f]
    set result [colorsFree .x]
    destroy .t
    set result
} {0}
test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} {
    catch {destroy .t}
    catch {destroy .t2}
    catch {destroy .x}
    toplevel .t -container 1 -colormap new
    wm geometry .t +0+0
    eatColors .t2
    toplevel .x -use [winfo id .t]
    set result [colorsFree .x]
    destroy .t
    set result
} {1}









test unixEmbed-1.5 {TkpUseWindow procedure, creating Container records} {
    eval destroy [winfo child .]
    frame .f1 -container 1 -width 200 -height 50
    frame .f2 -container 1 -width 200 -height 50
    pack .f1 .f2
    dobg "set w [winfo id .f1]"
    dobg {







|











|











>
>
>
>
>
>
>
>
>







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
    catch {destroy .t}
    list [catch {toplevel .t -use xyz} msg] $msg
} {1 {expected integer but got "xyz"}}
test unixEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {
    catch {destroy .t}
    list [catch {toplevel .t -use 47} msg] $msg
} {1 {couldn't create child of window "47"}}
test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} {nonPortable} {
    catch {destroy .t}
    catch {destroy .x}
    toplevel .t -colormap new
    wm geometry .t +0+0
    eatColors .t.t
    frame .t.f -container 1
    toplevel .x -use [winfo id .t.f]
    set result [colorsFree .x]
    destroy .t
    set result
} {0}
test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} {nonPortable} {
    catch {destroy .t}
    catch {destroy .t2}
    catch {destroy .x}
    toplevel .t -container 1 -colormap new
    wm geometry .t +0+0
    eatColors .t2
    toplevel .x -use [winfo id .t]
    set result [colorsFree .x]
    destroy .t
    set result
} {1}

if {[string compare testembed [info commands testembed]] != 0} {
    puts "This application hasn't been compiled with the testembed command,"
    puts "therefore I am skipping all of these tests."
    cleanupbg
    ::tcltest::cleanupTests
    return
}

test unixEmbed-1.5 {TkpUseWindow procedure, creating Container records} {
    eval destroy [winfo child .]
    frame .f1 -container 1 -width 200 -height 50
    frame .f2 -container 1 -width 200 -height 50
    pack .f1 .f2
    dobg "set w [winfo id .f1]"
    dobg {
609
610
611
612
613
614
615
616
617
618
619
620















    toplevel .t1 -use [winfo id .f1] -width 150 -height 80
    update
    wm geometry .t1 70x300+10+20
    update
    wm geometry .t1
} {70x300+0+0}


foreach w [winfo child .] {
    catch {destroy $w}
}
cleanupbg






















|




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
    toplevel .t1 -use [winfo id .f1] -width 150 -height 80
    update
    wm geometry .t1 70x300+10+20
    update
    wm geometry .t1
} {70x300+0+0}

# cleanup
foreach w [winfo child .] {
    catch {destroy $w}
}
cleanupbg
::tcltest::cleanupTests
return













Changes to tests/unixFont.test.

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
# This file is a Tcl script to test out the procedures in tkUnixFont.c. 
# It is organized in the standard fashion for Tcl tests.
#
# Many of these tests are visually oriented and cannot be checked
# programmatically (such as "does an underlined font appear to be
# underlined?"); these tests attempt to exercise the code in question,
# but there are no results that can be checked.  Some tests depend on the
# fonts having or not having certain properties, which may not be valid
# at all sites.  
#
# Copyright (c) 1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) unixFont.test 1.7 97/06/24 13:34:24




if {$tcl_platform(platform)!="unix"} {


    return
}

if {[string compare test [info procs test]] != 0} {
    source defs
}

catch {destroy .b}
toplevel .b
wm geom .b +0+0
update idletasks

# Font should be fixed width and have chars missing below char 32, so can
# test control char expansion and missing character code.











>
>

<
<
>
|
<
>
>
|
>

>
>



<
<
<
<







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
# This file is a Tcl script to test out the procedures in tkUnixFont.c. 
# It is organized in the standard fashion for Tcl tests.
#
# Many of these tests are visually oriented and cannot be checked
# programmatically (such as "does an underlined font appear to be
# underlined?"); these tests attempt to exercise the code in question,
# but there are no results that can be checked.  Some tests depend on the
# fonts having or not having certain properties, which may not be valid
# at all sites.  
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: unixFont.test,v 1.1.4.8 1999/04/06 05:07:53 rjohnson Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {$tcl_platform(platform)!="unix"} {
    puts "skipping: Unix only tests..."
    ::tcltest::cleanupTests
    return
}





catch {destroy .b}
toplevel .b
wm geom .b +0+0
update idletasks

# Font should be fixed width and have chars missing below char 32, so can
# test control char expansion and missing character code.
218
219
220
221
222
223
224
225
226
227



228
229

230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
    button .c -font xyz
    font configure xyz -family times
    update
    destroy .c
    font delete xyz
} {}
test unixfont-8.2 {AllocFont procedure: parse information from XLFD} {
    expr [lindex [font actual {-family times -size 0}] 3]==0
} {0}
test unixfont-8.3 {AllocFont procedure: can't parse info from name} {



    if [catch {set a [font actual a12biluc]}]==0 {
	string compare $a "-family a12biluc -size 0 -weight normal -slant roman -underline 0 -overstrike 0"

    } else {
	set a 0
    }
} {0}
test unixfont-8.4 {AllocFont procedure: classify characters} {
    set x 0
    incr x [font measure $courier "\001"]   ;# 4
    incr x [font measure $courier "\002"]   ;# 4
    incr x [font measure $courier "\012"]   ;# 2
    incr x [font measure $courier "\101"]   ;# 1
    set x
} [expr $cx*11]
test unixfont-8.5 {AllocFont procedure: setup widths of normal chars} {
    font metrics $courier -fixed
} {1}
test unixfont-8.6 {AllocFont procedure: setup widths of special chars} {
    set x 0
    incr x [font measure $courier "\001"]   ;# 4
    incr x [font measure $courier "\002"]   ;# 4







|


>
>
>
|
<
>
|
|
<
|


|




|







219
220
221
222
223
224
225
226
227
228
229
230
231
232

233
234
235

236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
    button .c -font xyz
    font configure xyz -family times
    update
    destroy .c
    font delete xyz
} {}
test unixfont-8.2 {AllocFont procedure: parse information from XLFD} {
    expr {[lindex [font actual {-family times -size 0}] 3] == 0}
} {0}
test unixfont-8.3 {AllocFont procedure: can't parse info from name} {
    catch {unset fontArray}
    # check that font actual returns the correct attributes.
    # the values of those attributes are system dependent.
    array set fontArray [font actual a12biluc]

    set result [lsort [array names fontArray]]
    catch {unset fontArray}
    set result

} {-family -overstrike -size -slant -underline -weight}
test unixfont-8.4 {AllocFont procedure: classify characters} {
    set x 0
    incr x [font measure $courier "\u4000"]   ;# 6
    incr x [font measure $courier "\002"]   ;# 4
    incr x [font measure $courier "\012"]   ;# 2
    incr x [font measure $courier "\101"]   ;# 1
    set x
} [expr $cx*13]
test unixfont-8.5 {AllocFont procedure: setup widths of normal chars} {
    font metrics $courier -fixed
} {1}
test unixfont-8.6 {AllocFont procedure: setup widths of special chars} {
    set x 0
    incr x [font measure $courier "\001"]   ;# 4
    incr x [font measure $courier "\002"]   ;# 4
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
















    lappend x [.b.c index $t @[expr $ax*0],0]
    lappend x [.b.c index $t @[expr $ax*1],0]
    lappend x [.b.c index $t @[expr $ax*2],0]
    lappend x [.b.c index $t @[expr $ax*3],0]
} {0 1 1 2}
test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} {
    .b.c dchars $t 0 end
    .b.c insert $t 0 "0\1770"
    set x {}
    lappend x [.b.c index $t @[expr $ax*0],0]
    lappend x [.b.c index $t @[expr $ax*1],0]
    lappend x [.b.c index $t @[expr $ax*2],0]
    lappend x [.b.c index $t @[expr $ax*3],0]
    lappend x [.b.c index $t @[expr $ax*4],0]
    lappend x [.b.c index $t @[expr $ax*5],0]
} {0 1 1 1 1 2}
























|









>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
    lappend x [.b.c index $t @[expr $ax*0],0]
    lappend x [.b.c index $t @[expr $ax*1],0]
    lappend x [.b.c index $t @[expr $ax*2],0]
    lappend x [.b.c index $t @[expr $ax*3],0]
} {0 1 1 2}
test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} {
    .b.c dchars $t 0 end
    .b.c insert $t 0 "0\0010"
    set x {}
    lappend x [.b.c index $t @[expr $ax*0],0]
    lappend x [.b.c index $t @[expr $ax*1],0]
    lappend x [.b.c index $t @[expr $ax*2],0]
    lappend x [.b.c index $t @[expr $ax*3],0]
    lappend x [.b.c index $t @[expr $ax*4],0]
    lappend x [.b.c index $t @[expr $ax*5],0]
} {0 1 1 1 1 2}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/unixMenu.test.

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
# This file is a Tcl script to test menus in Tk.  It is
# organized in the standard fashion for Tcl tests. This
# file tests the Macintosh-specific features of the menu
# system.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) unixMenu.test 1.9 97/06/24 13:52:38




if {$tcl_platform(platform) != "unix"} {


    return
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"

    return
}

if {[info procs test] != "test"} {
    source defs
}

proc deleteWindows {} {
    foreach i [winfo children .] {
    	catch [destroy $i]
    }
}

deleteWindows






>
>

<
<
>
|
<
>
>
|
>

>
>







>



<
<
<
<







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
# This file is a Tcl script to test menus in Tk.  It is
# organized in the standard fashion for Tcl tests. This
# file tests the Macintosh-specific features of the menu
# system.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: unixMenu.test,v 1.1.4.6 1999/03/26 00:08:09 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {$tcl_platform(platform) != "unix"} {
    puts "skipping: Unix only tests..."
    ::tcltest::cleanupTests
    return
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    ::tcltest::cleanupTests
    return
}





proc deleteWindows {} {
    foreach i [winfo children .] {
    	catch [destroy $i]
    }
}

deleteWindows
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
test unixMenu-18.1 {GetTearoffEntryGeometry} {
    catch {destroy .m1}
    menubutton .mb -text "test" -menu .mb.m
    menu .mb.m
    .mb.m add command -label test
    pack .mb
    raise .
    list [catch {tkMbPost .mb} msg] $msg [destroy .mb]
} {0 {} {}}

# Don't know how to reproduce the case where the tkwin has been deleted.
test unixMenu-19.1 {TkpComputeMenubarGeometry - zero entries} {
    catch {destroy .m1}
    menu .m1
    . configure -menu .m1
    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]







|
|







330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
test unixMenu-18.1 {GetTearoffEntryGeometry} {
    catch {destroy .m1}
    menubutton .mb -text "test" -menu .mb.m
    menu .mb.m
    .mb.m add command -label test
    pack .mb
    raise .
    list [catch {tkMbPost .mb} msg] $msg [tkMenuUnpost .mb.m] [destroy .mb]
} {0 {} {} {}}

# Don't know how to reproduce the case where the tkwin has been deleted.
test unixMenu-19.1 {TkpComputeMenubarGeometry - zero entries} {
    catch {destroy .m1}
    menu .m1
    . configure -menu .m1
    list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} {
    catch {destroy .m1}
    menubutton .mb -text "test" -menu .mb.m
    menu .mb.m
    .mb.m add command -label test
    pack .mb
    catch {tkMbPost .mb}
    list [update] [destroy .mb]
} {{} {}}
test unixMenu-25.6 {TkpComputeStandardMenuGeometry - standard label geometry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [update idletasks] [destroy .m1]
} {{} {}}
test unixMenu-25.7 {TkpComputeStandardMenuGeometry - different font for entry} {







|
|







846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} {
    catch {destroy .m1}
    menubutton .mb -text "test" -menu .mb.m
    menu .mb.m
    .mb.m add command -label test
    pack .mb
    catch {tkMbPost .mb}
    list [update] [tkMenuUnpost .mb.m] [destroy .mb]
} {{} {} {}}
test unixMenu-25.6 {TkpComputeStandardMenuGeometry - standard label geometry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [update idletasks] [destroy .m1]
} {{} {}}
test unixMenu-25.7 {TkpComputeStandardMenuGeometry - different font for entry} {
962
963
964
965
966
967
968

969















    menu .m1 -tearoff 0
    .m1 add checkbutton -label one -hidemargin 1
    list [update idletasks] [destroy .m1]
} {{} {}}

test unixMenu-26.1 {TkpMenuInit - nothing to do} {} {}


deleteWindows






















>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
    menu .m1 -tearoff 0
    .m1 add checkbutton -label one -hidemargin 1
    list [update idletasks] [destroy .m1]
} {{} {}}

test unixMenu-26.1 {TkpMenuInit - nothing to do} {} {}

# cleanup
deleteWindows
::tcltest::cleanupTests
return













Added tests/unixSend.test.















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
# This file is a Tcl script to test out the "send" command and the
# other procedures in the file tkSend.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: unixSend.test,v 1.1.2.7 1999/04/05 18:36:05 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {$tcl_platform(platform) == "macintosh"} {
    puts "send is not available on the Mac - skipping tests"
    ::tcltest::cleanupTests
    return
}
if {$tcl_platform(platform) == "windows"} {
    puts "skipping: Unix only tests..."
    ::tcltest::cleanupTests
    return
}
if {[auto_execok xhost] == ""} {
    puts "xhost application isn't available - skipping tests"
    ::tcltest::cleanupTests
    return
}

if {[info commands testsend] == "testsend"} {
    set gotTestCmds 1
} else {
    set gotTestCmds 0
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

# If send is disabled because of inadequate security, don't run any
# of these tests at all.

setupbg
set app [dobg {tk appname}]
if {[catch {send $app set a 0} msg] == 1} {
    if [string match "X server insecure *" $msg] {
	puts -nonewline "Your X server is insecure, so \"send\" can't be used;"
	puts " skipping \"send\" tests."
	cleanupbg
	::tcltest::cleanupTests
	return
    }
}
cleanupbg

# Compute a script that will load Tk into a child interpreter.

foreach pkg [info loaded] {
    if {[lindex $pkg 1] == "Tk"} {
	set loadTk "load $pkg"
	break
    }
}

# Procedure to create a new application with a given name and class.

proc newApp {screen name class} {
    global loadTk
    interp create $name
    $name eval [list set argv [list -display $screen -name $name -class $class]]
    eval $loadTk $name
}

set name [tk appname]
if $gotTestCmds {
    set registry [testsend prop root InterpRegistry]
    set commId [lindex [testsend prop root InterpRegistry] 0]
}
tk appname tktest
catch {send t_s_1 destroy .}
catch {send t_s_2 destroy .}

if $gotTestCmds {
    test unixSend-1.1 {RegOpen procedure, bogus property} {
	testsend bogus
	set result [winfo interps]
	tk appname tktest
	list $result [winfo interps]
    } {{} tktest}
    test unixSend-1.2 {RegOpen procedure, bogus property} {
	testsend prop root InterpRegistry {}
	set result [winfo interps]
	tk appname tktest
	list $result [winfo interps]
    } {{} tktest}
    test unixSend-1.3 {RegOpen procedure, bogus property} {
	testsend prop root InterpRegistry abcdefg
	tk appname tktest
	set x [testsend prop root InterpRegistry]
	string range $x [string first " " $x] end
    } " tktest\nabcdefg\n"

    frame .f -width 1 -height 1
    set id [string range [winfo id .f] 2 end]
    test unixSend-2.1 {RegFindName procedure} {
	testsend prop root InterpRegistry {}
	list [catch {send foo bar} msg] $msg
    } {1 {no application named "foo"}}
    test unixSend-2.2 {RegFindName procedure} {
	testsend prop root InterpRegistry " abc\n def\nghi\n\n$id foo\n"
	tk appname foo
    } {foo #2}
    test unixSend-2.3 {RegFindName procedure} {
	testsend prop root InterpRegistry "gyz foo\n"
	tk appname foo
    } {foo}
    test unixSend-2.4 {RegFindName procedure} {
	testsend prop root InterpRegistry "${id}z foo\n"
	tk appname foo
    } {foo}

    test unixSend-3.1 {RegDeleteName procedure} {
	tk appname tktest
	testsend prop root InterpRegistry "012345 gorp\n12345 foo\n12345 tktest"
	tk appname x
	set x [testsend prop root InterpRegistry]
	string range $x [string first " " $x] end
    } " x\n012345 gorp\n12345 foo\n"
    test unixSend-3.2 {RegDeleteName procedure} {
	tk appname tktest
	testsend prop root InterpRegistry "012345 gorp\n12345 tktest\n23456 tktest"
	tk appname x
	set x [testsend prop root InterpRegistry]
	string range $x [string first " " $x] end
    } " x\n012345 gorp\n23456 tktest\n"
    test unixSend-3.3 {RegDeleteName procedure} {
	tk appname tktest
	testsend prop root InterpRegistry "012345 tktest\n12345 bar\n23456 tktest"
	tk appname x
	set x [testsend prop root InterpRegistry]
	string range $x [string first " " $x] end
    } " x\n12345 bar\n23456 tktest\n"
    test unixSend-3.4 {RegDeleteName procedure} {
	tk appname tktest
	testsend prop root InterpRegistry "foo"
	tk appname x
	set x [testsend prop root InterpRegistry]
	string range $x [string first " " $x] end
    } " x\nfoo\n"
    test unixSend-3.5 {RegDeleteName procedure} {
	tk appname tktest
	testsend prop root InterpRegistry ""
	tk appname x
	set x [testsend prop root InterpRegistry]
	string range $x [string first " " $x] end
    } " x\n"

    test unixSend-4.1 {RegAddName procedure} {
	testsend prop root InterpRegistry ""
	tk appname bar
	testsend prop root InterpRegistry
    } "$commId bar\n"
    test unixSend-4.2 {RegAddName procedure} {
	testsend prop root InterpRegistry "abc def"
	tk appname bar
	tk appname foo
	testsend prop root InterpRegistry
    } "$commId foo\nabc def\n"

    # Previous checks should already cover the Regclose procedure.

    test unixSend-5.1 {ValidateName procedure} {
	testsend prop root InterpRegistry "123 abc\n"
	winfo interps
    } {}
    test unixSend-5.2 {ValidateName procedure} {
	testsend prop root InterpRegistry "$id Hi there"
	winfo interps
    } {{Hi there}}
    test unixSend-5.3 {ValidateName procedure} {
	testsend prop root InterpRegistry "$id Bogus"
	list [catch {send Bogus set a 44} msg] $msg
    } {1 {target application died or uses a Tk version before 4.0}}
    test unixSend-5.4 {ValidateName procedure} {
	tk appname test
	testsend prop root InterpRegistry "$commId Bogus\n$commId test\n"
	winfo interps
    } {test}
}

winfo interps
tk appname tktest
update
setupbg
set x [split [exec xhost] \n]
foreach i [lrange $x 1 end]  {
    exec xhost - $i
}
test unixSend-6.1 {ServerSecure procedure} {nonPortable} {
    set a 44
    list [dobg [list send [tk appname] set a 55]] $a
} {55 55}
test unixSend-6.2 {ServerSecure procedure} {nonPortable} {
    set a 22
    exec xhost [exec hostname]
    list [catch {dobg [list send [tk appname] set a 33]} msg] $a $msg
} {0 22 {X server insecure (must use xauth-style authorization); command ignored}}
test unixSend-6.3 {ServerSecure procedure} {nonPortable} {
    set a abc
    exec xhost - [exec hostname]
    list [dobg [list send [tk appname] set a new]] $a
} {new new}
cleanupbg

if $gotTestCmds {
    test unixSend-7.1 {Tk_SetAppName procedure} {
	testsend prop root InterpRegistry ""
	tk appname newName
	list [tk appname oldName] [testsend prop root InterpRegistry]
    } "oldName {$commId oldName\n}"
    test unixSend-7.2 {Tk_SetAppName procedure, name not in use} {
	testsend prop root InterpRegistry ""
	list [tk appname gorp] [testsend prop root InterpRegistry]
    } "gorp {$commId gorp\n}"
    test unixSend-7.3 {Tk_SetAppName procedure, name in use by us} {
	tk appname name1
	testsend prop root InterpRegistry "$commId name2\n"
	list [tk appname name2] [testsend prop root InterpRegistry]
    } "name2 {$commId name2\n}"
    test unixSend-7.4 {Tk_SetAppName procedure, name in use} {
	tk appname name1
	testsend prop root InterpRegistry "$id foo\n$id foo #2\n$id foo #3\n"
	list [tk appname foo] [testsend prop root InterpRegistry]
    } "{foo #4} {$commId foo #4\n$id foo\n$id foo #2\n$id foo #3\n}"
}

test unixSend-8.1 {Tk_SendCmd procedure, options} {
    setupbg
    set app [dobg {tk appname}]
    set a 66
    send -async $app [list send [tk appname] set a 77]
    set result $a
    after 200 set x 40
    tkwait variable x
    cleanupbg
    lappend result $a
} {66 77}
if [info exists env(TK_ALT_DISPLAY)] {
    test unixSend-8.2 {Tk_SendCmd procedure, options} {
	setupbg -display $env(TK_ALT_DISPLAY)
	tk appname xyzgorp
	set a homeDisplay
	set result [dobg "
	    toplevel .t -screen [winfo screen .]
	    wm geometry .t +0+0
	    set a altDisplay
	    tk appname xyzgorp
	    list \[send xyzgorp set a\] \[send -displayof .t xyzgorp set a\]
	"]
	cleanupbg
	set result
    } {altDisplay homeDisplay}
}
test unixSend-8.3 {Tk_SendCmd procedure, options} {
    list [catch {send -- -async foo bar baz} msg] $msg
} {1 {no application named "-async"}}
test unixSend-8.4 {Tk_SendCmd procedure, options} {
    list [catch {send -gorp foo bar baz} msg] $msg
} {1 {bad option "-gorp": must be -async, -displayof, or --}}
test unixSend-8.5 {Tk_SendCmd procedure, options} {
    list [catch {send -async foo} msg] $msg
} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
test unixSend-8.6 {Tk_SendCmd procedure, options} {
    list [catch {send foo} msg] $msg
} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
test unixSend-8.7 {Tk_SendCmd procedure, local execution} {
    set a initial
    send [tk appname] {set a new}
    set a
} {new}
test unixSend-8.8 {Tk_SendCmd procedure, local execution} {
    set a initial
    send [tk appname] set a new
    set a
} {new}
test unixSend-8.9 {Tk_SendCmd procedure, local execution} {
    set a initial
    string tolower [list [catch {send [tk appname] open bad_file} msg] \
	    $msg $errorInfo $errorCode]
} {1 {couldn't open "bad_file": no such file or directory} {couldn't open "bad_file": no such file or directory
    while executing
"open bad_file"
    invoked from within
"send [tk appname] open bad_file"} {posix enoent {no such file or directory}}}
test unixSend-8.10 {Tk_SendCmd procedure, no such interpreter} {
    list [catch {send bogus_name bogus_command} msg] $msg
} {1 {no application named "bogus_name"}}
if $gotTestCmds {
    newApp "" t_s_1 Test
    t_s_1 eval wm withdraw .
    test unixSend-8.11 {Tk_SendCmd procedure, local execution, different interp} {
	set a us
	send t_s_1 set a them
	list $a [send t_s_1 set a]
    } {us them}
    test unixSend-8.12 {Tk_SendCmd procedure, local execution, different interp} {
	set a us
	send t_s_1 {set a them}
	list $a [send t_s_1 {set a}]
    } {us them}
    test unixSend-8.13 {Tk_SendCmd procedure, local execution, different interp} {
	set a us
	send t_s_1 {set a them}
	list $a [send t_s_1 {set a}]
    } {us them}
    test unixSend-8.14 {Tk_SendCmd procedure, local interp killed by send} {
	newApp "" t_s_2 Test
	list [catch {send t_s_2 {destroy .; concat result}} msg] $msg
    } {0 result}
    interp delete t_s_2
    test unixSend-8.15 {Tk_SendCmd procedure, local interp, error info} {
	catch {error foo}
	list [catch {send t_s_1 {if 1 {open bogus_file_name}}} msg] $msg $errorInfo $errorCode
    } {1 {couldn't open "bogus_file_name": no such file or directory} {couldn't open "bogus_file_name": no such file or directory
    while executing
"open bogus_file_name"
    invoked from within
"if 1 {open bogus_file_name}"
    invoked from within
"send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}}
    test unixSend-8.16 {Tk_SendCmd procedure, bogusCommWindow} {
	testsend prop root InterpRegistry "10234 bogus\n"
	set result [list [catch {send bogus bogus command} msg] $msg]
	winfo interps
	tk appname tktest
	set result
    } {1 {no application named "bogus"}}
    interp delete t_s_1
}
test unixSend-8.17 {Tk_SendCmd procedure, deferring events} {nonPortable} {
    # Non-portable because some window managers ignore "raise"
    # requests so can't guarantee that new app's window won't
    # obscure .f, thereby masking the Expose event.

    setupbg
    set app [dobg {tk appname}]
    raise .		; # Don't want new app obscuring .f
    catch {destroy .f}
    frame .f
    place .f -x 0 -y 0
    bind .f <Expose> {set a exposed}
    set a {no event yet}
    set result ""
    lappend result [send $app send [list [tk appname]] set a]
    lappend result $a
    update
    cleanupbg
    lappend result $a
} {{no event yet} {no event yet} exposed}
test unixSend-8.18 {Tk_SendCmd procedure, error in remote app} {
    setupbg
    set app [dobg {tk appname}]
    set result [string tolower [list [catch {send $app open bad_name} msg] \
	    $msg $errorInfo $errorCode]]
    cleanupbg
    set result
} {1 {couldn't open "bad_name": no such file or directory} {couldn't open "bad_name": no such file or directory
    while executing
"open bad_name"
    invoked from within
"send $app open bad_name"} {posix enoent {no such file or directory}}}
test unixSend-8.19 {Tk_SendCmd, using modal timeouts} {
    setupbg
    set app [dobg {tk appname}]
    set x no
    set result ""
    after 0 {set x yes}
    lappend result [send $app {concat x y z}]
    lappend result $x
    update
    cleanupbg
    lappend result $x
} {{x y z} no yes}

tk appname tktest
catch {destroy .f}
frame .f
set id [string range [winfo id .f] 2 end]
if $gotTestCmds {
    test unixSend-9.1 {Tk_GetInterpNames procedure} {
	testsend prop root InterpRegistry \
		"$commId tktest\nfoo bar\n$commId tktest\n$id frame .f\n\n\n"
	list [winfo interps] [testsend prop root InterpRegistry]
    } "{tktest tktest {frame .f}} {$commId tktest\n$commId tktest\n$id frame .f
}"
    test unixSend-9.2 {Tk_GetInterpNames procedure} {
	testsend prop root InterpRegistry \
		"$commId tktest\nfoobar\n$commId gorp\n"
	list [winfo interps] [testsend prop root InterpRegistry]
    } "tktest {$commId tktest\n}"
    test unixSend-9.3 {Tk_GetInterpNames procedure} {
	testsend prop root InterpRegistry {}
	list [winfo interps] [testsend prop root InterpRegistry]
    } {{} {}}

    testsend prop root InterpRegistry "$commId tktest\n$id dummy\n"
    test unixSend-10.1 {SendEventProc procedure, bogus comm property} {
	testsend prop comm Comm {abc def}
	testsend prop comm Comm {}
	update
    } {}
    test unixSend-10.2 {SendEventProc procedure, simultaneous messages} {
	testsend prop comm Comm \
		"c\n-n tktest\n-s set a 44\nc\n-n tktest\n-s set b 45\n"
	set a null
	set b xyzzy
	update
	list $a $b
    } {44 45}
    test unixSend-10.3 {SendEventProc procedure, simultaneous messages} {
	testsend prop comm Comm \
		"c\n-n tktest\n-s set a newA\nr\n-s [testsend serial]\n-r 12345\nc\n-n tktest\n-s set b newB\n"
	set a null
	set b xyzzy
	set x [send dummy bogus]
	list $x $a $b
    } {12345 newA newB}
    test unixSend-10.4 {SendEventProc procedure, leading nulls, bogus commands} {
	testsend prop comm Comm \
		"\n\nx\n-bogus\n\nc\n-n tktest\n-s set a 44\n"
	set a null
	update
	set a
    } {44}
    test unixSend-10.5 {SendEventProc procedure, extraneous command options} {
	testsend prop comm Comm \
		"c\n-n tktest\n-x miscellanous\n-y who knows?\n-s set a new\n"
	set a null
	update
	set a
    } {new}
    test unixSend-10.6 {SendEventProc procedure, unknown interpreter} {
	testsend prop [winfo id .f] Comm {}
	testsend prop comm Comm \
		"c\n-n unknown\n-r $id 44\n-s set a new\n"
	set a null
	update
	list [testsend prop [winfo id .f] Comm] $a
    } "{\nr\n-s 44\n-r receiver never heard of interpreter \"unknown\"\n-c 1\n} null"
    test unixSend-10.7 {SendEventProc procedure, error in script} {
	testsend prop [winfo id .f] Comm {}
	testsend prop comm Comm \
		"c\n-n tktest\n-r $id 62\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n"
	update
	testsend prop [winfo id .f] Comm
    } {
r
-s 62
-r test error
-i Initial errorInfo
    ("foreach" body line 1)
    invoked from within
"foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}"
-e test code
-c 1
}
    test unixSend-10.8 {SendEventProc procedure, exceptional return} {
	testsend prop [winfo id .f] Comm {}
	testsend prop comm Comm \
		"c\n-n tktest\n-r $id 62\n-s break\n"
	update
	testsend prop [winfo id .f] Comm
    } {
r
-s 62
-r 
-c 3
}
    test unixSend-10.9 {SendEventProc procedure, empty return} {
	testsend prop [winfo id .f] Comm {}
	testsend prop comm Comm \
		"c\n-n tktest\n-r $id 62\n-s concat\n"
	update
	testsend prop [winfo id .f] Comm
    } {
r
-s 62
-r 
}
    test unixSend-10.10 {SendEventProc procedure, asynchronous calls} {
	testsend prop [winfo id .f] Comm {}
	testsend prop comm Comm \
		"c\n-n tktest\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n"
	update
	testsend prop [winfo id .f] Comm
    } {}
    test unixSend-10.11 {SendEventProc procedure, exceptional return} {
	testsend prop [winfo id .f] Comm {}
	testsend prop comm Comm \
		"c\n-n tktest\n-s break\n"
	update
	testsend prop [winfo id .f] Comm
    } {}
    test unixSend-10.12 {SendEventProc procedure, empty return} {
	testsend prop [winfo id .f] Comm {}
	testsend prop comm Comm \
		"c\n-n tktest\n-s concat\n"
	update
	testsend prop [winfo id .f] Comm
    } {}
    test unixSend-10.13 {SendEventProc procedure, return processing} {
	testsend prop comm Comm \
		"r\n-c 1\n-e test1\n-i test2\n-r test3\n-s [testsend serial]\n"
	list [catch {send dummy foo} msg] $msg $errorInfo $errorCode
    } {1 test3 {test2
    invoked from within
"send dummy foo"} test1}
    test unixSend-10.14 {SendEventProc procedure, extraneous return options} {
	testsend prop comm Comm \
		"r\n-x test1\n-y test2\n-r result\n-s [testsend serial]\n"
	list [catch {send dummy foo} msg] $msg
    } {0 result}
    test unixSend-10.15 {SendEventProc procedure, serial number} {
	testsend prop comm Comm \
		"r\n-r response\n"
	list [catch {send dummy foo} msg] $msg
    } {1 {target application died or uses a Tk version before 4.0}}
    test unixSend-10.16 {SendEventProc procedure, serial number} {
	testsend prop comm Comm \
		"r\n-r response\n\n-s 0"
	list [catch {send dummy foo} msg] $msg
    } {1 {target application died or uses a Tk version before 4.0}}
    test unixSend-10.17 {SendEventProc procedure, errorCode and errorInfo} {
	testsend prop comm Comm \
		"r\n-i test1\n-e test2\n-c 4\n-s [testsend serial]\n"
	set errorCode oldErrorCode
	set errorInfo oldErrorInfo
	list [catch {send dummy foo} msg] $msg $errorInfo $errorCode
    } {4 {} oldErrorInfo oldErrorCode}
    test unixSend-10.18 {SendEventProc procedure, send kills application} {
	setupbg
	dobg {tk appname t_s_3}
	set x [list [catch {send t_s_3 destroy .} msg] $msg]
	cleanupbg
	set x
    } {0 {}}
    test unixSend-10.19 {SendEventProc procedure, send exits} {
	setupbg
	dobg {tk appname t_s_3}
	set x [list [catch {send t_s_3 exit} msg] $msg]
	close $::tcltest::fd
	set x
    } {1 {target application died}}

    test unixSend-11.1 {AppendPropCarefully and AppendErrorProc procedures} {
	testsend prop root InterpRegistry "0x21447 dummy\n"
	list [catch {send dummy foo} msg] $msg
    } {1 {no application named "dummy"}}
    test unixSend-11.2 {AppendPropCarefully and AppendErrorProc procedures} {
	testsend prop comm Comm "c\n-r0x123 44\n-n tktest\n-s concat a b c\n"
	update
    } {}
}

winfo interps
tk appname tktest
catch {destroy .f}
frame .f
set id [string range [winfo id .f] 2 end]
if $gotTestCmds {
    test unixSend-12.1 {TimeoutProc procedure} {
        testsend prop root InterpRegistry "$id dummy\n"
        list [catch {send dummy foo} msg] $msg
    } {1 {target application died or uses a Tk version before 4.0}}
    testsend prop root InterpRegistry ""
}
test unixSend-12.2 {TimeoutProc procedure} {
    winfo interps
    tk appname tktest
    update
    setupbg
    puts $::tcltest::fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
    set ::tcltest::bgDone 0
    set ::tcltest::bgData {}
    flush $::tcltest::fd
    tkwait variable ::tcltest::bgDone
    set app $::tcltest::bgData
    after 200
    set result [list [catch {send $app foo} msg] $msg]
    close $::tcltest::fd
    set result
} {1 {target application died}}

winfo interps
tk appname tktest
test unixSend-13.1 {DeleteProc procedure} {
    setupbg
    set app [dobg {rename send {}; tk appname}]
    set result [list [catch {send $app foo} msg] $msg [winfo interps]]
    cleanupbg
    set result
} {1 {no application named "tktest #2"} tktest}
test unixSend-13.2 {DeleteProc procedure} {
    winfo interps
    tk appname tktest
    rename send {}
    set result {}
    lappend result [winfo interps] [info commands send]
    tk appname foo
    lappend result [winfo interps] [info commands send]
} {{} {} foo send}

if [info exists env(TK_ALT_DISPLAY)] {
    test unixSend-14.1 {SendRestrictProc procedure, sends crossing from different displays} {
	setupbg -display $env(TK_ALT_DISPLAY)
	set result [dobg "
	    toplevel .t -screen [winfo screen .]
	    wm geometry .t +0+0
	    tk appname xyzgorp1
	    set x child
	"]
	toplevel .t -screen $env(TK_ALT_DISPLAY)
	wm geometry .t +0+0
	tk appname xyzgorp2
	update
	set y parent
	set result [send -displayof .t xyzgorp1 {list $x [send -displayof .t xyzgorp2 set y]}]
	destroy .t
	cleanupbg
	set result
    } {child parent}
}

if $gotTestCmds {
    testsend prop root InterpRegister $registry
    tk appname tktest
    test unixSend-15.1 {UpdateCommWindow procedure} {
	set x [list [testsend prop comm TK_APPLICATION]]
	newApp "" t_s_1 Test
	send t_s_1 wm withdraw .
	newApp "" t_s_2 Test
	send t_s_2 wm withdraw .
	lappend x [testsend prop comm TK_APPLICATION]
	interp delete t_s_1
	lappend x [testsend prop comm TK_APPLICATION]
	interp delete t_s_2
	lappend x [testsend prop comm TK_APPLICATION]
    } {tktest {t_s_2 t_s_1 tktest} {t_s_2 tktest} tktest}
}

tk appname $name
if $gotTestCmds {
    testsend prop root InterpRegistry $registry
}
if $gotTestCmds {
    testdeleteapps
}
rename newApp {}

# cleanup
::tcltest::cleanupTests
return













Changes to tests/unixWm.test.

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
# This file is a Tcl script to test out Tk's interactions with
# the window manager, including the "wm" command.  It is organized
# in the standard fashion for Tcl tests.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) unixWm.test 1.46 97/10/27 16:15:36




if {$tcl_platform(platform) != "unix"} {


    return
}

if {[string compare test [info procs test]] == 1} {
    source defs
}

proc sleep ms {
    global x
    after $ms {set x 1}
    vwait x
}

# Procedure to set up a collection of top-level windows






>
>

<
<
>
|
<
>
>
|
>

>
>



<
<
<
<







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
# This file is a Tcl script to test out Tk's interactions with
# the window manager, including the "wm" command.  It is organized
# in the standard fashion for Tcl tests.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: unixWm.test,v 1.1.4.10 1999/04/07 02:16:37 surles Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {$tcl_platform(platform) != "unix"} {
    puts "skipping: Unix only tests..."
    ::tcltest::cleanupTests
    return
}





proc sleep ms {
    global x
    after $ms {set x 1}
    vwait x
}

# Procedure to set up a collection of top-level windows
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
test unixWm-6.3 {size changes} {
    wm geom .t 250x60
    .t config -width 170 -height 140
    wm geom .t {}
    update
    wm geom .t
} 170x140+10+10
test unixWm-6.4 {size changes} {nonPortable} {
    wm minsize .t 1 1
    update
    puts stdout "Please resize window \"t\" with the mouse (but don't move it!),"
    puts -nonewline stdout "then hit return: "
    flush stdout
    gets stdin
    update







|







192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
test unixWm-6.3 {size changes} {
    wm geom .t 250x60
    .t config -width 170 -height 140
    wm geom .t {}
    update
    wm geom .t
} 170x140+10+10
test unixWm-6.4 {size changes} {nonPortable userInteraction} {
    wm minsize .t 1 1
    update
    puts stdout "Please resize window \"t\" with the mouse (but don't move it!),"
    puts -nonewline stdout "then hit return: "
    flush stdout
    gets stdin
    update
347
348
349
350
351
352
353







354
355
356
357
358
359
360
    wm geom .icon +0+0
    update
    lappend result [winfo ismapped .icon] [wm state .icon]
    wm deiconify .icon
    update
    lappend result [winfo ismapped .icon] [wm state .icon]
} {icon 1 0 0 withdrawn 1 normal}








test unixWm-9.1 {TkWmMapWindow procedure, client property} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 100 -height 50
    wm geom .t +0+0
    wm client .t Test_String
    update







>
>
>
>
>
>
>







348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
    wm geom .icon +0+0
    update
    lappend result [winfo ismapped .icon] [wm state .icon]
    wm deiconify .icon
    update
    lappend result [winfo ismapped .icon] [wm state .icon]
} {icon 1 0 0 withdrawn 1 normal}

if {[string compare testwrapper [info commands testwrapper]] != 0} {
    puts "This application hasn't been compiled with the testwrapper command,"
    puts "therefore I am skipping all of these tests."
    ::tcltest::cleanupTests
    return
}

test unixWm-9.1 {TkWmMapWindow procedure, client property} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 100 -height 50
    wm geom .t +0+0
    wm client .t Test_String
    update
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
    tkwait visibility .t
    set result {}
    lappend result [winfo width .t] [winfo height .t]
    .t configure -width 200 -height 300
    sleep 500
    lappend result [winfo width .t] [winfo height .t]
} {400 150 200 300}
test unixWm-41.2 {ConfigureEvent procedure, menubars} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    wm geom .t +0+0
    update
    set x [winfo rootx .t]
    set y [winfo rooty .t]
    frame .t.m -bd 2 -relief raised -height 20







|







1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
    tkwait visibility .t
    set result {}
    lappend result [winfo width .t] [winfo height .t]
    .t configure -width 200 -height 300
    sleep 500
    lappend result [winfo width .t] [winfo height .t]
} {400 150 200 300}
test unixWm-41.2 {ConfigureEvent procedure, menubars} {nonPortable} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    wm geom .t +0+0
    update
    set x [winfo rootx .t]
    set y [winfo rooty .t]
    frame .t.m -bd 2 -relief raised -height 20
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472

1473
1474
1475
1476
1477
1478
1479
1480

1481
1482
1483
1484
1485


1486
1487
1488
1489
1490
1491
1492
    wm geometry .t +30+40
    wm overrideredirect .t 1
    tkwait visibility .t
    wm geometry .t 20x1
    update
    list [winfo width .t] [winfo height .t]
} {100 1}
test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60

    wm geometry .t +5-10
    wm overrideredirect .t 1
    tkwait visibility .t
    list [winfo x .t] [winfo y .t]
} "5 [expr [winfo screenheight .t] - 70]"
test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60

    wm geometry .t -30+2
    wm overrideredirect .t 1
    tkwait visibility .t
    list [winfo x .t] [winfo y .t]
} "[expr [winfo screenwidth .t] - 110] 2"


test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm resizable .t 0 0
    wm geometry .t +0+0
    tkwait visibility .t
    .t configure  -width 180 -height 20







|
|
|
>




|
|
|
|
>




|
>
>







1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
    wm geometry .t +30+40
    wm overrideredirect .t 1
    tkwait visibility .t
    wm geometry .t 20x1
    update
    list [winfo width .t] [winfo height .t]
} {100 1}

catch {destroy .t}
toplevel .t -width 80 -height 60
test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} {
    wm geometry .t +5-10
    wm overrideredirect .t 1
    tkwait visibility .t
    list [winfo x .t] [winfo y .t]
} [list 5 [expr [winfo screenheight .t] - 70]]

catch {destroy .t}
toplevel .t -width 80 -height 60
test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} {
    wm geometry .t -30+2
    wm overrideredirect .t 1
    tkwait visibility .t
    list [winfo x .t] [winfo y .t]
} [list [expr [winfo screenwidth .t] - 110] 2]
catch {destroy .t}

test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm resizable .t 0 0
    wm geometry .t +0+0
    tkwait visibility .t
    .t configure  -width 180 -height 20
2280
2281
2282
2283
2284
2285
2286































2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
    testmenubar window .t .t.f
    update
    set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]"
    .t.f configure -height 0
    update
    lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
} {0 20 0 1}
































# Test exit processing and cleanup:

test unixWm-58.1 {exit processing} {
    catch {removeFile script}
    set fd [open script w]
    puts $fd {
	update
	exit
    }
    close $fd
    if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
	set error 1
    } else {
	set error 0
    }
    list $error $msg
} {0 {}}
test unixWm-58.2 {exit processing} {
    catch {removeFile script}
    set fd [open script w]
    puts $fd {
	interp create x
	x eval {set argc 2}
	x eval {set argv "-geometry 10x10+0+0"}
	x eval {load {} Tk}
	update
	exit
    }
    close $fd
    if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
	set error 1
    } else {
	set error 0
    }
    list $error $msg
} {0 {}}
test unixWm-58.3 {exit processing} {







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











|


















|







2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
    testmenubar window .t .t.f
    update
    set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]"
    .t.f configure -height 0
    update
    lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
} {0 20 0 1}

test unixWm-58.1 {UpdateCommand procedure, DString gets reallocated} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 100 -height 50
    wm geom .t +0+0
    wm command .t "argumentNumber0 argumentNumber1 argumentNumber2 argumentNumber0 argumentNumber3 argumentNumber4 argumentNumber5 argumentNumber6 argumentNumber0 argumentNumber7 argumentNumber8 argumentNumber9 argumentNumber10 argumentNumber0 argumentNumber11 argumentNumber12 argumentNumber13 argumentNumber14 argumentNumber15 argumentNumber16 argumentNumber17 argumentNumber18"
    update
    testprop [testwrapper .t] WM_COMMAND
} {argumentNumber0
argumentNumber1
argumentNumber2
argumentNumber0
argumentNumber3
argumentNumber4
argumentNumber5
argumentNumber6
argumentNumber0
argumentNumber7
argumentNumber8
argumentNumber9
argumentNumber10
argumentNumber0
argumentNumber11
argumentNumber12
argumentNumber13
argumentNumber14
argumentNumber15
argumentNumber16
argumentNumber17
argumentNumber18
}

# Test exit processing and cleanup:

test unixWm-58.1 {exit processing} {
    catch {removeFile script}
    set fd [open script w]
    puts $fd {
	update
	exit
    }
    close $fd
    if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} {
	set error 1
    } else {
	set error 0
    }
    list $error $msg
} {0 {}}
test unixWm-58.2 {exit processing} {
    catch {removeFile script}
    set fd [open script w]
    puts $fd {
	interp create x
	x eval {set argc 2}
	x eval {set argv "-geometry 10x10+0+0"}
	x eval {load {} Tk}
	update
	exit
    }
    close $fd
    if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} {
	set error 1
    } else {
	set error 0
    }
    list $error $msg
} {0 {}}
test unixWm-58.3 {exit processing} {
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351



2352












	}
	x alias foo destroy_x
	proc destroy_x {} {interp delete x}
	update
	exit
    }
    close $fd
    if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
	set error 1
    } else {
	set error 0
    }
    list $error $msg
} {0 {}}

    
catch {destroy .t}



concat {}



















|







|

>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
	}
	x alias foo destroy_x
	proc destroy_x {} {interp delete x}
	update
	exit
    }
    close $fd
    if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} {
	set error 1
    } else {
	set error 0
    }
    list $error $msg
} {0 {}}

# cleanup
catch {destroy .t}
catch {removeFile script}
::tcltest::cleanupTests
return













Changes to tests/util.test.

1
2
3
4
5


6
7
8

9
10


11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test out the procedures in the file
# tkUtil.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) util.test 1.4 96/02/16 10:55:50



if {[string compare test [info procs test]] == 1} then \
  {source defs}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .






>
>

<
<
>
|
<
>
>
|
<
<







1
2
3
4
5
6
7
8


9
10

11
12
13


14
15
16
17
18
19
20
# This file is a Tcl script to test out the procedures in the file
# tkUtil.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: util.test,v 1.1.4.4 1999/03/24 02:55:10 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}



foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

64
65
66
67
68
69
70

















} {13}
test util-1.11 {Tk_GetScrollInfo procedure} {
    list [catch {.l yview scroll 3 zips} msg] $msg
} {1 {bad argument "zips": must be units or pages}}
test util-1.12 {Tk_GetScrollInfo procedure} {
    list [catch {.l yview dropdead 3 times} msg] $msg
} {1 {unknown option "dropdead": must be moveto or scroll}}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
} {13}
test util-1.11 {Tk_GetScrollInfo procedure} {
    list [catch {.l yview scroll 3 zips} msg] $msg
} {1 {bad argument "zips": must be units or pages}}
test util-1.12 {Tk_GetScrollInfo procedure} {
    list [catch {.l yview dropdead 3 times} msg] $msg
} {1 {unknown option "dropdead": must be moveto or scroll}}

# cleanup
::tcltest::cleanupTests
return













Deleted tests/visual.

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
#!/usr/local/bin/wish -f
#
# This script displays provides visual tests for many of Tk's features.
# Each test displays a window with various information in it, along
# with instructions about how the window should appear.  You can look
# at the window to make sure it appears as expected.  Individual tests
# are kept in separate ".tcl" files in this directory.
#
# SCCS: @(#) visual 1.5 97/06/13 16:37:29

set auto_path ". $auto_path"
wm title . "Visual Tests for Tk"

#-------------------------------------------------------
# The code below create the main window, consisting of a
# menu bar and a message explaining the basic operation
# of the program.
#-------------------------------------------------------

frame .menu -relief raised -borderwidth 1
message .msg -font {Times 18} -relief raised -width 4i \
	-borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit.  Each menu entry invokes a test, which displays information on the screen.  You can then verify visually that the information is being displayed in the correct way.  The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets."

pack .menu -side top -fill x
pack .msg -side bottom -expand yes -fill both

#-------------------------------------------------------
# The code below creates all the menus, which invoke procedures
# to create particular demonstrations of various widgets.
#-------------------------------------------------------

menubutton .menu.file -text "File" -menu .menu.file.m
menu .menu.file.m
.menu.file.m add command -label "Quit" -command exit

menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m
menu .menu.group1.m
.menu.group1.m add command -label "Canvas arcs" -command {source arc.tcl}
.menu.group1.m add command -label "Beveled borders in text widgets" \
	-command {source bevel.tcl}
.menu.group1.m add command -label "Colormap management" \
	-command {source cmap.tcl}
.menu.group1.m add command -label "Label/button geometry" \
	-command {source butGeom.tcl}
.menu.group1.m add command -label "Label/button colors" \
	-command {source butGeom2.tcl}

menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m
menu .menu.ps.m
.menu.ps.m add command -label "Rectangles and other graphics" \
	-command {source canvPsGrph.tcl}
.menu.ps.m add command -label "Text" \
	-command {source canvPsText.tcl}
.menu.ps.m add command -label "Bitmaps" \
	-command {source canvPsBmap.tcl}
.menu.ps.m add command -label "Arcs" \
	-command {source canvPsArc.tcl}

pack .menu.file .menu.group1 .menu.ps -side left -padx 1m

# Set up for keyboard-based menu traversal

bind . <Any-FocusIn> {
    if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {
	focus .menu
    }
}
tk_menuBar .menu .menu.file .menu.group1 .menu.ps

# The following procedure is invoked to print the contents of a canvas:

proc lpr c {
    exec rm -f tmp.ps
    $c postscript -file tmp.ps
    exec lpr tmp.ps
}

# Set up a class binding to allow objects to be deleted from a canvas
# by clicking with mouse button 1:

bind Canvas <1> {%W delete [%W find closest %x %y]}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


































































































































































Changes to tests/visual.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# This file is a Tcl script to test the visual- and colormap-handling
# procedures in the file tkVisual.c.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) visual.test 1.11 96/02/16 10:55:34

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .






|
|
<

|

|
|







1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
# This file is a Tcl script to test the visual- and colormap-handling
# procedures in the file tkVisual.c.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: visual.test,v 1.1.4.4 1999/03/24 02:55:11 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
306
307
308
309
310
311
312

















}

foreach w [winfo child .] {
    destroy $w
}
rename eatColors {}
rename colorsFree {}
























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
}

foreach w [winfo child .] {
    destroy $w
}
rename eatColors {}
rename colorsFree {}

# cleanup
::tcltest::cleanupTests
return













Added tests/visual_bb.test.



























































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#!/usr/local/bin/wish -f
#
# This script displays provides visual tests for many of Tk's features.
# Each test displays a window with various information in it, along
# with instructions about how the window should appear.  You can look
# at the window to make sure it appears as expected.  Individual tests
# are kept in separate ".tcl" files in this directory.
#
# RCS: @(#) $Id: visual_bb.test,v 1.1.2.1 1999/04/05 18:36:06 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

set auto_path ". $auto_path"
wm title . "Visual Tests for Tk"

set testNum 1

# Each menu entry invokes a visual test file

proc runTest {file} {
    global testNum

    test "2.$testNum" "testing $file" {userInteraction} {
	uplevel \#0 source [file join $::tcltest::testsDir $file]
	concat ""
    } {}
    incr testNum
}

# The following procedure is invoked to print the contents of a canvas:

proc lpr c {
    exec rm -f tmp.ps
    $c postscript -file tmp.ps
    exec lpr tmp.ps
    exec rm -f tmp.ps
}

test 1.1 "running visual tests" {userInteraction} {

    #-------------------------------------------------------
    # The code below create the main window, consisting of a
    # menu bar and a message explaining the basic operation
    # of the program.
    #-------------------------------------------------------

    frame .menu -relief raised -borderwidth 1
    message .msg -font {Times 18} -relief raised -width 4i \
	    -borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit.  Each menu entry invokes a test, which displays information on the screen.  You can then verify visually that the information is being displayed in the correct way.  The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets."
    
    pack .menu -side top -fill x
    pack .msg -side bottom -expand yes -fill both

    #-------------------------------------------------------
    # The code below creates all the menus, which invoke procedures
    # to create particular demonstrations of various widgets.
    #-------------------------------------------------------

    menubutton .menu.file -text "File" -menu .menu.file.m
    menu .menu.file.m
    .menu.file.m add command -label "Quit" -command ::tcltest::cleanupTests
    
    menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m
    menu .menu.group1.m
    .menu.group1.m add command -label "Canvas arcs" -command {runTest arc.tcl}
    .menu.group1.m add command -label "Beveled borders in text widgets" \
	    -command {runTest bevel.tcl}
    .menu.group1.m add command -label "Colormap management" \
	    -command {runTest cmap.tcl}
    .menu.group1.m add command -label "Label/button geometry" \
	    -command {runTest butGeom.tcl}
    .menu.group1.m add command -label "Label/button colors" \
	    -command {runTest butGeom2.tcl}
    
    menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m
    menu .menu.ps.m
    .menu.ps.m add command -label "Rectangles and other graphics" \
	    -command {runTest canvPsGrph.tcl}
    .menu.ps.m add command -label "Text" \
	    -command {runTest canvPsText.tcl}
    .menu.ps.m add command -label "Bitmaps" \
	    -command {runTest canvPsBmap.tcl}
    .menu.ps.m add command -label "Arcs" \
	    -command {runTest canvPsArc.tcl}
    
    pack .menu.file .menu.group1 .menu.ps -side left -padx 1m
    
    # Set up for keyboard-based menu traversal
    
    bind . <Any-FocusIn> {
	if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {
	    focus .menu
	}
    }
    tk_menuBar .menu .menu.file .menu.group1 .menu.ps

    # Set up a class binding to allow objects to be deleted from a canvas
    # by clicking with mouse button 1:

    bind Canvas <1> {%W delete [%W find closest %x %y]}

    concat ""
} {}

if {!$::tcltest::testConfig(userInteraction)} {
    ::tcltest::cleanupTests
}

Changes to tests/winButton.test.

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
# This file is a Tcl script to test the Windows specific behavior of
# labels, buttons, checkbuttons, and radiobuttons in Tk (i.e., all the
# widgets defined in tkWinButton.c).  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.


#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# SCCS: @(#) winButton.test 1.3 97/07/01 18:11:44

if {$tcl_platform(platform)!="windows"} {
    return
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\""
    puts "image, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"

    return
}

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

proc bogusTrace args {







>
>

<
<
>
|
<
|
|
<






>



<
<
<
<







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
# This file is a Tcl script to test the Windows specific behavior of
# labels, buttons, checkbuttons, and radiobuttons in Tk (i.e., all the
# widgets defined in tkWinButton.c).  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#


# RCS: @(#) $Id: winButton.test,v 1.1.4.5 1999/03/26 00:08:11 hershey Exp $


if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]

}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\""
    puts "image, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    ::tcltest::cleanupTests
    return
}





foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

proc bogusTrace args {
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















label .l -text Label
button .b -text Button
checkbutton .c -text Checkbutton
radiobutton .r -text Radiobutton
pack .l .b .c .r
update

test winbutton-1.1 {TkpComputeButtonGeometry procedure} {
    eval destroy [winfo children .]
    image create test image1
    image1 changed 0 0 0 0 60 40
    label .b1 -image image1 -bd 4 -padx 0 -pady 2
    button .b2 -image image1 -bd 4 -padx 0 -pady 2
    checkbutton .b3 -image image1 -bd 4 -padx 1 -pady 1
    radiobutton .b4 -image image1 -bd 4 -padx 2 -pady 0
    pack .b1 .b2 .b3 .b4
    update
    list [winfo reqwidth .b1] [winfo reqheight .b1] \
	    [winfo reqwidth .b2] [winfo reqheight .b2] \
	    [winfo reqwidth .b3] [winfo reqheight .b3] \
	    [winfo reqwidth .b4] [winfo reqheight .b4]
} {68 48 71 51 96 50 96 50}
test winbutton-1.2 {TkpComputeButtonGeometry procedure} {
    eval destroy [winfo children .]
    label .b1 -bitmap question -bd 3 -padx 0 -pady 2
    button .b2 -bitmap question -bd 3 -padx 0 -pady 2
    checkbutton .b3 -bitmap question -bd 3 -padx 1 -pady 1
    radiobutton .b4 -bitmap question -bd 3 -padx 2 -pady 0
    pack .b1 .b2 .b3 .b4
    update
    list [winfo reqwidth .b1] [winfo reqheight .b1] \
	    [winfo reqwidth .b2] [winfo reqheight .b2] \
	    [winfo reqwidth .b3] [winfo reqheight .b3] \
	    [winfo reqwidth .b4] [winfo reqheight .b4]
} {23 33 26 36 51 35 51 35}
test winbutton-1.3 {TkpComputeButtonGeometry procedure} {
    eval destroy [winfo children .]
    label .b1 -bitmap question -bd 3 -highlightthickness 4
    button .b2 -bitmap question -bd 3 -highlightthickness 0
    checkbutton .b3 -bitmap question -bd 3 -highlightthickness 1 \
	    -indicatoron 0
    radiobutton .b4 -bitmap question -bd 3 -indicatoron false
    pack .b1 .b2 .b3 .b4
    update
    list [winfo reqwidth .b1] [winfo reqheight .b1] \
	    [winfo reqwidth .b2] [winfo reqheight .b2] \
	    [winfo reqwidth .b3] [winfo reqheight .b3] \
	    [winfo reqwidth .b4] [winfo reqheight .b4]
} {31 41 24 34 26 36 26 36}
test winbutton-1.4 {TkpComputeButtonGeometry procedure} {nonPortable} {
    eval destroy [winfo children .]
    label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8}
    button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8}
    checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -font {{MS Sans Serif} 8}
    radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -font {{MS Sans Serif} 8}
    pack .b1 .b2 .b3 .b4
    update
    list [winfo reqwidth .b1] [winfo reqheight .b1] \
	    [winfo reqwidth .b2] [winfo reqheight .b2] \
	    [winfo reqwidth .b3] [winfo reqheight .b3] \
	    [winfo reqwidth .b4] [winfo reqheight .b4]
} {45 21 54 30 74 27 76 25} 
test winbutton-1.5 {TkpComputeButtonGeometry procedure} {nonPortable} {
    eval destroy [winfo children .]
    label .l1 -text "This is a long string that will wrap around on several lines.\n\nIt also has a blank line (above)." -wraplength 1.5i -padx 0 -pady 0
    pack .l1
    update
    list [winfo reqwidth .l1] [winfo reqheight .l1]
} {142 69}
test winbutton-1.6 {TkpComputeButtonGeometry procedure} {nonPortable} {
    eval destroy [winfo children .]
    label .l1 -text "This is a long string without wrapping.\n\nIt also has a blank line (above)." -padx 0 -pady 0
    pack .l1
    update
    list [winfo reqwidth .l1] [winfo reqheight .l1]
} {180 43}
test winbutton-1.7 {TkpComputeButtonGeometry procedure} {nonPortable} {
    eval destroy [winfo children .]
    label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10
    button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5
    checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -width 20 -height 2
    radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -width 4
    pack .b1 .b2 .b3 .b4
    update
    list [winfo reqwidth .b1] [winfo reqheight .b1] \
	    [winfo reqwidth .b2] [winfo reqheight .b2] \
	    [winfo reqwidth .b3] [winfo reqheight .b3] \
	    [winfo reqwidth .b4] [winfo reqheight .b4]
} {64 21 54 82 153 40 59 25}
test winbutton-1.8 {TkpComputeButtonGeometry procedure} {nonPortable} {
    eval destroy [winfo children .]
    label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \
	-highlightthickness 4
    button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 \
	-highlightthickness 0
    checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1  \
	-highlightthickness 1 -indicatoron no
    radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -indicatoron 0
    pack .b1 .b2 .b3 .b4
    update
    list [winfo reqwidth .b1] [winfo reqheight .b1] \
	    [winfo reqwidth .b2] [winfo reqheight .b2] \
	    [winfo reqwidth .b3] [winfo reqheight .b3] \
	    [winfo reqwidth .b4] [winfo reqheight .b4]
} {53 29 52 28 56 28 58 26}
test winbutton-1.9 {TkpComputeButtonGeometry procedure} {
    eval destroy [winfo children .]
    button .b2 -bitmap question -default normal
    list [winfo reqwidth .b2] [winfo reqheight .b2]
} {24 34}


eval destroy [winfo children .]






















|














|












|













|











|
|





|
|





|
|











|
|














|
|





>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
label .l -text Label
button .b -text Button
checkbutton .c -text Checkbutton
radiobutton .r -text Radiobutton
pack .l .b .c .r
update

test winbutton-1.1 {TkpComputeButtonGeometry procedure} {pcOnly} {
    eval destroy [winfo children .]
    image create test image1
    image1 changed 0 0 0 0 60 40
    label .b1 -image image1 -bd 4 -padx 0 -pady 2
    button .b2 -image image1 -bd 4 -padx 0 -pady 2
    checkbutton .b3 -image image1 -bd 4 -padx 1 -pady 1
    radiobutton .b4 -image image1 -bd 4 -padx 2 -pady 0
    pack .b1 .b2 .b3 .b4
    update
    list [winfo reqwidth .b1] [winfo reqheight .b1] \
	    [winfo reqwidth .b2] [winfo reqheight .b2] \
	    [winfo reqwidth .b3] [winfo reqheight .b3] \
	    [winfo reqwidth .b4] [winfo reqheight .b4]
} {68 48 71 51 96 50 96 50}
test winbutton-1.2 {TkpComputeButtonGeometry procedure} {pcOnly} {
    eval destroy [winfo children .]
    label .b1 -bitmap question -bd 3 -padx 0 -pady 2
    button .b2 -bitmap question -bd 3 -padx 0 -pady 2
    checkbutton .b3 -bitmap question -bd 3 -padx 1 -pady 1
    radiobutton .b4 -bitmap question -bd 3 -padx 2 -pady 0
    pack .b1 .b2 .b3 .b4
    update
    list [winfo reqwidth .b1] [winfo reqheight .b1] \
	    [winfo reqwidth .b2] [winfo reqheight .b2] \
	    [winfo reqwidth .b3] [winfo reqheight .b3] \
	    [winfo reqwidth .b4] [winfo reqheight .b4]
} {23 33 26 36 51 35 51 35}
test winbutton-1.3 {TkpComputeButtonGeometry procedure} {pcOnly} {
    eval destroy [winfo children .]
    label .b1 -bitmap question -bd 3 -highlightthickness 4
    button .b2 -bitmap question -bd 3 -highlightthickness 0
    checkbutton .b3 -bitmap question -bd 3 -highlightthickness 1 \
	    -indicatoron 0
    radiobutton .b4 -bitmap question -bd 3 -indicatoron false
    pack .b1 .b2 .b3 .b4
    update
    list [winfo reqwidth .b1] [winfo reqheight .b1] \
	    [winfo reqwidth .b2] [winfo reqheight .b2] \
	    [winfo reqwidth .b3] [winfo reqheight .b3] \
	    [winfo reqwidth .b4] [winfo reqheight .b4]
} {31 41 24 34 26 36 26 36}
test winbutton-1.4 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
    eval destroy [winfo children .]
    label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8}
    button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8}
    checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -font {{MS Sans Serif} 8}
    radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -font {{MS Sans Serif} 8}
    pack .b1 .b2 .b3 .b4
    update
    list [winfo reqwidth .b1] [winfo reqheight .b1] \
	    [winfo reqwidth .b2] [winfo reqheight .b2] \
	    [winfo reqwidth .b3] [winfo reqheight .b3] \
	    [winfo reqwidth .b4] [winfo reqheight .b4]
} {58 24 67 33 88 30 90 28} 
test winbutton-1.5 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
    eval destroy [winfo children .]
    label .l1 -text "This is a long string that will wrap around on several lines.\n\nIt also has a blank line (above)." -wraplength 1.5i -padx 0 -pady 0
    pack .l1
    update
    list [winfo reqwidth .l1] [winfo reqheight .l1]
} {178 84}
test winbutton-1.6 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
    eval destroy [winfo children .]
    label .l1 -text "This is a long string without wrapping.\n\nIt also has a blank line (above)." -padx 0 -pady 0
    pack .l1
    update
    list [winfo reqwidth .l1] [winfo reqheight .l1]
} {222 52}
test winbutton-1.7 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
    eval destroy [winfo children .]
    label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10
    button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5
    checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -width 20 -height 2
    radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -width 4
    pack .b1 .b2 .b3 .b4
    update
    list [winfo reqwidth .b1] [winfo reqheight .b1] \
	    [winfo reqwidth .b2] [winfo reqheight .b2] \
	    [winfo reqwidth .b3] [winfo reqheight .b3] \
	    [winfo reqwidth .b4] [winfo reqheight .b4]
} {74 24 67 97 174 46 64 28}
test winbutton-1.8 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
    eval destroy [winfo children .]
    label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \
	-highlightthickness 4
    button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 \
	-highlightthickness 0
    checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1  \
	-highlightthickness 1 -indicatoron no
    radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -indicatoron 0
    pack .b1 .b2 .b3 .b4
    update
    list [winfo reqwidth .b1] [winfo reqheight .b1] \
	    [winfo reqwidth .b2] [winfo reqheight .b2] \
	    [winfo reqwidth .b3] [winfo reqheight .b3] \
	    [winfo reqwidth .b4] [winfo reqheight .b4]
} {66 32 65 31 69 31 71 29}
test winbutton-1.9 {TkpComputeButtonGeometry procedure} {pcOnly} {
    eval destroy [winfo children .]
    button .b2 -bitmap question -default normal
    list [winfo reqwidth .b2] [winfo reqheight .b2]
} {24 34}

# cleanup
eval destroy [winfo children .]
::tcltest::cleanupTests
return













Changes to tests/winClipboard.test.

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
# This file is a Tcl script to test out Tk's Windows specific
# clipboard code.  It is organized in the standard fashion for Tcl
# tests.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) winClipboard.test 1.3 97/07/01 18:10:37


if {$tcl_platform(platform)!="windows"} {
    return
}


if {[string compare test [info procs test]] == 1} {
    source defs
}

test winClipboard-1.1 {TkSelGetSelection} {
    clipboard clear
    catch {selection get -selection CLIPBOARD} msg
    set msg
} {CLIPBOARD selection doesn't exist or form "STRING" not defined}
test winClipboard-1.2 {TkSelGetSelection} {
    clipboard clear
    clipboard append {}
    list [selection get -selection CLIPBOARD] [testclipboard]
} {{} {}}
test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {
    clipboard clear
    clipboard append abcd
    list [selection get -selection CLIPBOARD] [testclipboard]
} {abcd abcd}
test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {
    clipboard clear
    clipboard append "line 1\nline 2"
    list [selection get -selection CLIPBOARD] [testclipboard]
} [list "line 1\nline 2" "line 1\r\nline 2"]


























|
|
<

|

>
|
<


>
|
<
|
<
|




|




|




|




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

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
# This file is a Tcl script to test out Tk's Windows specific
# clipboard code.  It is organized in the standard fashion for Tcl
# tests.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: winClipboard.test,v 1.1.4.5 1999/03/24 02:55:12 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]

}

# Note that these tests may fail if another application is grabbing the
# clipboard (e.g. an X server)



test winClipboard-1.1 {TkSelGetSelection} {pcOnly} {
    clipboard clear
    catch {selection get -selection CLIPBOARD} msg
    set msg
} {CLIPBOARD selection doesn't exist or form "STRING" not defined}
test winClipboard-1.2 {TkSelGetSelection} {pcOnly} {
    clipboard clear
    clipboard append {}
    list [selection get -selection CLIPBOARD] [testclipboard]
} {{} {}}
test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} {
    clipboard clear
    clipboard append abcd
    list [selection get -selection CLIPBOARD] [testclipboard]
} {abcd abcd}
test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} {
    clipboard clear
    clipboard append "line 1\nline 2"
    list [selection get -selection CLIPBOARD] [testclipboard]
} [list "line 1\nline 2" "line 1\r\nline 2"]

# cleanup
::tcltest::cleanupTests
return













Added tests/winDialog.test.































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
# This file is a Tcl script to test the Windows specific behavior of
# the common dialog boxes.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: winDialog.test,v 1.1.2.7 1999/03/26 00:08:11 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[info command testwinevent] == ""} {
    puts "skipping: tests require the testwinevent command"
    ::tcltest::cleanupTests
    return
}

testwinevent debug 1

eval destroy [winfo children .] 
wm geometry . {}
raise .

proc start {arg} {
    set ::tk_dialog 0

    after 1 "$arg"
}

proc then {cmd} {
    set ::command $cmd
    set ::dialogresult {}

    afterbody
    vwait ::dialogresult
    return $::dialogresult
}

proc afterbody {} {
    if {$::tk_dialog == 0} {
	after 100 {afterbody}
	return
    }
    uplevel #0 {set dialogresult [eval $command]}
}    

proc Click {button} {
    testwinevent $::tk_dialog $button WM_LBUTTONDOWN 1 0x000a000b
    testwinevent $::tk_dialog $button WM_LBUTTONUP 0 0x000a000b
}	    

proc GetText {button} {
    return [testwinevent $::tk_dialog $button WM_GETTEXT]
}

proc SetText {button text} {
    return [testwinevent $::tk_dialog $button WM_SETTEXT $text]
}

test winDialog-1.1 {Tk_ChooseColorObjCmd} {nt} {
} {}

test winDialog-2.1 {ColorDlgHookProc} {nt} {
} {}

test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt} {
    start {tk_getOpenFile}
    then {
	set x [GetText 2]
	Click 2
    }
    set x	
} {Cancel}

test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt} {
    start {tk_getSaveFile}
    then {
	set x [GetText 2]
	Click 2
    }
    set x	
} {Cancel}

test winDialog-5.1 {GetFileName: no arguments} {nt} {
    start {tk_getOpenFile -title Open}
    then {
	Click cancel
    }
} {0}
test winDialog-5.2 {GetFileName: one argument} {nt} {
    list [catch {tk_getOpenFile -foo} msg] $msg
} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
test winDialog-5.4 {GetFileName: many arguments} {nt} {
    start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo}
    then {
	Click cancel
    }
} {0}
test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {nt} {
    list [catch {tk_getOpenFile -foo bar -abc} msg] $msg
} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt} {
    start {tk_getOpenFile -title bar}
    then {
	Click cancel
    }
} {0}
test winDialog-5.7 {GetFileName: valid option, but missing value} {nt} {
    list [catch {tk_getOpenFile -initialdir bar -title} msg] $msg
} {1 {value for "-title" missing}}
test winDialog-5.8 {GetFileName: extension begins with .} {nt} {
#    if (string[0] == '.') {
#	string++;
#    }

    start {set x [tk_getSaveFile -defaultextension .foo -title Save]}
    then {
	SetText 0x480 bar
	Click 1
    }
    set x
} [file join [pwd] bar.foo]
test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt} {
    start {set x [tk_getSaveFile -defaultextension foo -title Save]}
    then {
	SetText 0x480 bar
	Click 1
    }
    set x
} [file join [pwd] bar.foo]
test winDialog-5.10 {GetFileName: file types} {nt} {
#	    case FILE_TYPES: 

    start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo}
    then {
	set x [GetText 0x470]
	Click cancel
    }
    set x
} {foo files (*.foo)}
test winDialog-5.11 {GetFileName: file types: MakeFilter() fails} {nt} {
#		if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) 

    list [catch {tk_getSaveFile -filetypes {{"foo" .foo FOO}}} msg] $msg
} {1 {bad Macintosh file type "FOO"}}
test winDialog-5.12 {GetFileName: initial directory} {nt} {
#	    case FILE_INITDIR: 

    start {set x [tk_getSaveFile -initialdir c:/ -initialfile "12x 455" -title Foo]}
    then {
	Click 1
    }
    set x
} {C:/12x 455}
test winDialog-5.13 {GetFileName: initial directory: Tcl_TranslateFilename()} \
	{nt} {
#		if (Tcl_TranslateFileName(interp, string, &ds) == NULL) 
    
    list [catch {tk_getOpenFile -initialdir ~12x/455} msg] $msg
} {1 {user "12x" doesn't exist}}
test winDialog-5.14 {GetFileName: initial file} {nt} {
#	    case FILE_INITFILE: 

    start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]}
    then {
	Click 1
    }
    set x
} [file join [pwd] "12x 456"]
test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {nt} {
#		if (Tcl_TranslateFileName(interp, string, &ds) == NULL) 
    list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg
} {1 {user "12x" doesn't exist}}
set a aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
append a $a
append a $a
append a $a
append a $a
test winDialog-5.16 {GetFileName: initial file: long name} {knownBug nt} {
    start {set x [tk_getSaveFile -initialfile $a -title Long]}
    then {
	Click 1
    }
    set x
} [string range [file join [pwd] $a] 0 257]
test winDialog-5.17 {GetFileName: parent} {nt} {
#	    case FILE_PARENT: 

    toplevel .t
    set x 0
    start {tk_getOpenFile -parent .t -title Parent; set x 1}
    then {
	destroy .t
    }
    set x
} {1}
test winDialog-5.18 {GetFileName: title} {nt} {
#	    case FILE_TITLE: 
    
    start {tk_getOpenFile -title Narf}
    then {
	Click 2
    }
} {0}
test winDialog-5.19 {GetFileName: no filter specified} {nt} {
#    if (ofn.lpstrFilter == NULL) 

    start {tk_getOpenFile -title Filter} 
    then {
	set x [GetText 0x470]
	Click 2
    }
    set x
} {All Files (*.*)}
test winDialog-5.20 {GetFileName: parent HWND doesn't yet exist} {nt} {
#    if (Tk_WindowId(parent) == None) 

    toplevel .t
    start {tk_getOpenFile -parent .t -title Open}
    then {
	destroy .t
    }
} {}
test winDialog-5.21 {GetFileName: parent HWND already exists} {nt} {
    toplevel .t
    update
    start {tk_getOpenFile -parent .t -title Open}
    then {
	destroy .t
    }
} {}
test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt} {
#	    winCode = GetOpenFileName(&ofn);
    
    start {tk_getOpenFile -title Open}
    then {
	set x [GetText 1]
	Click 2
    }
    set x
} {&Open}
test winDialog-5.22 {GetFileName: call GetSaveFileName} {nt} {
#	    winCode = GetSaveFileName(&ofn);

    start {tk_getSaveFile -title Save}
    then {
	set x [GetText 1]
	Click 2
    }
    set x
} {&Save}
test winDialog-5.22 {GetFileName: convert \ to /} {nt} {
    start {set x [tk_getSaveFile -title Back]}
    then {
	SetText 0x480 "c:\\12x 457"
	Click 1
    }
    set x
} {c:/12x 457}

test winDialog-8.1 {OFNHookProc} {nt} {
} {}

test winDialog-6.1 {MakeFilter} {nt} {
} {}

test winDialog-5.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt} {
    start {tk_chooseDirectory}
    then {
	Click cancel
    }
} {0}
test winDialog-5.2 {Tk_ChooseDirectoryObjCmd: one argument} {nt} {
    list [catch {tk_chooseDirectory -foo} msg] $msg
} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}}
test winDialog-5.4 {Tk_ChooseDirectoryObjCmd: many arguments} {nt} {
    start {tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test}
    then {
	Click cancel
    }
} {0}
test winDialog-5.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} \
	{nt} {
    list [catch {tk_chooseDirectory -foo bar -abc} msg] $msg
} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}}
test winDialog-5.6 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} \
	{nt} {
    start {tk_chooseDirectory -title bar}
    then {
	Click cancel
    }
} {0}
test winDialog-5.7 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} \
	{nt} {
    list [catch {tk_chooseDirectory -initialdir bar -title} msg] $msg
} {1 {value for "-title" missing}}
test winDialog-5.12 {Tk_ChooseDirectoryObjCmd: initial directory} {nt} {
#	    case DIR_INITIAL: 

    start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]}
    then {
	Click 1
    }
    string tolower [set x]
} {c:/}
test winDialog-5.13 \
	{Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} \
	{nt} {
#		if (Tcl_TranslateFileName(interp, string, 
#			&utfDirString) == NULL) 
    
    list [catch {tk_chooseDirectory -initialdir ~12x/455} msg] $msg
} {1 {user "12x" doesn't exist}}

test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {}

testwinevent debug 0

# cleanup
::tcltest::cleanupTests
return











Changes to tests/winFont.test.

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
# This file is a Tcl script to test out the procedures in tkWinFont.c. 
# It is organized in the standard fashion for Tcl tests.
#
# Many of these tests are visually oriented and cannot be checked
# programmatically (such as "does an underlined font appear to be
# underlined?"); these tests attempt to exercise the code in question,
# but there are no results that can be checked.  
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) winFont.test 1.7 97/04/25 16:55:00

if {$tcl_platform(platform)!="windows"} {
    return
}

if {[string compare test [info procs test]] != 0} {
    source defs
}

catch {destroy .b}
catch {font delete xyz}

toplevel .b
update idletasks









|
|
<

<
|
<
<
|
|
<
|







1
2
3
4
5
6
7
8
9
10
11

12

13


14
15

16
17
18
19
20
21
22
23
# This file is a Tcl script to test out the procedures in tkWinFont.c. 
# It is organized in the standard fashion for Tcl tests.
#
# Many of these tests are visually oriented and cannot be checked
# programmatically (such as "does an underlined font appear to be
# underlined?"); these tests attempt to exercise the code in question,
# but there are no results that can be checked.  
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#

# RCS: @(#) $Id: winFont.test,v 1.1.4.4 1999/03/24 02:55:13 hershey Exp $



if {[lsearch [namespace children] ::tcltest] == -1} {

    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

catch {destroy .b}
catch {font delete xyz}

toplevel .b
update idletasks
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














set ax [winfo reqwidth .b.l]
set ay [winfo reqheight .b.l]
proc getsize {} {
    update
    return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
}

test winfont-1.1 {TkpGetNativeFont procedure: not native} {
    list [catch {font measure {} xyz} msg] $msg
} {1 {font "" doesn't exist}}
test winfont-1.2 {TkpGetNativeFont procedure: native} {
    font measure ansifixed 0
    font measure ansi 0
    font measure device 0
    font measure oemfixed 0
    font measure systemfixed 0
    font measure system 0
    set x {}
} {}

test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} {
    expr [font actual {-size -10} -size]>0
} {1}
test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} {
    expr [font actual {-family Arial} -size]>0
} {1}
test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} {
    font actual {-weight normal} -weight
} {normal}
test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} {
    font actual {-weight bold} -weight
} {bold}
test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} {
    catch {expr {[font actual {-size 10} -size]}}
} 0
test winfont-2.6 {TkpGetFontFromAttributes procedure: family} {
    font actual {-family Arial} -family
} {Arial}
test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} {
    set x {}
    lappend x [font actual {-family "Times"} -family]
    lappend x [font actual {-family "New York"} -family]
    lappend x [font actual {-family "Times New Roman"} -family]
} {{Times New Roman} {Times New Roman} {Times New Roman}}
test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} {
    set x {}
    lappend x [font actual {-family "Courier"} -family]
    lappend x [font actual {-family "Monaco"} -family]
    lappend x [font actual {-family "Courier New"} -family]
} {{Courier New} {Courier New} {Courier New}}
test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} {
    set x {}
    lappend x [font actual {-family "Helvetica"} -family]
    lappend x [font actual {-family "Geneva"} -family]
    lappend x [font actual {-family "Arial"} -family]
} {Arial Arial Arial}
test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} {
    # No way to get it to fail! Any font name is acceptable.
} {}

test winfont-3.1 {TkpDeleteFont procedure} {
    font actual {-family xyz}
    set x {}
} {}

test winfont-4.1 {TkpGetFontFamilies procedure} {
    font families
    set x {}
} {}

test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {
    .b.l config -wrap 0 -text "000000"
    getsize
} "[expr $ax*6] $ay"
test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {
    .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
    getsize
} "[expr $ax*256] $ay"
test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {
    .b.l config -wrap [expr $ax*10] -text "00000000"
    getsize
} "[expr $ax*8] $ay"
test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {
    .b.l config -wrap [expr $ax*6] -text "00000000"
    getsize
} "[expr $ax*6] [expr $ay*2]"
test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} {
    .b.c dchars $t 0 end
    .b.c insert $t 0 "0000"
    .b.c index $t @[expr int($cx*2.5)],1
} {2}
test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} { 
    .b.l config -text "000000" -wrap 1
    getsize
} "$ax [expr $ay*6]"
test winfont-5.7 {Tk_MeasureChars procedure: whole words} {
    .b.l config -wrap [expr $ax*8] -text "000000 0000"
    getsize
} "[expr $ax*6] [expr $ay*2]"
test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} {
    .b.l config -wrap [expr $ax*12] -text "000000    0000000"
    getsize
} "[expr $ax*7] [expr $ay*2]"
test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} {
    .b.l config -wrap [expr $ax*12] -text "000  00   00000"
    getsize
} "[expr $ax*7] [expr $ay*2]"
test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {
    .b.l config -wrap [expr $ax*12] -text "0000000000000000"
    getsize
} "[expr $ax*12] [expr $ay*2]"










test winfont-6.1 {Tk_DrawChars procedure: loop test} {
    .b.l config -text "a"
    update
} {}

test winfont-7.1 {AllocFont procedure: use old font} {
    font create xyz
    catch {destroy .c}
    button .c -font xyz
    font configure xyz -family times
    update
    destroy .c
    font delete xyz
} {}
test winfont-7.2 {AllocFont procedure: extract info from logfont} {
    font actual {arial 10 bold italic underline overstrike}
} {-family Arial -size 10 -weight bold -slant italic -underline 1 -overstrike 1}
test winfont-7.3 {AllocFont procedure: extract info from textmetric} {
    font metric {arial 10 bold italic underline overstrike} -fixed
} {0}
test winfont-7.4 {AllocFont procedure: extract info from textmetric} {
    font metric systemfixed -fixed
} {1}


destroy .b





















|


|









|


|


|


|


|


|


|





|





|





|



|




|




|



|



|



|



|




|



|



|



|



|



|
>
>
>
>
>
>
>
>
>
|




|








|


|


|



>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
set ax [winfo reqwidth .b.l]
set ay [winfo reqheight .b.l]
proc getsize {} {
    update
    return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
}

test winfont-1.1 {TkpGetNativeFont procedure: not native} {pcOnly} {
    list [catch {font measure {} xyz} msg] $msg
} {1 {font "" doesn't exist}}
test winfont-1.2 {TkpGetNativeFont procedure: native} {pcOnly} {
    font measure ansifixed 0
    font measure ansi 0
    font measure device 0
    font measure oemfixed 0
    font measure systemfixed 0
    font measure system 0
    set x {}
} {}

test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} {pcOnly} {
    expr [font actual {-size -10} -size]>0
} {1}
test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} {pcOnly} {
    expr [font actual {-family Arial} -size]>0
} {1}
test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} {pcOnly} {
    font actual {-weight normal} -weight
} {normal}
test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} {pcOnly} {
    font actual {-weight bold} -weight
} {bold}
test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} {pcOnly} {
    catch {expr {[font actual {-size 10} -size]}}
} 0
test winfont-2.6 {TkpGetFontFromAttributes procedure: family} {pcOnly} {
    font actual {-family Arial} -family
} {Arial}
test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} {pcOnly} {
    set x {}
    lappend x [font actual {-family "Times"} -family]
    lappend x [font actual {-family "New York"} -family]
    lappend x [font actual {-family "Times New Roman"} -family]
} {{Times New Roman} {Times New Roman} {Times New Roman}}
test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} {pcOnly} {
    set x {}
    lappend x [font actual {-family "Courier"} -family]
    lappend x [font actual {-family "Monaco"} -family]
    lappend x [font actual {-family "Courier New"} -family]
} {{Courier New} {Courier New} {Courier New}}
test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} {pcOnly} {
    set x {}
    lappend x [font actual {-family "Helvetica"} -family]
    lappend x [font actual {-family "Geneva"} -family]
    lappend x [font actual {-family "Arial"} -family]
} {Arial Arial Arial}
test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} {pcOnly} {
    # No way to get it to fail! Any font name is acceptable.
} {}

test winfont-3.1 {TkpDeleteFont procedure} {pcOnly} {
    font actual {-family xyz}
    set x {}
} {}

test winfont-4.1 {TkpGetFontFamilies procedure} {pcOnly} {
    font families
    set x {}
} {}

test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {pcOnly} {
    .b.l config -wrap 0 -text "000000"
    getsize
} "[expr $ax*6] $ay"
test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {pcOnly} {
    .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
    getsize
} "[expr $ax*256] $ay"
test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {pcOnly} {
    .b.l config -wrap [expr $ax*10] -text "00000000"
    getsize
} "[expr $ax*8] $ay"
test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {pcOnly} {
    .b.l config -wrap [expr $ax*6] -text "00000000"
    getsize
} "[expr $ax*6] [expr $ay*2]"
test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} {pcOnly} {
    .b.c dchars $t 0 end
    .b.c insert $t 0 "0000"
    .b.c index $t @[expr int($cx*2.5)],1
} {2}
test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} {pcOnly} { 
    .b.l config -text "000000" -wrap 1
    getsize
} "$ax [expr $ay*6]"
test winfont-5.7 {Tk_MeasureChars procedure: whole words} {pcOnly} {
    .b.l config -wrap [expr $ax*8] -text "000000 0000"
    getsize
} "[expr $ax*6] [expr $ay*2]"
test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} {pcOnly} {
    .b.l config -wrap [expr $ax*12] -text "000000    0000000"
    getsize
} "[expr $ax*7] [expr $ay*2]"
test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} {pcOnly} {
    .b.l config -wrap [expr $ax*12] -text "000  00   00000"
    getsize
} "[expr $ax*7] [expr $ay*2]"
test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {pcOnly} {
    .b.l config -wrap [expr $ax*12] -text "0000000000000000"
    getsize
} "[expr $ax*12] [expr $ay*2]"
test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} \
	{pcOnly nonPortable} {
    set font [.b.l cget -font]
    .b.l config -font {{MS Sans Serif} 8} -text "W"
    set width [winfo reqwidth .b.l]
    .b.l config -text "XaYoYaKaWx"
    set x [lindex [getsize] 0]
    .b.l config -font $font
    expr $x < ($width*10)
} 1
test winfont-6.1 {Tk_DrawChars procedure: loop test} {pcOnly} {
    .b.l config -text "a"
    update
} {}

test winfont-7.1 {AllocFont procedure: use old font} {pcOnly} {
    font create xyz
    catch {destroy .c}
    button .c -font xyz
    font configure xyz -family times
    update
    destroy .c
    font delete xyz
} {}
test winfont-7.2 {AllocFont procedure: extract info from logfont} {pcOnly} {
    font actual {arial 10 bold italic underline overstrike}
} {-family Arial -size 10 -weight bold -slant italic -underline 1 -overstrike 1}
test winfont-7.3 {AllocFont procedure: extract info from textmetric} {pcOnly} {
    font metric {arial 10 bold italic underline overstrike} -fixed
} {0}
test winfont-7.4 {AllocFont procedure: extract info from textmetric} {pcOnly} {
    font metric systemfixed -fixed
} {1}

# cleanup
destroy .b
::tcltest::cleanupTests
return












Changes to tests/winMenu.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376















377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396

397
398
399
400
401
402

403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500

501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562

563
564
565
566
567
568
569
570
571
572
573
574
575
576

577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599

600

601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652

653
654
655
656
657
658
659
660

661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676

677

678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900

901
902
903
904
905
906

907
908
909
910
911
912

913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952

953













954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975

976
977
978
979
980

981
982
983
984
985
986
987
988

989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029

1030














# This file is a Tcl script to test menus in Tk.  It is
# organized in the standard fashion for Tcl tests. This
# file tests the Macintosh-specific features of the menu
# system.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) winMenu.test 1.19 97/07/02 11:29:57

if {$tcl_platform(platform) != "windows"} {
    return
}

if {![info exists INTERACTIVE]} {
    puts " Some tests were skipped because they could not be performed"
    puts " automatically on this platform. If you wish to execute them"
    puts " interactively, set the TCL variable INTERACTIVE and re-run"
    puts " the test."
    set testConfig(menuInteractive) 0
} else {
    set testConfig(menuInteractive) 1
}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"

    return
}

if {[info procs test] != "test"} {
    source defs
}

proc deleteWindows {} {
    foreach i [winfo children .] {
    	catch [destroy $i]
    }
}

deleteWindows
wm geometry . {}
raise .

test winMenu-1.1 {GetNewID} {
    catch {destroy .m1}
    list [catch {menu .m1} msg] $msg [destroy .m1]
} {0 .m1 {}}
# Basically impossible to test menu IDs wrapping.

test winMenu-2.1 {FreeID} {
    catch {destroy .m1}
    menu .m1
    list [catch {destroy .m1} msg] $msg
} {0 {}}

test winMenu-3.1 {TkpNewMenu} {
    catch {destroy .m1}
    list [catch {menu .m1} msg] $msg [catch {destroy .m1} msg2] $msg2
} {0 .m1 0 {}}
test winMenu-3.2 {TkpNewMenu} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    .m1 add command -label "foo"
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2
} {0 {} {} 0 {}}

test winMenu-4.1 {TkpDestroyMenu} {
    catch {destroy .m1}
    menu .m1
    list [catch {destroy .m1} msg] $msg
} {0 {}}
test winMenu-4.2 {TkpDestroyMenu - help menu} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -menu .m1.system
    . configure -menu .m1
    list [catch {destroy .m1.system} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}

test winMenu-5.1 {TkpDestroyMenuEntry} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    .m1 add command -label "test"
    update idletasks
    list [catch {.m1 delete 1} msg] $msg [destroy .m1]
} {0 {} {}}

test winMenu-6.1 {GetEntryText} {
    catch {destroy .m1}
    list [catch {menu .m1} msg] $msg [destroy .m1]
} {0 .m1 {}}
test winMenu-6.2 {GetEntryText} {
    catch {destroy .m1}
    catch {image delete image1}
    menu .m1
    image create test image1
    list [catch {.m1 add command -image image1} msg] $msg [destroy .m1] [image delete image1]
} {0 {} {} {}}
test winMenu-6.3 {GetEntryText} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -bitmap questhead} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.4 {GetEntryText} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.5 {GetEntryText} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "foo"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.6 {GetEntryText} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "This string has one & in it"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.7 {GetEntryText} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "The & should be underlined." -underline 4} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.8 {GetEntryText} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "The * should be underlined." -underline 4} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.9 {GetEntryText} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "foo" -accel "bar"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.10 {GetEntryText} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "This string has one & in it" -accel "bar"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.11 {GetEntryText} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.12 {GetEntryText} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.13 {GetEntryText} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "foo" -accel "&bar"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.14 {GetEntryText} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "This string has one & in it" -accel "&bar"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.15 {GetEntryText} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.16 {GetEntryText} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1]
} {0 {} {}}

test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -menu .m1.system
    menu .m1.system
    .m1.system add command -label foo
    update idletasks
    .m1.system add command -label bar
    list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label Hello
    update idletasks
    .m1 add command -label foo
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.3 {ReconfigureWindowsMenu - zero items} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label Hello
    .m1 delete Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.4 {ReconfigureWindowsMenu - one item} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.5 {ReconfigureWindowsMenu - two items} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label One
    .m1 add command -label Two
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.6 {ReconfigureWindowsMenu - separator item} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add separator
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.7 {ReconfigureWindowsMenu - non-text item} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.8 {ReconfigureWindowsMenu - disabled item} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label Hello -state disabled
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.9 {ReconfigureWindowsMenu - non-selected checkbutton} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add checkbutton -label Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.10 {ReconfigureWindowsMenu - non-selected radiobutton} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add radiobutton -label Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.11 {ReconfigureWindowsMenu - selected checkbutton} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add checkbutton -label Hello
    .m1 invoke Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.12 {ReconfigureWindowsMenu - selected radiobutton} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add radiobutton -label Hello
    .m1 invoke Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.13 {ReconfigureWindowsMenu - cascade missing} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add cascade -label Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.14 {ReconfigureWindowsMenu - cascade} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1 -tearoff 0
    menu .m2
    .m1 add cascade -menu .m2 -label Hello
    list [catch {update idletasks} msg] $msg [destroy .m1] [destroy .m2]
} {0 {} {} {}}
test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add cascade -menu .m1.file
    menu .m1.file -tearoff 0
    . configure -menu .m1
    list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add cascade -menu .m1.system
    menu .m1.system -tearoff 0
    . configure -menu .m1
    update idletasks
    .m1.system add command -label Hello
    list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add cascade -menu .m1.system
    menu .m1.system -tearoff 0
    . configure -menu .m1
    list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add cascade -menu .m1.system
    menu .m1.system -tearoff 0
    .m1.system add command -label Hello
    update idletasks
    . configure -menu .m1
    list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test winMenu-7.19 {ReconfigureWindowsMenu - column break} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label one
    .m1 add command -label two -columnbreak 1
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}

#Don't know how to generate nested post menus
test winMenu-8.1 {TkpPostMenu} {
    catch {destroy .m1}
    menu .m1 -postcommand "blork"
    list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
} {1 {invalid command name "blork"} {}}
test winMenu-8.2 {TkpPostMenu} {
    catch {destroy .m1}
    menu .m1 -postcommand "destroy .m1"
    list [.m1 post 40 40] [winfo exists .m1]
} {{} 0}
test winMenu-8.3 {TkpPostMenu - popup menu} {menuInteractive} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-8.3: Hit ESCAPE."
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}
test winMenu-8.4 {TkpPostMenu - menu button} {menuInteractive} {
    catch {destroy .mb}
    menubutton .mb -text test -menu .mb.menu
    menu .mb.menu
    .mb.menu add command -label "winMenu-8.4 - Hit ESCAPE."
    pack .mb
    list [tkMbPost .mb] [destroy .m1]
} {{} {}}
test winMenu-8.5 {TkpPostMenu - update not pending} {menuInteractive} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-8.5 - Hit ESCAPE."
    update idletasks
    list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
} {0 {} {}}

test winMenu-9.1 {TkpMenuNewEntry} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command} msg] $msg [destroy .m1]
} {0 {} {}}

test winMenu-10.1 {TkwinMenuProc} {menuInteractive} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-10.1: Hit ESCAPE."
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}

# Can't generate a WM_INITMENU without a Tk menu yet.
test winMenu-11.1 {TkWinHandleMenuEvent - WM_INITMENU} {menuInteractive} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1 -postcommand "set foo test"
    .m1 add command -label "winMenu-11.1: Hit ESCAPE."
    list [.m1 post 40 40] [set foo] [unset foo] [destroy .m1]
} {test test {} {}}
test winMenu-11.2 {TkWinHandleMenuEvent - WM_COMMAND} {menuInteractive} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add checkbutton -variable foo -label "winMenu-11.2: Please select this menu item."
    list [.m1 post 40 40] [update] [set foo] [unset foo] [destroy .m1]
} {{} {} 1 {} {}}















# Can't test WM_MENUCHAR
test winMenu-11.3 {TkWinHandleMenuEvent - WM_MEASUREITEM} {menuInteractive} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-11.3: Hit ESCAPE."
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}
test winMenu-11.4 {TkWinHandleMenuEvent - WM_MEASUREITEM} {menuInteractive} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label "winMenu-11.4: Hit ESCAPE" -hidemargin 1
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}
test winMenu-11.5 {TkWinHandleMenuEvent - WM_DRAWITEM} {menuInteractive} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-11.5: Hit ESCAPE."
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}
test winMenu-11.6 {TkWinHandleMenuEvent - WM_DRAWITEM - item disabled} {menuInteractive} {

    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-11.6: Hit ESCAPE." -state disabled
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}
test winMenu-11.7 {TkWinHandleMenuEvent - WM_INITMENU - not pending} {menuInteractive} {

    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label "winMenu-11.7: Hit ESCAPE"
    update idletasks
    list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
} {0 {} {}}

test winMenu-12.1 {TkpSetWindowMenuBar} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    .m1 add command -label foo
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2
} {0 {} {} 0 {}}
test winMenu-12.2 {TkpSetWindowMenuBar} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    .m1 add command -label foo
    . configure -menu .m1
    list [catch {. configure -menu ""} msg] $msg [catch {destroy .m1} msg2] $msg2
} {0 {} 0 {}}
test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1 -tearoff 0
    .m1 add command -label foo
    update idletasks
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}

test winMenu-13.1 {TkpSetMainMenubar - nothing to do} {} {}

test winMenu-14.1 {GetMenuIndicatorGeometry} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo
    list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}
test winMenu-14.2 {GetMenuIndicatorGeometry} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo -hidemargin 1
    list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}

test winMenu-15.1 {GetMenuAccelGeometry} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label foo -accel Ctrl+U
    list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}
test winMenu-15.2 {GetMenuAccelGeometry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}
test winMenu-15.3 {GetMenuAccelGeometry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -accel "Ctrl+U"
    list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}

test winMenu-16.1 {GetTearoffEntryGeometry} {menuInteractive} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-19.1: Hit ESCAPE."
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}

test winMenu-17.1 {GetMenuSeparatorGeometry} {
    catch {destroy .m1}
    menu .m1
    .m1 add separator
    list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}

# Currently, the only callers to DrawWindowsSystemBitmap want things
# centered vertically, and either centered or right aligned horizontally.
test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo
    .m1 invoke foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}

test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} {

    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-19.2 {DrawMenuEntryIndicator - not selected} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo
    .m1 invoke foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} {
    catch {destroy .m1}
    menu .m1
    .m1 add radiobutton -label foo
    .m1 invoke foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-19.5 {DrawMenuEntryIndicator - disabled} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo
    .m1 invoke foo
    .m1 entryconfigure foo -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo -indicatoron 0
    .m1 invoke foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}

test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} {
    catch {destroy .m1}
    menu .m1 -disabledforeground red
    .m1 add command -label foo -accel "Ctrl+U" -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -accel "Ctrl+U"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} {

    catch {destroy .m1}
    menu .m1 -disabledforeground ""
    .m1 add command -label foo -accel "Ctrl+U" -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-20.5 {DrawMenuEntryAccelerator - cascade, drawArrow false} {menuInteractive} {

    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label "winMenu-23.5: Hit ESCAPE."
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}

test winMenu-21.1 {DrawMenuSeparator} {
    catch {destroy .m1}
    menu .m1
    .m1 add separator
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}

test winMenu-22.1 {DrawMenuUnderline} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -underline 0
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}   

test winMenu-23.1 {Don't know how to test MenuKeyBindProc} {} {}

test winMenu-24.1 {TkpInitializeMenuBindings called at boot time} {} {}


test winMenu-25.1 {DrawMenuEntryLabel - normal} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} {
    catch {destroy .m1}
    menu .m1 -disabledforeground red
    .m1 add command -label foo -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} {
    catch {destroy .m1}
    menu .m1 -disabledforeground ""
    .m1 add command -label foo -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}

test winMenu-26.1 {TkpComputeMenubarGeometry} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label File
    list [. configure -menu .m1] [. configure -menu ""] [destroy .m1]
} {{} {} {}}

test winMenu-27.1 {DrawTearoffEntry} {menuInteractive} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-24.4: Hit ESCAPE."
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}

test winMenu-28.1 {TkpConfigureMenuEntry - update pending} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label Hello
    list [catch {.m1 add command -label Two} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label One
    update idletasks
    list [catch {.m1 add command -label Two} msg] $msg [destroy .m1]
} {0 {} {}}

test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} {

    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} {

    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -activeforeground red
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} {
    catch {destroy .m1}
    menu .m1
    set tk_strictMotif 1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1] [set tk_strictMotif 0]
} {{} {} 0}

test winMenu-29.4 {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} {

    catch {destroy .m1}
    menu .m1 -disabledforeground blue
    .m1 add command -label foo -state disabled -background red
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} {
    catch {destroy .m1}
    menu .m1 -disabledforeground blue
    .m1 add command -label foo -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} {
    catch {destroy .m1}
    menu .m1 -disabledforeground ""
    .m1 add command -label foo -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -foreground red
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo -selectcolor orange
    .m1 invoke 1
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo
    .m1 invoke 1
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -activebackground green
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.12 {TkpDrawMenuEntry - border} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} {
    catch {destroy .m1}
    set tk_strictMotif 1
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1] [set tk_strictMotif 0]
} {{} {} 0}
test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -activeforeground yellow
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.15 {TkpDrawMenuEntry - active border} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -font "Helvectica 72"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.17 {TkpDrawMenuEntry - font} {
    catch {destroy .m1}
    menu .m1 -font "Courier 72"
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.18 {TkpDrawMenuEntry - separator} {
    catch {destroy .m1}
    menu .m1
    .m1 add separator
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.19 {TkpDrawMenuEntry - standard} {
    catch {destroy .mb}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label File -menu .m1.file
    menu .m1.file
    .m1.file add command -label foo
    .m1 entryconfigure File -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.21 {TkpDrawMenuEntry - indicator} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label winMenu-31.20
    .m1 invoke winMenu-31.20
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.22 {TkpDrawMenuEntry - indicator} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label winMenu-31.21 -hidemargin 1
    .m1 invoke winMenu-31.21
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}

test winMenu-30.1 {GetMenuLabelGeometry - image} {
    catch {destroy .m1}
    catch {image delete image1}
    menu .m1
    image create test image1
    .m1 add command -image image1
    list [update idletasks] [destroy .m1] [image delete image1]
} {{} {} {}}
test winMenu-30.2 {GetMenuLabelGeometry - bitmap} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -bitmap questhead
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-30.3 {GetMenuLabelGeometry - no text} {
    catch {destroy .m1}
    menu .m1
    .m1 add command
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-30.4 {GetMenuLabelGeometry - text} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "This is a test."
    list [update idletasks] [destroy .m1]
} {{} {}}

test winMenu-31.1 {DrawMenuEntryBackground} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-31.2 {DrawMenuEntryBackground} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    $tearoff activate 0
    list [update] [destroy .m1]
} {{} {}}

test winMenu-32.1 {TkpComputeStandardMenuGeometry - no entries} {
    catch {destroy .m1}
    menu .m1
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.2 {TkpComputeStandardMenuGeometry - one entry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "one"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.3 {TkpComputeStandardMenuGeometry - more than one entry} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "one"
    .m1 add command -label "two"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.4 {TkpComputeStandardMenuGeometry - separator} {
    catch {destroy .m1}
    menu .m1
    .m1 add separator
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} {
    catch {destroy .m1}
    menubutton .mb -text "test" -menu .mb.m
    menu .mb.m
    .mb.m add command -label test
    pack .mb
    catch {tkMbPost .mb}
    list [update] [destroy .mb]
} {{} {}}
test winMenu-32.6 {TkpComputeStandardMenuGeometry - standard label geometry} {

    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.7 {TkpComputeStandardMenuGeometry - different font for entry} {

    catch {destroy .m1}
    menu .m1 -font "Helvetica 12"
    .m1 add command -label "test" -font "Courier 12"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.8 {TkpComputeStandardMenuGeometry - second entry larger} {

    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add command -label "test test"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.9 {TkpComputeStandardMenuGeometry - first entry larger} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test test"
    .m1 add command -label "test"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.10 {TkpComputeStandardMenuGeometry - accelerator} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test" -accel "Ctrl+S"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.11 {TkpComputeStandardMenuGeometry - second accel larger} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test" -accel "1"
    .m1 add command -label "test" -accel "1 1"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.12 {TkpComputeStandardMenuGeometry - second accel smaller} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test" -accel "1 1"
    .m1 add command -label "test" -accel "1"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.13 {TkpComputeStandardMenuGeometry - indicator} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label test
    .m1 invoke 1
    list [update idletasks] [destroy .m1]
} {{} {}}

test winMenu-32.14 {TkpComputeStandardMenuGeometry - second indicator less or equal } {













    catch {destroy .m1}
    catch {image delete image1}
    image create test image1
    menu .m1
    .m1 add checkbutton -image image1
    .m1 invoke 1
    .m1 add checkbutton -label test
    .m1 invoke 2
    list [update idletasks] [destroy .m1] [image delete image1]
} {{} {} {}}
test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger } {unixOnly} {
    catch {destroy .m1}
    catch {image delete image1}
    image create test image1
    menu .m1
    .m1 add checkbutton -image image1
    .m1 invoke 1
    .m1 add checkbutton -label test
    .m1 invoke 2
    list [update idletasks] [destroy .m1] [image delete image1]
} {{} {} {}}
test winMenu-32.16 {TkpComputeStandardMenuGeometry - zero sized menus} {

    catch {destroy .m1}
    menu .m1 -tearoff 0
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} {

    catch {destroy .m1}
    menu .m1
    .m1 add command -label one
    .m1 add command -label two
    .m1 add command -label three -columnbreak 1
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} {

    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label one
    .m1 add command -label two -columnbreak 1
    .m1 add command -label three
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label one
    .m1 add command -label two -columnbreak 1
    .m1 add command -label three
    .m1 add command -label four
    .m1 add command -label five -columnbreak 1
    .m1 add command -label six
    list [update idletasks] [destroy .m1]    
} {{} {}}

test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} {
    catch {destroy .t2}
    catch {destroy .m1}
    toplevel .t2 -menu .m1
    wm geometry .t2 +0+0
    list [update idletasks] [destroy .t2]
} {{} {}}
test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} {
    catch {destroy .t2}
    catch {destroy .m1}
    menu .m1
    menu .m1.system
    .m1 add cascade -menu .m1.system
    .m1.system add separator
    .m1.system add command -label foo
    toplevel .t2 -menu .m1
    wm geometry .t2 +0+0
    list [update idletasks] [destroy .m1] [destroy .t2]
} {{} {} {}}

test winMenu-34.1 {TkpMenuInit called at boot time} {} {}


deleteWindows




















|
|
<

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






>



<
<
<
<










|





|





|



|







|




|







|








|



|






|




|




|




|




|




|




|




|




|




|




|




|




|




|





|









|







|






|





|






|





|





|





|





|





|






|






|





|







|







|









|







|









|








|




|




|





|







|







|





|







|






|






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

|





|





|





|
>





|
>







|






|







|








|

|





|






|





|





|






|






|








|







|







|
>






|






|







|







|








|








|






|






|
>






|






|
>






|







|







|
>
|
>

|






|






|







|






|






|





|







|
>







|
>







|








>
|
>






|






|






|






|






|







|







|







|







|








|







|







|






|






|






|






|









|







|








|







|





|





|






|






|








|




|





|






|














|
>





|
>





|
>






|






|





|






|






|






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










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




|
>







|
>







|











|






|












|

>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8

9

10


11
12
13







14
15
16
17
18
19
20
21
22
23




24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992











993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
# This file is a Tcl script to test menus in Tk.  It is
# organized in the standard fashion for Tcl tests. This
# file tests the Macintosh-specific features of the menu
# system.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#

# RCS: @(#) $Id: winMenu.test,v 1.1.4.6 1999/03/26 00:08:12 hershey Exp $



if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]







}

if {[lsearch [image types] test] < 0} {
    puts "This application hasn't been compiled with the \"test\" image"
    puts "type, so I can't run this test.  Are you sure you're using"
    puts "tktest instead of wish?"
    ::tcltest::cleanupTests
    return
}





proc deleteWindows {} {
    foreach i [winfo children .] {
    	catch [destroy $i]
    }
}

deleteWindows
wm geometry . {}
raise .

test winMenu-1.1 {GetNewID} {pcOnly} {
    catch {destroy .m1}
    list [catch {menu .m1} msg] $msg [destroy .m1]
} {0 .m1 {}}
# Basically impossible to test menu IDs wrapping.

test winMenu-2.1 {FreeID} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {destroy .m1} msg] $msg
} {0 {}}

test winMenu-3.1 {TkpNewMenu} {pcOnly} {
    catch {destroy .m1}
    list [catch {menu .m1} msg] $msg [catch {destroy .m1} msg2] $msg2
} {0 .m1 0 {}}
test winMenu-3.2 {TkpNewMenu} {pcOnly} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    .m1 add command -label "foo"
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2
} {0 {} {} 0 {}}

test winMenu-4.1 {TkpDestroyMenu} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {destroy .m1} msg] $msg
} {0 {}}
test winMenu-4.2 {TkpDestroyMenu - help menu} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -menu .m1.system
    . configure -menu .m1
    list [catch {destroy .m1.system} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}

test winMenu-5.1 {TkpDestroyMenuEntry} {pcOnly} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    .m1 add command -label "test"
    update idletasks
    list [catch {.m1 delete 1} msg] $msg [destroy .m1]
} {0 {} {}}

test winMenu-6.1 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    list [catch {menu .m1} msg] $msg [destroy .m1]
} {0 .m1 {}}
test winMenu-6.2 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    catch {image delete image1}
    menu .m1
    image create test image1
    list [catch {.m1 add command -image image1} msg] $msg [destroy .m1] [image delete image1]
} {0 {} {} {}}
test winMenu-6.3 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -bitmap questhead} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.4 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.5 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "foo"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.6 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "This string has one & in it"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.7 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "The & should be underlined." -underline 4} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.8 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "The * should be underlined." -underline 4} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.9 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "foo" -accel "bar"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.10 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "This string has one & in it" -accel "bar"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.11 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.12 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.13 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "foo" -accel "&bar"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.14 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "This string has one & in it" -accel "&bar"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.15 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-6.16 {GetEntryText} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1]
} {0 {} {}}

test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -menu .m1.system
    menu .m1.system
    .m1.system add command -label foo
    update idletasks
    .m1.system add command -label bar
    list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label Hello
    update idletasks
    .m1 add command -label foo
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.3 {ReconfigureWindowsMenu - zero items} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label Hello
    .m1 delete Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.4 {ReconfigureWindowsMenu - one item} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.5 {ReconfigureWindowsMenu - two items} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label One
    .m1 add command -label Two
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.6 {ReconfigureWindowsMenu - separator item} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add separator
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.7 {ReconfigureWindowsMenu - non-text item} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.8 {ReconfigureWindowsMenu - disabled item} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label Hello -state disabled
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.9 {ReconfigureWindowsMenu - non-selected checkbutton} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add checkbutton -label Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.10 {ReconfigureWindowsMenu - non-selected radiobutton} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add radiobutton -label Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.11 {ReconfigureWindowsMenu - selected checkbutton} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add checkbutton -label Hello
    .m1 invoke Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.12 {ReconfigureWindowsMenu - selected radiobutton} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add radiobutton -label Hello
    .m1 invoke Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.13 {ReconfigureWindowsMenu - cascade missing} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add cascade -label Hello
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-7.14 {ReconfigureWindowsMenu - cascade} {pcOnly} {
    catch {destroy .m1}
    catch {destroy .m2}
    menu .m1 -tearoff 0
    menu .m2
    .m1 add cascade -menu .m2 -label Hello
    list [catch {update idletasks} msg] $msg [destroy .m1] [destroy .m2]
} {0 {} {} {}}
test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add cascade -menu .m1.file
    menu .m1.file -tearoff 0
    . configure -menu .m1
    list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add cascade -menu .m1.system
    menu .m1.system -tearoff 0
    . configure -menu .m1
    update idletasks
    .m1.system add command -label Hello
    list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add cascade -menu .m1.system
    menu .m1.system -tearoff 0
    . configure -menu .m1
    list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add cascade -menu .m1.system
    menu .m1.system -tearoff 0
    .m1.system add command -label Hello
    update idletasks
    . configure -menu .m1
    list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
test winMenu-7.19 {ReconfigureWindowsMenu - column break} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label one
    .m1 add command -label two -columnbreak 1
    list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}

#Don't know how to generate nested post menus
test winMenu-8.1 {TkpPostMenu} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -postcommand "blork"
    list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
} {1 {invalid command name "blork"} {}}
test winMenu-8.2 {TkpPostMenu} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -postcommand "destroy .m1"
    list [.m1 post 40 40] [winfo exists .m1]
} {{} 0}
test winMenu-8.3 {TkpPostMenu - popup menu} {pcOnly userInteraction} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-8.3: Hit ESCAPE."
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}
test winMenu-8.4 {TkpPostMenu - menu button} {pcOnly userInteraction} {
    catch {destroy .mb}
    menubutton .mb -text test -menu .mb.menu
    menu .mb.menu
    .mb.menu add command -label "winMenu-8.4 - Hit ESCAPE."
    pack .mb
    list [tkMbPost .mb] [destroy .m1]
} {{} {}}
test winMenu-8.5 {TkpPostMenu - update not pending} {pcOnly userInteraction} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-8.5 - Hit ESCAPE."
    update idletasks
    list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
} {0 {} {}}

test winMenu-9.1 {TkpMenuNewEntry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [catch {.m1 add command} msg] $msg [destroy .m1]
} {0 {} {}}

test winMenu-10.1 {TkwinMenuProc} {pcOnly userInteraction} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-10.1: Hit ESCAPE."
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}

# Can't generate a WM_INITMENU without a Tk menu yet.
test winMenu-11.1 {TkWinHandleMenuEvent - WM_INITMENU} {pcOnly userInteraction} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1 -postcommand "set foo test"
    .m1 add command -label "winMenu-11.1: Hit ESCAPE."
    list [.m1 post 40 40] [set foo] [unset foo] [destroy .m1]
} {test test {} {}}
test winMenu-11.2 {TkWinHandleMenuEvent - WM_COMMAND} {pcOnly userInteraction} {
    catch {destroy .m1}
    catch {unset foo}
    menu .m1
    .m1 add checkbutton -variable foo -label "winMenu-11.2: Please select this menu item."
    list [.m1 post 40 40] [update] [set foo] [unset foo] [destroy .m1]
} {{} {} 1 {} {}}
test winMenu-11.3 {TkWinHandleMenuEvent - WM_COMMAND} {pcOnly userInteraction} {
    catch {destroy .m1}
    catch {unset foo}
    proc bgerror {args} {
	global foo errorInfo
	set foo [list $args $errorInfo]
    }
    menu .m1
    .m1 add command -command {error 1} -label "winMenu-11.2: Please select this menu item."
    list [.m1 post 40 40] [update] [set foo] [unset foo] [destroy .m1]
} {{} {} {1 {1
    while executing
"error 1"
    (menu invoke)}} {} {}}

# Can't test WM_MENUCHAR
test winMenu-11.4 {TkWinHandleMenuEvent - WM_MEASUREITEM} {pcOnly userInteraction} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-11.3: Hit ESCAPE."
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}
test winMenu-11.5 {TkWinHandleMenuEvent - WM_MEASUREITEM} {pcOnly userInteraction} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label "winMenu-11.4: Hit ESCAPE" -hidemargin 1
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}
test winMenu-11.6 {TkWinHandleMenuEvent - WM_DRAWITEM} {pcOnly userInteraction} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-11.5: Hit ESCAPE."
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}
test winMenu-11.7 {TkWinHandleMenuEvent - WM_DRAWITEM - item disabled} \
	{pcOnly userInteraction} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-11.6: Hit ESCAPE." -state disabled
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}
test winMenu-11.8 {TkWinHandleMenuEvent - WM_INITMENU - not pending} \
	{pcOnly userInteraction} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label "winMenu-11.7: Hit ESCAPE"
    update idletasks
    list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
} {0 {} {}}

test winMenu-12.1 {TkpSetWindowMenuBar} {pcOnly} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    .m1 add command -label foo
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2
} {0 {} {} 0 {}}
test winMenu-12.2 {TkpSetWindowMenuBar} {pcOnly} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1
    .m1 add command -label foo
    . configure -menu .m1
    list [catch {. configure -menu ""} msg] $msg [catch {destroy .m1} msg2] $msg2
} {0 {} 0 {}}
test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} {pcOnly} {
    catch {destroy .m1}
    . configure -menu ""
    menu .m1 -tearoff 0
    .m1 add command -label foo
    update idletasks
    list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}

test winMenu-13.1 {TkpSetMainMenubar - nothing to do} {emptyTest pcOnly} {} {}

test winMenu-14.1 {GetMenuIndicatorGeometry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo
    list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}
test winMenu-14.2 {GetMenuIndicatorGeometry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo -hidemargin 1
    list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}

test winMenu-15.1 {GetMenuAccelGeometry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label foo -accel Ctrl+U
    list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}
test winMenu-15.2 {GetMenuAccelGeometry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}
test winMenu-15.3 {GetMenuAccelGeometry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -accel "Ctrl+U"
    list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}

test winMenu-16.1 {GetTearoffEntryGeometry} {pcOnly userInteraction} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-19.1: Hit ESCAPE."
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}

test winMenu-17.1 {GetMenuSeparatorGeometry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add separator
    list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}

# Currently, the only callers to DrawWindowsSystemBitmap want things
# centered vertically, and either centered or right aligned horizontally.
test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo
    .m1 invoke foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}

test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} \
	{pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-19.2 {DrawMenuEntryIndicator - not selected} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo
    .m1 invoke foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add radiobutton -label foo
    .m1 invoke foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-19.5 {DrawMenuEntryIndicator - disabled} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo
    .m1 invoke foo
    .m1 entryconfigure foo -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo -indicatoron 0
    .m1 invoke foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}

test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -disabledforeground red
    .m1 add command -label foo -accel "Ctrl+U" -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -accel "Ctrl+U"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} \
	{pcOnly} {
    catch {destroy .m1}
    menu .m1 -disabledforeground ""
    .m1 add command -label foo -accel "Ctrl+U" -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-20.5 {DrawMenuEntryAccelerator - cascade, drawArrow false} \
	{pcOnly userInteraction} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label "winMenu-23.5: Hit ESCAPE."
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}

test winMenu-21.1 {DrawMenuSeparator} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add separator
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}

test winMenu-22.1 {DrawMenuUnderline} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -underline 0
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}   

test winMenu-23.1 {Don't know how to test MenuKeyBindProc} \
	{pcOnly emptyTest} {} {}
test winMenu-24.1 {TkpInitializeMenuBindings called at boot time} \
	{pcOnly emptyTest} {} {}

test winMenu-25.1 {DrawMenuEntryLabel - normal} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -disabledforeground red
    .m1 add command -label foo -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -disabledforeground ""
    .m1 add command -label foo -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}

test winMenu-26.1 {TkpComputeMenubarGeometry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label File
    list [. configure -menu .m1] [. configure -menu ""] [destroy .m1]
} {{} {} {}}

test winMenu-27.1 {DrawTearoffEntry} {pcOnly userInteraction} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "winMenu-24.4: Hit ESCAPE."
    list [.m1 post 40 40] [destroy .m1]
} {{} {}}

test winMenu-28.1 {TkpConfigureMenuEntry - update pending} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label Hello
    list [catch {.m1 add command -label Two} msg] $msg [destroy .m1]
} {0 {} {}}
test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label One
    update idletasks
    list [catch {.m1 add command -label Two} msg] $msg [destroy .m1]
} {0 {} {}}

test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} \
	{pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} \
	{pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -activeforeground red
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    set tk_strictMotif 1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1] [set tk_strictMotif 0]
} {{} {} 0}
test winMenu-29.4 \
	{TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} \
	{pcOnly} {
    catch {destroy .m1}
    menu .m1 -disabledforeground blue
    .m1 add command -label foo -state disabled -background red
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -disabledforeground blue
    .m1 add command -label foo -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -disabledforeground ""
    .m1 add command -label foo -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -foreground red
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo -selectcolor orange
    .m1 invoke 1
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label foo
    .m1 invoke 1
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -activebackground green
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.12 {TkpDrawMenuEntry - border} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} {pcOnly} {
    catch {destroy .m1}
    set tk_strictMotif 1
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1] [set tk_strictMotif 0]
} {{} {} 0}
test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -activeforeground yellow
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.15 {TkpDrawMenuEntry - active border} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    .m1 entryconfigure 1 -state active
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo -font "Helvectica 72"
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.17 {TkpDrawMenuEntry - font} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -font "Courier 72"
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.18 {TkpDrawMenuEntry - separator} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add separator
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.19 {TkpDrawMenuEntry - standard} {pcOnly} {
    catch {destroy .mb}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add cascade -label File -menu .m1.file
    menu .m1.file
    .m1.file add command -label foo
    .m1 entryconfigure File -state disabled
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.21 {TkpDrawMenuEntry - indicator} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label winMenu-31.20
    .m1 invoke winMenu-31.20
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-29.22 {TkpDrawMenuEntry - indicator} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label winMenu-31.21 -hidemargin 1
    .m1 invoke winMenu-31.21
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}

test winMenu-30.1 {GetMenuLabelGeometry - image} {pcOnly} {
    catch {destroy .m1}
    catch {image delete image1}
    menu .m1
    image create test image1
    .m1 add command -image image1
    list [update idletasks] [destroy .m1] [image delete image1]
} {{} {} {}}
test winMenu-30.2 {GetMenuLabelGeometry - bitmap} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -bitmap questhead
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-30.3 {GetMenuLabelGeometry - no text} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-30.4 {GetMenuLabelGeometry - text} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "This is a test."
    list [update idletasks] [destroy .m1]
} {{} {}}

test winMenu-31.1 {DrawMenuEntryBackground} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    list [update] [destroy .m1]
} {{} {}}
test winMenu-31.2 {DrawMenuEntryBackground} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label foo
    set tearoff [tkTearOffMenu .m1 40 40]
    $tearoff activate 0
    list [update] [destroy .m1]
} {{} {}}

test winMenu-32.1 {TkpComputeStandardMenuGeometry - no entries} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.2 {TkpComputeStandardMenuGeometry - one entry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "one"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.3 {TkpComputeStandardMenuGeometry - more than one entry} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "one"
    .m1 add command -label "two"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.4 {TkpComputeStandardMenuGeometry - separator} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add separator
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} {
    catch {destroy .m1}
    menubutton .mb -text "test" -menu .mb.m
    menu .mb.m
    .mb.m add command -label test
    pack .mb
    catch {tkMbPost .mb}
    list [update] [destroy .mb]
} {{} {}}
test winMenu-32.6 {TkpComputeStandardMenuGeometry - standard label geometry} \
	{pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.7 {TkpComputeStandardMenuGeometry - different font for entry} \
	{pcOnly} {
    catch {destroy .m1}
    menu .m1 -font "Helvetica 12"
    .m1 add command -label "test" -font "Courier 12"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.8 {TkpComputeStandardMenuGeometry - second entry larger} \
	{pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test"
    .m1 add command -label "test test"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.9 {TkpComputeStandardMenuGeometry - first entry larger} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test test"
    .m1 add command -label "test"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.10 {TkpComputeStandardMenuGeometry - accelerator} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test" -accel "Ctrl+S"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.11 {TkpComputeStandardMenuGeometry - second accel larger} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test" -accel "1"
    .m1 add command -label "test" -accel "1 1"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.12 {TkpComputeStandardMenuGeometry - second accel smaller} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label "test" -accel "1 1"
    .m1 add command -label "test" -accel "1"
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.13 {TkpComputeStandardMenuGeometry - indicator} {pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add checkbutton -label test
    .m1 invoke 1
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.14 \
	{TkpComputeStandardMenuGeometry - second indicator less or equal} \
	{pcOnly} {
    catch {destroy .m1}
    catch {image delete image1}
    image create test image1
    menu .m1
    .m1 add checkbutton -image image1
    .m1 invoke 1
    .m1 add checkbutton -label test
    .m1 invoke 2
    list [update idletasks] [destroy .m1] [image delete image1]
} {{} {} {}}
test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger} \
	{unixOnly} {
    catch {destroy .m1}
    catch {image delete image1}
    image create test image1
    menu .m1
    .m1 add checkbutton -image image1
    .m1 invoke 1
    .m1 add checkbutton -label test
    .m1 invoke 2
    list [update idletasks] [destroy .m1] [image delete image1]
} {{} {} {}}











test winMenu-32.16 {TkpComputeStandardMenuGeometry - zero sized menus} \
	{pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} \
	{pcOnly} {
    catch {destroy .m1}
    menu .m1
    .m1 add command -label one
    .m1 add command -label two
    .m1 add command -label three -columnbreak 1
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} \
	{pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label one
    .m1 add command -label two -columnbreak 1
    .m1 add command -label three
    list [update idletasks] [destroy .m1]
} {{} {}}
test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} {pcOnly} {
    catch {destroy .m1}
    menu .m1 -tearoff 0
    .m1 add command -label one
    .m1 add command -label two -columnbreak 1
    .m1 add command -label three
    .m1 add command -label four
    .m1 add command -label five -columnbreak 1
    .m1 add command -label six
    list [update idletasks] [destroy .m1]    
} {{} {}}

test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} {pcOnly} {
    catch {destroy .t2}
    catch {destroy .m1}
    toplevel .t2 -menu .m1
    wm geometry .t2 +0+0
    list [update idletasks] [destroy .t2]
} {{} {}}
test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} {pcOnly} {
    catch {destroy .t2}
    catch {destroy .m1}
    menu .m1
    menu .m1.system
    .m1 add cascade -menu .m1.system
    .m1.system add separator
    .m1.system add command -label foo
    toplevel .t2 -menu .m1
    wm geometry .t2 +0+0
    list [update idletasks] [destroy .m1] [destroy .t2]
} {{} {} {}}

test winMenu-34.1 {TkpMenuInit called at boot time} {emptyTest pcOnly} {} {}

# cleanup
deleteWindows
::tcltest::cleanupTests
return












Added tests/winSend.test.

























































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
# This file is a Tcl script to test out the "send" command and the
# other procedures in the file tkSend.c.  It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: winSend.test,v 1.1.2.7 1999/04/01 21:58:51 redman Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {$tcl_platform(platform) != "windows"} {
    puts "skipping: Windows only tests..."
    ::tcltest::cleanupTests
    return
}

if {[info commands send] != "send"} {
    puts "skipping: Unimplemented send command"
    ::tcltest::cleanupTests
    return
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

set currentInterps [winfo interps]

if {[catch {exec tktest &}] == 1} {
    puts "Could not run winSend.test because another instance of tktest could not be loaded."
    ::tcltest::cleanupTests
    return;
}

# Compute a script that will load Tk into a child interpreter.

foreach pkg [info loaded] {
    if {[lindex $pkg 1] == "Tk"} {
	set loadTk "load $pkg"
	break
    }
}

# Procedure to create a new application with a given name and class.

proc newApp {name {safe {}}} {
    global loadTk
    if {[string compare $safe "-safe"] == 0} {
	interp create -safe $name
    } else {
	interp create $name
    }
    $name eval [list set argv [list -name $name]]
    catch {eval $loadTk $name}
}

# Wait until the child application has launched.

while {[llength [winfo interps]] == [llength $currentInterps]} {
}

# Now find an interp to send to
set newInterps [winfo interps]
foreach interp $newInterps {
    if {[lsearch -exact $currentInterps $interp] < 0} {
	break
    }
}

# Now we have found our interpreter we are going to send to. Make sure that
# it works first.
if {[catch {send $interp {console hide; update}}] == 1} {
    puts "Could not send to child interpreter $interp"
    ::tcltest::cleanupTests
   return
}

# setting up dde server is done when the first interp is created and
# cannot be tested very easily.
test winSend-1.1 {Tk_SetAppName - changing name of interp} {
    newApp testApp
    list [testApp eval tk appname testApp2] [interp delete testApp]
} {testApp2 {}}
test winSend-1.2 {Tk_SetAppName - changing name - not front of linked list} {
    newApp testApp
    newApp testApp2
    list [testApp eval tk appname testApp3] [interp delete testApp] [interp delete testApp2]
} {testApp3 {} {}}
test winSend-1.3 {Tk_SetAppName - unique name - no conflicts} {
    newApp testApp
    list [testApp eval tk appname testApp] [interp delete testApp]
} {testApp {}}
test winSend-1.4 {Tk_SetAppName - unique name - one conflict} {
    newApp testApp
    newApp foobar
    list [foobar eval tk appname testApp] [interp delete foobar] [interp delete testApp]
} {{testApp #2} {} {}}
test winSend-1.5 {Tk_SetAppName - unique name - one conflict} {
    newApp testApp
    newApp foobar
    newApp blaz
    foobar eval tk appname testApp
    list [blaz eval tk appname testApp] [interp delete foobar] [interp delete testApp] [interp delete blaz]
} {{testApp #3} {} {} {}}
test winSend-1.6 {Tk_SetAppName - safe interps} {
    newApp testApp -safe
    list [catch {testApp eval send testApp {set foo a}} msg] $msg [interp delete testApp]
} {1 {invalid command name "send"} {}}

test winSend-2.1 {Tk_SendObjCmd - # of args} {
    list [catch {send tktest} msg] $msg
} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
test winSend-2.1 {Tk_SendObjCmd: arguments} {
    list [catch {send -bogus tktest} msg] $msg
} {1 {bad option "-bogus": must be -async, -displayof, or --}}
test winSend-2.1 {Tk_SendObjCmd: arguments} {
    list [catch {send -async bogus foo} msg] $msg
} {1 {no registered server named "bogus"}}
test winSend-2.1 {Tk_SendObjCmd: arguments} {
    list [catch {send -displayof . bogus foo} msg] $msg
} {1 {no registered server named "bogus"}}
test winSend-2.1 {Tk_SendObjCmd: arguments} {
    list [catch {send -- -bogus foo} msg] $msg
} {1 {no registered server named "-bogus"}}
test winSend-2.2 {Tk_SendObjCmd - sending to ourselves} {
    list [send [tk appname] {set foo a}]
} {a}
test winSend-2.3 {Tk_SendObjCmd - sending to ourselves in a different interpreter} {
    newApp testApp
    list [catch {send testApp {set foo b}} msg] $msg [interp delete testApp]
} {0 b {}}
test winSend-2.4 {Tk_SendObjCmd - sending to ourselves in a different interp with errors} {
    newApp testApp
    list [catch {send testApp {expr 2 / 0}} msg] $msg $errorCode $errorInfo [interp delete testApp]
} "1 {divide by zero} {ARITH DIVZERO {divide by zero}} {divide by zero\n    while executing\n\"expr 2 / 0\"\n    invoked from within\n\"send testApp {expr 2 / 0}\"} {}"
test winSend-2.5 {Tk_SendObjCmd - sending to another app async} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    list [catch {send -async $interp {set foo a}} msg] $msg
} {0 {}}
test winSend-2.6 {Tk_SendObjCmd - sending to another app sync - no error} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    list [catch {send $interp {set foo a}} msg] $msg
} {0 a}
test winSend-2.7 {Tk_SendObjCmd - sending to another app - error} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    list [catch {send $interp {expr 2 / 0}} msg] $msg $errorCode $errorInfo
} "1 {divide by zero} {ARITH DIVZERO {divide by zero}} {divide by zero\n    while executing\n\"expr 2 / 0\"\n    invoked from within\n\"send \$interp {expr 2 / 0}\"}"

test winSend-3.1 {TkGetInterpNames} {
    set origLength [llength $currentInterps]
    set newLength [llength [winfo interps]]
    expr {($newLength - 2) == $origLength}
} {1}

test winSend-4.1 {DeleteProc - changing name of app} {
    newApp a
    list [a eval tk appname foo] [interp delete a]
} {foo {}}
test winSend-4.2 {DeleteProc - normal} {
    newApp a
    list [interp delete a]
} {{}}

test winSend-5.1 {ExecuteRemoteObject - no error} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    list [send $interp {send [tk appname] {expr 2 / 1}}]
} {2}
test winSend-5.2 {ExecuteRemoteObject - error} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    list [catch {send $interp {send [tk appname] {expr 2 / 0}}} msg] $msg
} {1 {divide by zero}}

test winSend-6.1 {SendDDEServer - XTYP_CONNECT} {
    set foo "Hello, World"
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    set command "dde request Tk [tk appname] foo"
    list [catch "send \{$interp\} \{$command\}" msg] $msg
} {0 {Hello, World}}
test winSend-6.2 {SendDDEServer - XTYP_CONNECT_CONFIRM} {
    set foo "Hello, World"
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    set command "dde request Tk [tk appname] foo"
    list [catch "send \{$interp\} \{$command\}" msg] $msg
} {0 {Hello, World}}
test winSend-6.3 {SendDDEServer - XTYP_DISCONNECT} {
    set foo "Hello, World"
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    set command "dde request Tk [tk appname] foo"
    list [catch "send \{$interp\} \{$command\}" msg] $msg
} {0 {Hello, World}}
test winSend-6.4 {SendDDEServer - XTYP_REQUEST variable} {
    set foo "Hello, World"
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    set command "dde request Tk [tk appname] foo"
    list [catch "send \{$interp\} \{$command\}" msg] $msg
} {0 {Hello, World}}
test winSend-6.5 {SendDDEServer - XTYP_REQUEST array} {
    catch {unset foo}
    set foo(test) "Hello, World"
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    set command "dde request Tk [tk appname] foo(test)"
    list [catch "send \{$interp\} \{$command\}" msg] $msg [catch {unset foo}]
} {0 {Hello, World} 0}
test winSend-6.6 {SendDDEServer - XTYP_REQUEST return results} {
    set foo 3
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    set command "send [tk appname] {expr $foo + 1}"
    list [catch "send \{$interp\} \{$command\}" msg] $msg
} {0 4}
test winSend-6.7 {SendDDEServer - XTYP_EXECUTE} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    set command "send [tk appname] {expr 4 / 2}"
    list [catch "send \{$interp\} \{$command\}" msg] $msg
} {0 2}
test winSend-6.8 {SendDDEServer - XTYP_WILDCONNECT} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    set command "dde services Tk {}"
    list [catch "send \{$interp\} \{$command\}"]
} {0}

test winSend-7.1 {DDEExitProc} {
    newApp testApp
    list [interp delete testApp]
} {{}}

test winSend-8.1 {SendDdeConnect} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    list [send $interp {set tk foo}]
} {foo}

test winSend-9.1 {SetDDEError} {
    list [catch {dde execute Tk foo {set foo hello}} msg] $msg
} {1 {dde command failed}}

test winSend-10.1 {Tk_DDEObjCmd - wrong num args} {
    list [catch {dde} msg] $msg
} {1 {wrong # args: should be "dde ?-async? serviceName topicName value"}}
test winSend-10.2 {Tk_DDEObjCmd - unknown subcommand} {
    list [catch {dde foo} msg] $msg
} {1 {bad command "foo": must be execute, request, or services}}
test winSend-10.3 {Tk_DDEObjCmd - execute - wrong num args} {
    list [catch {dde execute} msg] $msg
} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}}
test winSend-10.4 {Tk_DDEObjCmd - execute - wrong num args} {
    list [catch {dde execute 3 4 5 6 7} msg] $msg
} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}}
test winSend-10.5 {Tk_DDEObjCmd - execute async - wrong num args} {
    list [catch {dde execute -async} msg] $msg
} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}}
test winSend-10.6 {Tk_DDEObjCmd - request - wrong num args} {
    list [catch {dde request} msg] $msg
} {1 {wrong # args: should be "dde request serviceName topicName value"}}
test winSend-10.7 {Tk_DDEObjCmd - services wrong num args} {
    list [catch {dde services} msg] $msg
} {1 {wrong # args: should be "dde services serviceName topicName"}}
test winSend-10.8 {Tk_DDEObjCmd - null service name} {
    list [catch {dde services {} {tktest #2}}]
} {0}
test winSend-10.9 {Tk_DDEObjCmd - null topic name} {
    list [catch {dde services {Tk} {}}]
} {0}
test winSend-10.10 {Tk_DDEObjCmd - execute - nothing to execute} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    list [catch {dde execute Tk $interp {}} msg] $msg
} {1 {cannot execute null data}}
test winSend-10.11 {Tk_DDEObjCmd - execute - no such conversation} {
    list [catch {dde execute Tk foo {set foo hello}} msg] $msg
} {1 {dde command failed}}
test winSend-10.12 {Tk_DDEObjCmd - execute - async} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    list [catch {dde execute -async Tk $interp {set foo hello}} msg] $msg
} {0 {}}
test winSend-10.13 {Tk_DDEObjCmd - execute} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    list [catch {dde execute Tk $interp {set foo goodbye}} msg] $msg
} {0 {}}
test winSend-10.14 {Tk_DDEObjCmd - request - nothing to request} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    list [catch {dde request Tk $interp {}} msg] $msg
} {1 {cannot request value of null data}}
test winSend-10.15 {Tk_DDEObjCmd - request - invalid interp} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    list [catch {dde request Tk foo foo} msg] $msg
} {1 {dde command failed}}
test winSend-10.16 {Tk_DDEObjCmd - invalid variable} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    send $interp {unset foo}
    list [catch {dde request Tk $interp foo} msg] $msg
} {1 {remote server cannot handle this command}}
test winSend-10.17 {Tk_DDEObjCmd - valid variable} {
    set newInterps [winfo interps]
    foreach interp $newInterps {
	if {[lsearch $currentInterps $interp] < 0} {
	    break
	}
    }
    send $interp {set foo winSend-10.17}
    list [catch {dde request Tk $interp foo} msg] $msg
} {0 winSend-10.17}
test winSend-10.18 {Tk_DDEObjCmd - services} {
    set currentService [list Tk [tk appname]]
    list [catch {dde services Tk {}} msg] [expr [lsearch $msg $currentService] >= 0]
} {0 1}

# Get rid of the other app and all of its interps

set newInterps [winfo interps]
while {[llength $newInterps] != [llength $currentInterps]} {
    foreach interp $newInterps {
	if {[lsearch -exact $currentInterps $interp] < 0} {
	    catch {send $interp exit}
	    set newInterps [winfo interps]
	    break
	}
    }
}

# cleanup
::tcltest::cleanupTests
return

Changes to tests/winWm.test.

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
# This file tests  is a Tcl script to test the procedures in the file
# tkWinWm.c.  It is organized in the standard fashion for Tcl tests.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) winWm.test 1.5 97/08/13 15:42:46

if {$tcl_platform(platform) != "windows"} {
    return
}

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    catch {destroy $i}
}

# Measure the height of a single menu line








|
|
<

<
|
<
<
|
|
<
|







1
2
3
4
5
6
7
8
9
10

11

12


13
14

15
16
17
18
19
20
21
22
# This file tests  is a Tcl script to test the procedures in the file
# tkWinWm.c.  It is organized in the standard fashion for Tcl tests.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#

# RCS: @(#) $Id: winWm.test,v 1.1.4.4 1999/03/24 02:55:15 hershey Exp $



if {[lsearch [namespace children] ::tcltest] == -1} {

    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    catch {destroy $i}
}

# Measure the height of a single menu line
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
















set menuheight [winfo y .t]
.t.m add command -label "thisisreallylong"
wm geom .t -0-0
update
set menuheight [expr $menuheight - [winfo y .t]]
destroy .t

test winWm-1.1 {TkWmMapWindow} {
    toplevel .t
    wm override .t 1
    wm geometry .t +0+0
    update
    set result [list [winfo rootx .t] [winfo rooty .t]]
    destroy .t
    set result
} {0 0}
test winWm-1.2 {TkWmMapWindow} {
    toplevel .t
    wm transient .t .
    update
    wm iconify .
    update
    wm deiconify .
    update
    catch {wm iconify .t} msg
    destroy .t
    set msg
} {can't iconify ".t": it is a transient}
test winWm-1.3 {TkWmMapWindow} {
    toplevel .t
    update
    toplevel .t2
    update
    set result [expr [winfo x .t] != [winfo x .t2]]
    destroy .t .t2
    set result
} 1
test winWm-1.4 {TkWmMapWindow} {
    toplevel .t
    wm geometry .t +10+10
    update
    toplevel .t2
    wm geometry .t2 +40+10
    update
    set result [list [winfo x .t] [winfo x .t2]]
    destroy .t .t2
    set result
} {10 40}
test winWm-1.5 {TkWmMapWindow} {
    toplevel .t
    wm iconify .t
    update
    set result [wm state .t]
    destroy .t
    set result
} iconic

test winWm-2.1 {TkpWmSetState} {
    toplevel .t
    wm geometry .t 150x50+10+10
    update
    set result [wm state .t]
    wm iconify .t
    update
    lappend result [wm state .t]
    wm deiconify .t
    update
    lappend result [wm state .t]
    destroy .t
    set result
} {normal iconic normal}
test winWm-2.2 {TkpWmSetState} {
    toplevel .t
    wm geometry .t 150x50+10+10
    update
    set result [wm state .t]
    wm withdraw .t
    update
    lappend result [wm state .t]
    wm iconify .t
    update
    lappend result [wm state .t]
    wm deiconify .t
    update 
    lappend result [wm state .t]
    destroy .t
    set result
} {normal withdrawn iconic normal}
test winWm-2.3 {TkpWmSetState} {
    set result {}
    toplevel .t
    wm geometry .t 150x50+10+10
    update
    lappend result [list [wm state .t] [wm geometry .t]]
    wm iconify .t
    update
    lappend result [list [wm state .t] [wm geometry .t]]
    wm geometry .t 200x50+10+10
    update
    lappend result [list [wm state .t] [wm geometry .t]]
    wm deiconify .t
    update
    lappend result [list [wm state .t] [wm geometry .t]]
    destroy .t
    set result
} {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}}


test winWm-3.1 {ConfigureTopLevel: window geometry propagation} {
    toplevel .t
    wm geometry .t +0+0
    button .t.b
    pack .t.b
    update
    set x [winfo x .t.b]
    destroy .t
    toplevel .t
    wm geometry .t +0+0
    button .t.b
    update
    pack .t.b
    update
    set x [expr $x == [winfo x .t.b]]
    destroy .t
    set x
} 1

test winWm-4.1 {ConfigureTopLevel: menu resizing} {
    set result {}
    toplevel .t
    frame .t.f -width 150 -height 50 -bg red
    pack .t.f
    wm geometry .t -0-0
    update
    set y [winfo y .t]
    menu .t.m
    .t.m add command -label foo
    .t conf -menu .t.m
    update
    set result [expr $y - [winfo y .t]]
    destroy .t
    set result
} [expr $menuheight + 1]

test winWm-5.1 {UpdateGeometryInfo: menu resizing} {
    set result {}
    toplevel .t
    frame .t.f -width 150 -height 50 -bg red
    pack .t.f
    update
    set result [winfo height .t]
    menu .t.m
    .t.m add command -label foo
    .t conf -menu .t.m
    update
    lappend result [winfo height .t]
    .t.m add command -label "thisisreallylong"
    .t.m add command -label "thisisreallylong"
    update
    lappend result [winfo height .t]
    destroy .t
    set result
} {50 50 50}
test winWm-5.2 {UpdateGeometryInfo: menu resizing} {
    set result {}
    toplevel .t
    frame .t.f -width 150 -height 50 -bg red
    pack .t.f
    wm geom .t -0-0
    update
    set y [winfo rooty .t]
    lappend result [winfo height .t]
    menu .t.m
    .t conf -menu .t.m
    .t.m add command -label foo
    .t.m add command -label "thisisreallylong"
    .t.m add command -label "thisisreallylong"
    update
    lappend result [winfo height .t]
    lappend result [expr $y - [winfo rooty .t]]
    destroy .t
    set result
} {50 50 0}























|








|











|








|










|








|













|
















|



















|


















|
















|


















|



















>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
set menuheight [winfo y .t]
.t.m add command -label "thisisreallylong"
wm geom .t -0-0
update
set menuheight [expr $menuheight - [winfo y .t]]
destroy .t

test winWm-1.1 {TkWmMapWindow} {pcOnly} {
    toplevel .t
    wm override .t 1
    wm geometry .t +0+0
    update
    set result [list [winfo rootx .t] [winfo rooty .t]]
    destroy .t
    set result
} {0 0}
test winWm-1.2 {TkWmMapWindow} {pcOnly} {
    toplevel .t
    wm transient .t .
    update
    wm iconify .
    update
    wm deiconify .
    update
    catch {wm iconify .t} msg
    destroy .t
    set msg
} {can't iconify ".t": it is a transient}
test winWm-1.3 {TkWmMapWindow} {pcOnly} {
    toplevel .t
    update
    toplevel .t2
    update
    set result [expr [winfo x .t] != [winfo x .t2]]
    destroy .t .t2
    set result
} 1
test winWm-1.4 {TkWmMapWindow} {pcOnly} {
    toplevel .t
    wm geometry .t +10+10
    update
    toplevel .t2
    wm geometry .t2 +40+10
    update
    set result [list [winfo x .t] [winfo x .t2]]
    destroy .t .t2
    set result
} {10 40}
test winWm-1.5 {TkWmMapWindow} {pcOnly} {
    toplevel .t
    wm iconify .t
    update
    set result [wm state .t]
    destroy .t
    set result
} iconic

test winWm-2.1 {TkpWmSetState} {pcOnly} {
    toplevel .t
    wm geometry .t 150x50+10+10
    update
    set result [wm state .t]
    wm iconify .t
    update
    lappend result [wm state .t]
    wm deiconify .t
    update
    lappend result [wm state .t]
    destroy .t
    set result
} {normal iconic normal}
test winWm-2.2 {TkpWmSetState} {pcOnly} {
    toplevel .t
    wm geometry .t 150x50+10+10
    update
    set result [wm state .t]
    wm withdraw .t
    update
    lappend result [wm state .t]
    wm iconify .t
    update
    lappend result [wm state .t]
    wm deiconify .t
    update 
    lappend result [wm state .t]
    destroy .t
    set result
} {normal withdrawn iconic normal}
test winWm-2.3 {TkpWmSetState} {pcOnly} {
    set result {}
    toplevel .t
    wm geometry .t 150x50+10+10
    update
    lappend result [list [wm state .t] [wm geometry .t]]
    wm iconify .t
    update
    lappend result [list [wm state .t] [wm geometry .t]]
    wm geometry .t 200x50+10+10
    update
    lappend result [list [wm state .t] [wm geometry .t]]
    wm deiconify .t
    update
    lappend result [list [wm state .t] [wm geometry .t]]
    destroy .t
    set result
} {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}}


test winWm-3.1 {ConfigureTopLevel: window geometry propagation} {pcOnly} {
    toplevel .t
    wm geometry .t +0+0
    button .t.b
    pack .t.b
    update
    set x [winfo x .t.b]
    destroy .t
    toplevel .t
    wm geometry .t +0+0
    button .t.b
    update
    pack .t.b
    update
    set x [expr $x == [winfo x .t.b]]
    destroy .t
    set x
} 1

test winWm-4.1 {ConfigureTopLevel: menu resizing} {pcOnly} {
    set result {}
    toplevel .t
    frame .t.f -width 150 -height 50 -bg red
    pack .t.f
    wm geometry .t -0-0
    update
    set y [winfo y .t]
    menu .t.m
    .t.m add command -label foo
    .t conf -menu .t.m
    update
    set result [expr $y - [winfo y .t]]
    destroy .t
    set result
} [expr $menuheight + 1]

test winWm-5.1 {UpdateGeometryInfo: menu resizing} {pcOnly} {
    set result {}
    toplevel .t
    frame .t.f -width 150 -height 50 -bg red
    pack .t.f
    update
    set result [winfo height .t]
    menu .t.m
    .t.m add command -label foo
    .t conf -menu .t.m
    update
    lappend result [winfo height .t]
    .t.m add command -label "thisisreallylong"
    .t.m add command -label "thisisreallylong"
    update
    lappend result [winfo height .t]
    destroy .t
    set result
} {50 50 50}
test winWm-5.2 {UpdateGeometryInfo: menu resizing} {pcOnly} {
    set result {}
    toplevel .t
    frame .t.f -width 150 -height 50 -bg red
    pack .t.f
    wm geom .t -0-0
    update
    set y [winfo rooty .t]
    lappend result [winfo height .t]
    menu .t.m
    .t conf -menu .t.m
    .t.m add command -label foo
    .t.m add command -label "thisisreallylong"
    .t.m add command -label "thisisreallylong"
    update
    lappend result [winfo height .t]
    lappend result [expr $y - [winfo rooty .t]]
    destroy .t
    set result
} {50 50 0}

# cleanup
::tcltest::cleanupTests
return












Changes to tests/window.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
# This file is a Tcl script to test the procedures in the file
# tkWindow.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) window.test 1.8 97/01/22 14:17:54

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .




|
|
<

|

|
|







1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
# This file is a Tcl script to test the procedures in the file
# tkWindow.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: window.test,v 1.1.4.5 1999/03/26 00:08:13 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
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
















    place .f.t.f -x 0 -y 0
    frame .f.t.f.f -width 100 -height 100 -relief raised -bd 2
    place .f.t.f.f -relx 1 -rely 1 -anchor se
    update
    destroy .f
} {}





test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {

    catch {destroy .t}
    toplevel .t -width 300 -height 200
    wm geometry .t +0+0
    pack [entry .t.e]
    frame .t.f -bd 2 -relief raised
    testmenubar window .t .t.f
    update
    # If stacking order isn't handle properly, generates an X error.
} {}
test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {

    catch {destroy .t}
    toplevel .t -width 300 -height 200
    wm geometry .t +0+0
    pack [entry .t.e]
    pack [entry .t.e2]
    update
    frame .t.f -bd 2 -relief raised
    raise .t.f .t.e
    testmenubar window .t .t.f
    update
    # If stacking order isn't handled properly, generates an X error.
} {}

test window-4.1 {Tk_NameToWindow procedure} {
    catch {destroy .t}
    list [catch {winfo geometry .t} msg] $msg
} {1 {bad window path name ".t"}}
test window-4.2 {Tk_NameToWindow procedure} {
    catch {destroy .t}
    frame .t -width 100 -height 50
    place .t -x 10 -y 10
    update
    list [catch {winfo geometry .t} msg] $msg
} {0 100x50+10+10}

test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {

    catch {destroy .t}
    toplevel .t -width 300 -height 200
    wm geometry .t +0+0
    pack [entry .t.e]
    pack [entry .t.e2]
    frame .t.f -bd 2 -relief raised
    testmenubar window .t .t.f
    update
    lower .t.e2 .t.f
    update
    # If stacking order isn't handled properly, generates an X error.
} {}























>
>
>
>
|
>









|
>













|



|







|
>












>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
    place .f.t.f -x 0 -y 0
    frame .f.t.f.f -width 100 -height 100 -relief raised -bd 2
    place .f.t.f.f -relx 1 -rely 1 -anchor se
    update
    destroy .f
} {}

# Some tests require the testmenubar command
set ::tcltest::testConfig(testmenubar) \
	[expr {[info commands testmenubar] != {}}]

test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \
	{unixOnly testmenubar} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200
    wm geometry .t +0+0
    pack [entry .t.e]
    frame .t.f -bd 2 -relief raised
    testmenubar window .t .t.f
    update
    # If stacking order isn't handle properly, generates an X error.
} {}
test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} \
	{unixOnly testmenubar} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200
    wm geometry .t +0+0
    pack [entry .t.e]
    pack [entry .t.e2]
    update
    frame .t.f -bd 2 -relief raised
    raise .t.f .t.e
    testmenubar window .t .t.f
    update
    # If stacking order isn't handled properly, generates an X error.
} {}

test window-4.1 {Tk_NameToWindow procedure} {testmenubar} {
    catch {destroy .t}
    list [catch {winfo geometry .t} msg] $msg
} {1 {bad window path name ".t"}}
test window-4.2 {Tk_NameToWindow procedure} {testmenubar} {
    catch {destroy .t}
    frame .t -width 100 -height 50
    place .t -x 10 -y 10
    update
    list [catch {winfo geometry .t} msg] $msg
} {0 100x50+10+10}

test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \
	{unixOnly testmenubar} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200
    wm geometry .t +0+0
    pack [entry .t.e]
    pack [entry .t.e2]
    frame .t.f -bd 2 -relief raised
    testmenubar window .t .t.f
    update
    lower .t.e2 .t.f
    update
    # If stacking order isn't handled properly, generates an X error.
} {}

# cleanup
::tcltest::cleanupTests
return












Changes to tests/winfo.test.

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
# This file is a Tcl script to test out the "winfo" command.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) winfo.test 1.19 97/05/16 08:49:01

if {[info procs test] != "test"} {
    source defs
}

foreach i [winfo children .] {
    catch {destroy $i}
}
wm geometry . {}
raise .





# eatColors --
# Creates a toplevel window and allocates enough colors in it to
# use up all the slots in the colormap.
#
# Arguments:
# w -		Name of toplevel window to create.





|
|
<

|

|
|







>
>
>
>







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
# This file is a Tcl script to test out the "winfo" command.  It is
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

#
# RCS: @(#) $Id: winfo.test,v 1.1.4.7 1999/04/07 00:49:19 stanton Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    catch {destroy $i}
}
wm geometry . {}
raise .

# Some tests require the testwrapper command
set ::tcltest::testConfig(testwrapper) \
	[expr {[info commands testwrapper] != {}}]

# eatColors --
# Creates a toplevel window and allocates enough colors in it to
# use up all the slots in the colormap.
#
# Arguments:
# w -		Name of toplevel window to create.
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
test winfo-2.6 {"winfo atomname" command} {
    winfo atomname 2
} SECONDARY
test winfo-2.7 {"winfo atom" command} {
    winfo atomname -displayof . 2
} SECONDARY



if {([winfo depth .] == 8) && ([winfo visual .] == "pseudocolor")} {

    test winfo-3.1 {"winfo colormapfull" command} {
	list [catch {winfo colormapfull} msg] $msg
    } {1 {wrong # args: should be "winfo colormapfull window"}}
    test winfo-3.2 {"winfo colormapfull" command} {
	list [catch {winfo colormapfull a b} msg] $msg
    } {1 {wrong # args: should be "winfo colormapfull window"}}
    test winfo-3.3 {"winfo colormapfull" command} {
	list [catch {winfo colormapfull foo} msg] $msg
    } {1 {bad window path name "foo"}}
    test winfo-3.4 {"winfo colormapfull" command} {macOrUnix} {
	eatColors .t {-colormap new}
	set result [list [winfo colormapfull .] [winfo colormapfull .t]]
	.t.c delete 34
	lappend result [winfo colormapfull .t]
	.t.c create rectangle 30 30 80 80 -fill #441739
	lappend result [winfo colormapfull .t]
	.t.c create rectangle 40 40 90 90 -fill #ffeedd
	lappend result [winfo colormapfull .t]
	destroy .t.c
	lappend result [winfo colormapfull .t]
    } {0 1 0 0 1 0}
    catch {destroy .t}
}

catch {destroy .t}
toplevel .t -width 550 -height 400
frame .t.f -width 80 -height 60 -bd 2 -relief raised
place .t.f -x 50 -y 50
wm geom .t +0+0
update
test winfo-4.1 {"winfo containing" command} {
    list [catch {winfo containing 22} msg] $msg







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







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
test winfo-2.6 {"winfo atomname" command} {
    winfo atomname 2
} SECONDARY
test winfo-2.7 {"winfo atom" command} {
    winfo atomname -displayof . 2
} SECONDARY

# Some tests require the "pseudocolor" visual class.
set ::tcltest::testConfig(pseudocolor) \
	[expr {([winfo depth .] == 8) && ([winfo visual .] == "pseudocolor")}]

test winfo-3.1 {"winfo colormapfull" command} {pseudocolor} {
    list [catch {winfo colormapfull} msg] $msg
} {1 {wrong # args: should be "winfo colormapfull window"}}
test winfo-3.2 {"winfo colormapfull" command} {pseudocolor} {
    list [catch {winfo colormapfull a b} msg] $msg
} {1 {wrong # args: should be "winfo colormapfull window"}}
test winfo-3.3 {"winfo colormapfull" command} {pseudocolor} {
    list [catch {winfo colormapfull foo} msg] $msg
} {1 {bad window path name "foo"}}
test winfo-3.4 {"winfo colormapfull" command} {macOrUnix pseudocolor} {
    eatColors .t {-colormap new}
    set result [list [winfo colormapfull .] [winfo colormapfull .t]]
    .t.c delete 34
    lappend result [winfo colormapfull .t]
    .t.c create rectangle 30 30 80 80 -fill #441739
    lappend result [winfo colormapfull .t]
    .t.c create rectangle 40 40 90 90 -fill #ffeedd
    lappend result [winfo colormapfull .t]
    destroy .t.c
    lappend result [winfo colormapfull .t]
} {0 1 0 0 1 0}
catch {destroy .t}



toplevel .t -width 550 -height 400
frame .t.f -width 80 -height 60 -bd 2 -relief raised
place .t.f -x 50 -y 50
wm geom .t +0+0
update
test winfo-4.1 {"winfo containing" command} {
    list [catch {winfo containing 22} msg] $msg
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
} {1 {expected integer but got "xyz"}}
test winfo-7.6 {"winfo pathname" command} {
    list [catch {winfo pathname 224} msg] $msg
} {1 {window id "224" doesn't exist in this application}}
test winfo-7.7 {"winfo pathname" command} {
    winfo pathname -displayof .b [winfo id .]
} {.}
test winfo-7.8 {"winfo pathname" command} {unixOnly} {
    winfo pathname [testwrapper .]
} {}

test winfo-8.1 {"winfo pointerx" command} {
    catch [winfo pointerx .b]
} 1
test winfo-8.2 {"winfo pointery" command} {







|







206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
} {1 {expected integer but got "xyz"}}
test winfo-7.6 {"winfo pathname" command} {
    list [catch {winfo pathname 224} msg] $msg
} {1 {window id "224" doesn't exist in this application}}
test winfo-7.7 {"winfo pathname" command} {
    winfo pathname -displayof .b [winfo id .]
} {.}
test winfo-7.8 {"winfo pathname" command} {unixOnly testwrapper} {
    winfo pathname [testwrapper .]
} {}

test winfo-8.1 {"winfo pointerx" command} {
    catch [winfo pointerx .b]
} 1
test winfo-8.2 {"winfo pointery" command} {
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
















    frame .con -container 1
    pack .con -expand yes -fill both
    toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0
    button .emb.b
    pack .emb.b -expand yes -fill both
    update
}
test winfo-13.1 {root coordinates of embedded toplevel} {macOrUnix} {
    MakeEmbed
    set z [expr [winfo rootx .emb] == [winfo rootx .con] && \
		[winfo rooty .emb] == [winfo rooty .con]]
    destroy .emb
    destroy .con
    set z
} {1}
test winfo-13.2 {destroying embedded toplevel} {macOrUnix} {
    catch {destroy .emb}
    update
    expr [winfo exists .emb.b] || [winfo exists .con]
} 0

foreach i [winfo children .] {
    destroy $i
}

test winfo-13.3 {destroying container window} {macOrUnix} {
    MakeEmbed
    destroy .con
    update
    set z [expr [winfo exists .emb.b] || [winfo exists .emb]]
    catch {destroy .emb}
    catch {destroy .con}
    set z
} 0

foreach i [winfo children .] {
    destroy $i
}

test winfo-13.4 {[winfo containing] with embedded windows} {macOrUnix} {
    MakeEmbed
    button .b
    pack .b -expand yes -fill both
    update

    set z [string compare \
	[winfo containing [winfo rootx .emb.b] [winfo rooty .emb.b]] .emb.b]
    catch {destroy .con}
    catch {destroy .emb}
    set z
} 0

foreach i [winfo children .] {
    catch {destroy $i}
}























|







|
|








|













|















>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
    frame .con -container 1
    pack .con -expand yes -fill both
    toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0
    button .emb.b
    pack .emb.b -expand yes -fill both
    update
}
test winfo-13.1 {root coordinates of embedded toplevel} {
    MakeEmbed
    set z [expr [winfo rootx .emb] == [winfo rootx .con] && \
		[winfo rooty .emb] == [winfo rooty .con]]
    destroy .emb
    destroy .con
    set z
} {1}
test winfo-13.2 {destroying embedded toplevel} {
    destroy .emb
    update
    expr [winfo exists .emb.b] || [winfo exists .con]
} 0

foreach i [winfo children .] {
    destroy $i
}

test winfo-13.3 {destroying container window} {
    MakeEmbed
    destroy .con
    update
    set z [expr [winfo exists .emb.b] || [winfo exists .emb]]
    catch {destroy .emb}
    catch {destroy .con}
    set z
} 0

foreach i [winfo children .] {
    destroy $i
}

test winfo-13.4 {[winfo containing] with embedded windows} {
    MakeEmbed
    button .b
    pack .b -expand yes -fill both
    update

    set z [string compare \
	[winfo containing [winfo rootx .emb.b] [winfo rooty .emb.b]] .emb.b]
    catch {destroy .con}
    catch {destroy .emb}
    set z
} 0

foreach i [winfo children .] {
    catch {destroy $i}
}

# cleanup
::tcltest::cleanupTests
return












Added tests/xmfbox.test.



















































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
# xmfbox.test -- 
#
#	This file is a Tcl script to test the file dialog that's used
#	when the tk_strictMotif flag is set. Because the file dialog
#	runs in a modal loop, the only way to test it sufficiently is
#	to call the internal Tcl procedures in xmfbox.tcl directly.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: xmfbox.test,v 1.1.2.5 1999/03/24 02:55:16 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

set testPWD [pwd]
eval destroy [winfo children .]
catch {unset foo}

catch {unset data foo}

proc cleanup {} {
    global testPWD

    set err0 [catch {
	cd $testPWD
    } msg0]

    set err1 [catch {
	if [file exists ./~nosuchuser1] {
	    file delete ./~nosuchuser1
	}
    } msg1]

    set err2 [catch {
	if [file exists ./~nosuchuser2] {
	    file delete ./~nosuchuser2
	}
    } msg2]

    set err3 [catch {
	if [file exists ./~nosuchuser3] {
	    file delete ./~nosuchuser3
	}
    } msg3]

    set err4 [catch {
	if [file exists ./~nosuchuser4] {
	    file delete ./~nosuchuser4
	}
    } msg4]

    if {$err0 || $err1 || $err2 || $err3 || $err4} {
	error [list $msg0 $msg1 $msg2 $msg3 $msg4] 
    }
    catch {unset foo}
    catch {destroy .foo}
}

test xmfbox-1.1 {tkMotifFDialog_Create, -parent switch} {unixOnly} {
    catch {unset foo}
    set x [tkMotifFDialog_Create foo open {-parent .}]
    catch {destroy $x}
    set x
} .foo

test xmfbox-1.2 {tkMotifFDialog_Create, -parent switch} {unixOnly} {
    catch {unset foo}
    toplevel .bar
    set x [tkMotifFDialog_Create foo open {-parent .bar}]
    catch {destroy $x}
    catch {destroy .bar}
    set x
} .bar.foo

test xmfbox-2.1 {tkMotifFDialog_InterpFilter, ~ in dir names} {unixOnly} {
    cleanup
    file mkdir ./~nosuchuser1
    set x [tkMotifFDialog_Create foo open {}]
    $foo(fEnt) delete 0 end
    $foo(fEnt) insert 0 [pwd]/~nosuchuser1
    set kk [tkMotifFDialog_InterpFilter $x]
} [list $testPWD/~nosuchuser1 *]

test xmfbox-2.2 {tkMotifFDialog_InterpFilter, ~ in file names} {unixOnly} {
    cleanup
    close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
    set x [tkMotifFDialog_Create foo open {}]
    $foo(fEnt) delete 0 end
    $foo(fEnt) insert 0 [pwd]/~nosuchuser1
    set kk [tkMotifFDialog_InterpFilter $x]
} [list $testPWD ./~nosuchuser1]

test xmfbox-2.3 {tkMotifFDialog_Update, ~ in file names} {unixOnly} {
    cleanup
    close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
    set x [tkMotifFDialog_Create foo open {}]
    $foo(fEnt) delete 0 end
    $foo(fEnt) insert 0 [pwd]/~nosuchuser1
    tkMotifFDialog_InterpFilter $x
    tkMotifFDialog_Update $x
    $foo(fList) get end
} ~nosuchuser1

test xmfbox-2.4 {tkMotifFDialog_LoadFile, ~ in file names} {unixOnly} {
    cleanup
    close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
    set x [tkMotifFDialog_Create foo open {}]
    set i [lsearch [$foo(fList) get 0 end] ~nosuchuser1]
    expr {$i >= 0}
} 1

test xmfbox-2.5 {tkMotifFDialog_BrowseFList, ~ in file names} {unixOnly} {
    cleanup
    close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
    set x [tkMotifFDialog_Create foo open {}]
    set i [lsearch [$foo(fList) get 0 end] ~nosuchuser1]
    $foo(fList) selection clear 0 end
    $foo(fList) selection set $i
    tkMotifFDialog_BrowseFList $x
    $foo(sEnt) get
} $testPWD/~nosuchuser1

test xmfbox-2.5 {tkMotifFDialog_ActivateFList, ~ in file names} {unixOnly} {
    cleanup
    close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
    set x [tkMotifFDialog_Create foo open {}]
    set i [lsearch [$foo(fList) get 0 end] ~nosuchuser1]
    $foo(fList) selection clear 0 end
    $foo(fList) selection set $i
    tkMotifFDialog_BrowseFList $x
    tkMotifFDialog_ActivateFList $x
    list $foo(selectPath) $foo(selectFile) $tkPriv(selectFilePath)
} [list $testPWD ~nosuchuser1 $testPWD/~nosuchuser1]

# cleanup
cleanup
::tcltest::cleanupTests
return












Changes to unix/Makefile.in.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
#
# This file is a Makefile for Tk.  If it has the name "Makefile.in"
# then it is a template for a Makefile;  to generate the actual Makefile,
# run "./configure", which is a configuration script generated by the
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
# SCCS: @(#) Makefile.in 1.146 97/11/05 11:10:45

# Current Tk version;  used in various names.

TCLVERSION = @TCL_VERSION@
VERSION = @TK_VERSION@

#----------------------------------------------------------------







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
#
# This file is a Makefile for Tk.  If it has the name "Makefile.in"
# then it is a template for a Makefile;  to generate the actual Makefile,
# run "./configure", which is a configuration script generated by the
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
# RCS: @(#) $Id: Makefile.in,v 1.1.4.13 1999/04/07 00:36:10 stanton Exp $

# Current Tk version;  used in various names.

TCLVERSION = @TCL_VERSION@
VERSION = @TK_VERSION@

#----------------------------------------------------------------
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
# Tcl commands implemented by Tk:
MANN_INSTALL_DIR =	$(MAN_INSTALL_DIR)/mann

# The directory containing the Tcl sources and headers appropriate
# for this version of Tk ("srcdir" will be replaced or has already
# been replaced by the configure script):
TCL_GENERIC_DIR =	@TCL_SRC_DIR@/generic


# The directory containing the Tcl library archive file appropriate
# for this version of Tk:
TCL_BIN_DIR =		@TCL_BIN_DIR@



















# A "-I" switch that can be used when compiling to make all of the
# X11 include files accessible (the configure script will try to
# set this value, and will cause it to be an empty string if the
# include files are accessible via /usr/include).
X11_INCLUDES =		@XINCLUDES@

# Linker switch(es) to use to link with the X11 library archive (the
# configure script will try to set this value automatically, but you
# can override it).
X11_LIB_SWITCHES =	@XLIBSW@

# Libraries to use when linking.  This definition is determined by the
# configure script.
LIBS = @TCL_BUILD_LIB_SPEC@ @LIBS@ $(X11_LIB_SWITCHES) @DL_LIBS@ @MATH_LIBS@ -lc

# To change the compiler switches, for example to change from -O
# to -g, change the following line:
CFLAGS = -O

# To turn off the security checks that disallow incoming sends when
# the X server appears to be insecure, reverse the comments on the
# following lines:
SECURITY_FLAGS =
#SECURITY_FLAGS = -DTK_NO_SECURITY








>




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












<
<
<
<
<
<
<







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
# Tcl commands implemented by Tk:
MANN_INSTALL_DIR =	$(MAN_INSTALL_DIR)/mann

# The directory containing the Tcl sources and headers appropriate
# for this version of Tk ("srcdir" will be replaced or has already
# been replaced by the configure script):
TCL_GENERIC_DIR =	@TCL_SRC_DIR@/generic
TCL_UNIX_DIR =		@TCL_SRC_DIR@/unix

# The directory containing the Tcl library archive file appropriate
# for this version of Tk:
TCL_BIN_DIR =		@TCL_BIN_DIR@

# Libraries built with optimization switches have this additional extension
TK_DBGX =		@TK_DBGX@
TCL_DBGX =		@TCL_DBGX@

# warning flags
CFLAGS_WARNING =	@CFLAGS_WARNING@

# The default switches for optimization or debugging
CFLAGS_DEBUG =		@CFLAGS_DEBUG@
CFLAGS_OPTIMIZE =	@CFLAGS_OPTIMIZE@

# To change the compiler switches, for example to change from optimization to
# debugging symbols, change the following line:
#CFLAGS = 		$(CFLAGS_DEBUG)
#CFLAGS = 		$(CFLAGS_OPTIMIZE)
#CFLAGS = 		$(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
CFLAGS = 		$(@CFLAGS_DEFAULT@)

# A "-I" switch that can be used when compiling to make all of the
# X11 include files accessible (the configure script will try to
# set this value, and will cause it to be an empty string if the
# include files are accessible via /usr/include).
X11_INCLUDES =		@XINCLUDES@

# Linker switch(es) to use to link with the X11 library archive (the
# configure script will try to set this value automatically, but you
# can override it).
X11_LIB_SWITCHES =	@XLIBSW@









# To turn off the security checks that disallow incoming sends when
# the X server appears to be insecure, reverse the comments on the
# following lines:
SECURITY_FLAGS =
#SECURITY_FLAGS = -DTK_NO_SECURITY

121
122
123
124
125
126
127






128
129
130
131
132
133
134
# If your X server is X11R4 or earlier, then you may wish to reverse
# the comment characters on the following two lines.  This will enable
# extra code to speed up XStringToKeysym.  In X11R5 and later releases
# XStringToKeysym is plenty fast, so you needn't define REDO_KEYSYM_LOOKUP.
KEYSYM_FLAGS =
#KEYSYM_FLAGS = -DREDO_KEYSYM_LOOKUP







# Some versions of make, like SGI's, use the following variable to
# determine which shell to use for executing commands:
SHELL =		/bin/sh

# Tk used to let the configure script choose which program to use
# for installing, but there are just too many different versions of
# "install" around;  better to use the install-sh script that comes







>
>
>
>
>
>







133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
# If your X server is X11R4 or earlier, then you may wish to reverse
# the comment characters on the following two lines.  This will enable
# extra code to speed up XStringToKeysym.  In X11R5 and later releases
# XStringToKeysym is plenty fast, so you needn't define REDO_KEYSYM_LOOKUP.
KEYSYM_FLAGS =
#KEYSYM_FLAGS = -DREDO_KEYSYM_LOOKUP

# Tk does not used deprecated Tcl constructs so it should
# compile fine with -DTCL_NO_DEPRECATED. To remove its own
# set of deprecated code uncomment the second line.
NO_DEPRECATED_FLAGS= -DTCL_NO_DEPRECATED
#NO_DEPRECATED_FLAGS= -DTCL_NO_DEPRECATED -DTK_NO_DEPRECATED

# Some versions of make, like SGI's, use the following variable to
# determine which shell to use for executing commands:
SHELL =		/bin/sh

# Tk used to let the configure script choose which program to use
# for installing, but there are just too many different versions of
# "install" around;  better to use the install-sh script that comes
142
143
144
145
146
147
148









149
150
151














152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186


187
188

189




190
191
192
193
194
195
196
197
198


199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218


219
220
221
222
223
224
225
226




227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261

262

263
264
265

266
267
268
269
270

271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291





292
293
294
295
296
297

298
299
300
301
302
303
304

305
306
307
308

309
310
311
312
313
314
315
316
317
318
319
320
321
322


323
324
325
326
327
328
329
330
331
332


333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360










361
362
363
364
365
366
367
368
369
370
371
372


373
374

375
376
377
378
379
380
381
382
# The symbols below provide support for dynamic loading and shared
# libraries.  The values of the symbols are normally set by the
# configure script.  You shouldn't normally need to modify any of
# these definitions by hand.

TK_SHLIB_CFLAGS = @TK_SHLIB_CFLAGS@










TK_LIB_FILE = @TK_LIB_FILE@
#TK_LIB_FILE = libtk.a















# The symbol below provides support for dynamic loading and shared
# libraries.  See configure.in for a description of what it means.
# The values of the symbolis normally set by the configure script.

SHLIB_LD = @SHLIB_LD@

# Additional search flags needed to find the various shared libraries
# at run-time.  The first symbol is for use when creating a binary
# with cc, and the second is for use when running ld directly.
TK_CC_SEARCH_FLAGS = @TK_CC_SEARCH_FLAGS@
TK_LD_SEARCH_FLAGS = @TK_LD_SEARCH_FLAGS@

#----------------------------------------------------------------
# The information below is modified by the configure script when
# Makefile is generated from Makefile.in.  You shouldn't normally
# modify any of this stuff by hand.
#----------------------------------------------------------------

AC_FLAGS =		@DEFS@
RANLIB =		@RANLIB@
SRC_DIR =		@srcdir@/..
TOP_DIR =		@srcdir@/..
GENERIC_DIR =		$(TOP_DIR)/generic
UNIX_DIR = 		@srcdir@
BMAP_DIR =		$(TOP_DIR)/bitmaps
TOOL_DIR =		@TCL_SRC_DIR@/tools

#----------------------------------------------------------------
# The information below should be usable as is.  The configure
# script won't modify it and you shouldn't need to modify it
# either.
#----------------------------------------------------------------


CC =		@CC@


CC_SWITCHES =	${CFLAGS} ${TK_SHLIB_CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
-I${BMAP_DIR} -I${TCL_GENERIC_DIR} ${X11_INCLUDES} ${AC_FLAGS} ${PROTO_FLAGS} \

${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} ${KEYSYM_FLAGS}





DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
-I${BMAP_DIR} \
-I${TCL_GENERIC_DIR} ${X11_INCLUDES} \
${AC_FLAGS} ${PROTO_FLAGS} ${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} \
${KEYSYM_FLAGS}

WISH_OBJS = tkAppInit.o



TKTEST_OBJS = tkTestInit.o tkTest.o tkSquare.o

WIDGOBJS = tkButton.o tkEntry.o tkFrame.o tkListbox.o \
	tkMenu.o tkMenubutton.o tkMenuDraw.o tkMessage.o tkScale.o \
	tkScrollbar.o

CANVOBJS = tkCanvas.o tkCanvArc.o tkCanvBmap.o tkCanvImg.o \
	tkCanvLine.o tkCanvPoly.o tkCanvPs.o tkCanvText.o \
	tkCanvUtil.o tkCanvWind.o tkRectOval.o tkTrig.o

IMAGEOBJS = tkImage.o tkImgBmap.o tkImgGIF.o tkImgPPM.o tkImgPhoto.o

TEXTOBJS = tkText.o tkTextBTree.o tkTextDisp.o tkTextImage.o tkTextIndex.o \
	tkTextMark.o tkTextTag.o tkTextWind.o

UNIXOBJS = tkUnix.o tkUnix3d.o tkUnixButton.o tkUnixColor.o tkUnixCursor.o \
	tkUnixDialog.o tkUnixDraw.o \
	tkUnixEmbed.o tkUnixEvent.o tkUnixFocus.o tkUnixFont.o tkUnixInit.o \
	tkUnixMenu.o tkUnixMenubu.o tkUnixScale.o tkUnixScrlbr.o \
	tkUnixSelect.o tkUnixSend.o tkUnixWm.o tkUnixXId.o



OBJS =  tk3d.o tkArgv.o tkAtom.o tkBind.o tkBitmap.o tkClipboard.o tkCmds.o \
	tkColor.o tkConfig.o tkCursor.o tkError.o tkEvent.o \
	tkFocus.o tkFont.o tkGet.o tkGC.o tkGeometry.o tkGrab.o tkGrid.o \
	tkMain.o tkOption.o tkPack.o tkPlace.o \
	tkSelect.o tkUtil.o tkVisual.o tkWindow.o \
	$(UNIXOBJS) $(WIDGOBJS) $(CANVOBJS) $(IMAGEOBJS) $(TEXTOBJS)





SRCS = \
	$(GENERIC_DIR)/tk3d.c $(GENERIC_DIR)/tkArgv.c \
	$(GENERIC_DIR)/tkAtom.c $(GENERIC_DIR)/tkBind.c	\
	$(GENERIC_DIR)/tkBitmap.c $(GENERIC_DIR)/tkClipboard.c \
	$(GENERIC_DIR)/tkCmds.c $(GENERIC_DIR)/tkColor.c \
	$(GENERIC_DIR)/tkConfig.c $(GENERIC_DIR)/tkCursor.c \
	$(GENERIC_DIR)/tkError.c $(GENERIC_DIR)/tkEvent.c \
	$(GENERIC_DIR)/tkFocus.c $(GENERIC_DIR)/tkFont.c \
	$(GENERIC_DIR)/tkGet.c $(GENERIC_DIR)/tkGC.c \
	$(GENERIC_DIR)/tkGeometry.c $(GENERIC_DIR)/tkGrab.c \
	$(GENERIC_DIR)/tkGrid.c \
	$(GENERIC_DIR)/tkMain.c $(GENERIC_DIR)/tkOption.c \
	$(GENERIC_DIR)/tkPack.c $(GENERIC_DIR)/tkPlace.c \
	$(GENERIC_DIR)/tkSelect.c $(GENERIC_DIR)/tkUtil.c \
	$(GENERIC_DIR)/tkVisual.c $(GENERIC_DIR)/tkWindow.c \
	$(GENERIC_DIR)/tkButton.c \
	$(GENERIC_DIR)/tkEntry.c $(GENERIC_DIR)/tkFrame.c \
	$(GENERIC_DIR)/tkListbox.c $(GENERIC_DIR)/tkMenu.c \
	$(GENERIC_DIR)/tkMenubutton.c $(GENERIC_DIR)/tkMenuDraw.c \
	$(GENERIC_DIR)/tkMessage.c \
	$(GENERIC_DIR)/tkScale.c $(GENERIC_DIR)/tkScrollbar.c \
	$(GENERIC_DIR)/tkCanvas.c $(GENERIC_DIR)/tkCanvArc.c \
	$(GENERIC_DIR)/tkCanvBmap.c $(GENERIC_DIR)/tkCanvImg.c \
	$(GENERIC_DIR)/tkCanvLine.c $(GENERIC_DIR)/tkCanvPoly.c \
	$(GENERIC_DIR)/tkCanvPs.c $(GENERIC_DIR)/tkCanvText.c \
	$(GENERIC_DIR)/tkCanvUtil.c \
	$(GENERIC_DIR)/tkCanvWind.c $(GENERIC_DIR)/tkRectOval.c \
	$(GENERIC_DIR)/tkTrig.c $(GENERIC_DIR)/tkImage.c \
	$(GENERIC_DIR)/tkImgBmap.c $(GENERIC_DIR)/tkImgGIF.c \
	$(GENERIC_DIR)/tkImgPPM.c \
	$(GENERIC_DIR)/tkImgPhoto.c $(GENERIC_DIR)/tkText.c \
	$(GENERIC_DIR)/tkTextBTree.c $(GENERIC_DIR)/tkTextDisp.c \
	$(GENERIC_DIR)/tkTextImage.c \
	$(GENERIC_DIR)/tkTextIndex.c $(GENERIC_DIR)/tkTextMark.c \
	$(GENERIC_DIR)/tkTextTag.c $(GENERIC_DIR)/tkTextWind.c \

	$(GENERIC_DIR)/tkSquare.c $(GENERIC_DIR)/tkTest.c \

	$(UNIX_DIR)/tkAppInit.c $(UNIX_DIR)/tkUnix.c \
	$(UNIX_DIR)/tkUnix3d.c \
	$(UNIX_DIR)/tkUnixButton.c $(UNIX_DIR)/tkUnixColor.c \

	$(UNIX_DIR)/tkUnixCursor.c \
	$(UNIX_DIR)/tkUnixDialog.c $(UNIX_DIR)/tkUnixDraw.c \
	$(UNIX_DIR)/tkUnixEmbed.c $(UNIX_DIR)/tkUnixEvent.c \
	$(UNIX_DIR)/tkUnixFocus.c \
	$(UNIX_DIR)/tkUnixFont.c $(UNIX_DIR)/tkUnixInit.c \

	$(UNIX_DIR)/tkUnixMenu.c $(UNIX_DIR)/tkUnixMenubu.c \
	$(UNIX_DIR)/tkUnixScale.c $(UNIX_DIR)/tkUnixScrlbr.c \
	$(UNIX_DIR)/tkUnixSelect.c \
	$(UNIX_DIR)/tkUnixSend.c $(UNIX_DIR)/tkUnixWm.c \
	$(UNIX_DIR)/tkUnixXId.c


HDRS = bltList.h \
	default.h ks_names.h tkPatch.h tk.h tkButton.h tkCanvas.h tkInt.h  \
	tkPort.h tkScrollbar.h tkText.h

DEMOPROGS = browse hello ixset rmt rolodex square tcolor timer widget

all: wish

# The following target is configured by autoconf to generate either
# a shared library or non-shared library for Tk.
@TK_LIB_FILE@: ${OBJS}
	rm -f @TK_LIB_FILE@
	@MAKE_LIB@
	$(RANLIB) @TK_LIB_FILE@






# Make target which outputs the list of the .o contained in the Tk lib
# usefull to build a single big shared library containing Tcl/Tk and other
# extensions.  used for the Tcl Plugin.  -- dl
tkLibObjs:
	@echo ${OBJS}

# This targets actually build the objects needed for the lib in the above
# case
objs: ${OBJS}


wish: $(WISH_OBJS) $(TK_LIB_FILE)
	$(CC) @LD_FLAGS@ $(WISH_OBJS) @TK_BUILD_LIB_SPEC@ $(LIBS) \

		$(TK_CC_SEARCH_FLAGS) -o wish

tktest: $(TKTEST_OBJS) $(TK_LIB_FILE)
	${CC} @LD_FLAGS@ $(TKTEST_OBJS) @TK_BUILD_LIB_SPEC@ $(LIBS) \

		$(TK_CC_SEARCH_FLAGS) -o tktest

xttest: test.o tkTest.o tkSquare.o $(TK_LIB_FILE)
	${CC} @LD_FLAGS@ test.o tkTest.o tkSquare.o \
		@TK_BUILD_LIB_SPEC@ $(LIBS) \
		@TK_LD_SEARCH_FLAGS@ -lXt -o xttest

# Note, in the target below TCL_LIBRARY needs to be set or else
# "make test" won't work in the case where the compilation directory
# isn't the same as the source directory.

test: tktest
	LD_LIBRARY_PATH=`pwd`:${TCL_BIN_DIR}:${LD_LIBRARY_PATH}; \
	export LD_LIBRARY_PATH; \


	TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
	TK_LIBRARY=$(TOP_DIR)/library; export TK_LIBRARY; \
	( echo cd $(TOP_DIR)/tests\; source all\; exit ) \
	| ./tktest -geometry +0+0


# Useful target to launch a built tktest with the proper path,...
runtest:
	LD_LIBRARY_PATH=`pwd`:${TCL_BIN_DIR}:${LD_LIBRARY_PATH}; \
	export LD_LIBRARY_PATH; \


	TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
	TK_LIBRARY=$(TOP_DIR)/library; export TK_LIBRARY; \
	./tktest

install: install-binaries install-libraries install-demos install-man

# Note: before running ranlib below, must cd to target directory because
# some ranlibs write to current directory, and this might not always be
# possible (e.g. if installing as root).

install-binaries: $(TK_LIB_FILE) wish
	@for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) ; \
	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		mkdir $$i; \
		chmod 755 $$i; \
		else true; \
		fi; \
	    done;
	@echo "Installing $(TK_LIB_FILE)"
	@$(INSTALL_DATA) $(TK_LIB_FILE) $(LIB_INSTALL_DIR)/$(TK_LIB_FILE)
	@(cd $(LIB_INSTALL_DIR); $(RANLIB) $(TK_LIB_FILE))
	@chmod 555 $(LIB_INSTALL_DIR)/$(TK_LIB_FILE)
	@echo "Installing wish"
	@$(INSTALL_PROGRAM) wish $(BIN_INSTALL_DIR)/wish$(VERSION)
	@echo "Installing tkConfig.sh"
	@$(INSTALL_DATA) tkConfig.sh $(LIB_INSTALL_DIR)/tkConfig.sh











install-libraries:
	@for i in $(INSTALL_ROOT)$(prefix)/lib $(INCLUDE_INSTALL_DIR) \
		$(SCRIPT_INSTALL_DIR) $(SCRIPT_INSTALL_DIR)/images; \
	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		mkdir $$i; \
		chmod 755 $$i; \
		else true; \
		fi; \
	    done;


	@echo "Installing tk.h"
	@$(INSTALL_DATA) $(GENERIC_DIR)/tk.h $(INCLUDE_INSTALL_DIR)/tk.h

	for i in $(SRC_DIR)/library/*.tcl $(SRC_DIR)/library/tclIndex $(SRC_DIR)/library/prolog.ps $(UNIX_DIR)/tkAppInit.c; \
	    do \
	    echo "Installing $$i"; \
	    $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
	    done;
	for i in $(SRC_DIR)/library/images/*; \
	    do \
	    if [ -f $$i ] ; then \







>
>
>
>
>
>
>
>
>



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


















|
















>
>
|
|
>
|
>
>
>
>









>
>
|














|
|
|
|
|
>
>




|



>
>
>
>















|



















>

>



>

|



>

















|
|

|
>
>
>
>
>






>





|
|
>
|


|
>
|



|
|








>
>

|
<
|
<





>
>

|








|

















>
>
>
>
>
>
>
>
>
>












>
>
|
|
>
|







160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394

395

396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
# The symbols below provide support for dynamic loading and shared
# libraries.  The values of the symbols are normally set by the
# configure script.  You shouldn't normally need to modify any of
# these definitions by hand.

TK_SHLIB_CFLAGS = @TK_SHLIB_CFLAGS@

# To enable support for stubs in Tcl.
STUB_LIB_FILE = @STUB_LIB_FILE@

TK_STUB_LIB_FILE = @TK_STUB_LIB_FILE@
#TK_STUB_LIB_FILE = libtkstub.a

TK_STUB_LIB_FLAG = @TK_STUB_LIB_FLAG@
#TK_STUB_LIB_FLAG = -ltkstub

TK_LIB_FILE = @TK_LIB_FILE@
#TK_LIB_FILE = libtk.a

TK_LIB_FLAG = @TK_LIB_FLAG@
#TK_LIB_FLAG = -ltk

TCL_LIB_SPEC = @TCL_BUILD_LIB_SPEC@
TK_EXP_FILE = @TK_EXP_FILE@
TK_BUILD_EXP_FILE = @TK_BUILD_EXP_FILE@

TCL_STUB_FLAGS = @TCL_STUB_FLAGS@

# Libraries to use when linking.  This definition is determined by the
# configure script.
LIBS = @LIBS@ $(X11_LIB_SWITCHES) @DL_LIBS@ @MATH_LIBS@ -lc
WISH_LIBS = $(TCL_LIB_SPEC) @LIBS@ $(X11_LIB_SWITCHES) @DL_LIBS@ @MATH_LIBS@ -lc

# The symbol below provides support for dynamic loading and shared
# libraries.  See configure.in for a description of what it means.
# The values of the symbolis normally set by the configure script.

SHLIB_LD = @SHLIB_LD@

# Additional search flags needed to find the various shared libraries
# at run-time.  The first symbol is for use when creating a binary
# with cc, and the second is for use when running ld directly.
TK_CC_SEARCH_FLAGS = @TK_CC_SEARCH_FLAGS@
TK_LD_SEARCH_FLAGS = @TK_LD_SEARCH_FLAGS@

#----------------------------------------------------------------
# The information below is modified by the configure script when
# Makefile is generated from Makefile.in.  You shouldn't normally
# modify any of this stuff by hand.
#----------------------------------------------------------------

AC_FLAGS =		@EXTRA_CFLAGS@ @DEFS@
RANLIB =		@RANLIB@
SRC_DIR =		@srcdir@/..
TOP_DIR =		@srcdir@/..
GENERIC_DIR =		$(TOP_DIR)/generic
UNIX_DIR = 		@srcdir@
BMAP_DIR =		$(TOP_DIR)/bitmaps
TOOL_DIR =		@TCL_SRC_DIR@/tools

#----------------------------------------------------------------
# The information below should be usable as is.  The configure
# script won't modify it and you shouldn't need to modify it
# either.
#----------------------------------------------------------------


CC =		@CC@

CC_SWITCHES_NO_STUBS = ${CFLAGS} ${CFLAGS_WARNING} ${TK_SHLIB_CFLAGS} \
-I${UNIX_DIR} -I${GENERIC_DIR} \
-I${BMAP_DIR} -I${TCL_GENERIC_DIR} ${X11_INCLUDES} \
${AC_FLAGS} ${PROTO_FLAGS} \
${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} ${KEYSYM_FLAGS} ${NO_DEPRECATED_FLAGS}

CC_SWITCHES = ${CC_SWITCHES_NO_STUBS} ${TCL_STUB_FLAGS} 



DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
-I${BMAP_DIR} \
-I${TCL_GENERIC_DIR} ${X11_INCLUDES} \
${AC_FLAGS} ${PROTO_FLAGS} ${SECURITY_FLAGS} ${MEM_DEBUG_FLAGS} \
${KEYSYM_FLAGS}

WISH_OBJS = tkAppInit.o

TCLTEST_OBJS = ${TCL_BIN_DIR}/tclTest.o ${TCL_BIN_DIR}/tclThreadTest.o \
        ${TCL_BIN_DIR}/tclUnixTest.o
TKTEST_OBJS = $(TCLTEST_OBJS) tkTestInit.o tkTest.o tkSquare.o

WIDGOBJS = tkButton.o tkEntry.o tkFrame.o tkListbox.o \
	tkMenu.o tkMenubutton.o tkMenuDraw.o tkMessage.o tkScale.o \
	tkScrollbar.o

CANVOBJS = tkCanvas.o tkCanvArc.o tkCanvBmap.o tkCanvImg.o \
	tkCanvLine.o tkCanvPoly.o tkCanvPs.o tkCanvText.o \
	tkCanvUtil.o tkCanvWind.o tkRectOval.o tkTrig.o

IMAGEOBJS = tkImage.o tkImgBmap.o tkImgGIF.o tkImgPPM.o tkImgPhoto.o

TEXTOBJS = tkText.o tkTextBTree.o tkTextDisp.o tkTextImage.o tkTextIndex.o \
	tkTextMark.o tkTextTag.o tkTextWind.o

UNIXOBJS = tkUnix.o tkUnix3d.o tkUnixButton.o tkUnixColor.o tkUnixConfig.o \
	tkUnixCursor.o tkUnixDraw.o tkUnixEmbed.o tkUnixEvent.o \
	tkUnixFocus.o tkUnixFont.o tkUnixInit.o tkUnixKey.o tkUnixMenu.o \
	tkUnixMenubu.o tkUnixScale.o tkUnixScrlbr.o tkUnixSelect.o \
	tkUnixSend.o tkUnixWm.o tkUnixXId.o tkStubInit.o tkStubLib.o

STUB_LIB_OBJS = tkStubLib.o

OBJS =  tk3d.o tkArgv.o tkAtom.o tkBind.o tkBitmap.o tkClipboard.o tkCmds.o \
	tkColor.o tkConfig.o tkCursor.o tkError.o tkEvent.o \
	tkFocus.o tkFont.o tkGet.o tkGC.o tkGeometry.o tkGrab.o tkGrid.o \
	tkMain.o tkObj.o tkOldConfig.o tkOption.o tkPack.o tkPlace.o \
	tkSelect.o tkUtil.o tkVisual.o tkWindow.o \
	$(UNIXOBJS) $(WIDGOBJS) $(CANVOBJS) $(IMAGEOBJS) $(TEXTOBJS)

TK_DECLS = \
	$(GENERIC_DIR)/tk.decls \
	$(GENERIC_DIR)/tkInt.decls

SRCS = \
	$(GENERIC_DIR)/tk3d.c $(GENERIC_DIR)/tkArgv.c \
	$(GENERIC_DIR)/tkAtom.c $(GENERIC_DIR)/tkBind.c	\
	$(GENERIC_DIR)/tkBitmap.c $(GENERIC_DIR)/tkClipboard.c \
	$(GENERIC_DIR)/tkCmds.c $(GENERIC_DIR)/tkColor.c \
	$(GENERIC_DIR)/tkConfig.c $(GENERIC_DIR)/tkCursor.c \
	$(GENERIC_DIR)/tkError.c $(GENERIC_DIR)/tkEvent.c \
	$(GENERIC_DIR)/tkFocus.c $(GENERIC_DIR)/tkFont.c \
	$(GENERIC_DIR)/tkGet.c $(GENERIC_DIR)/tkGC.c \
	$(GENERIC_DIR)/tkGeometry.c $(GENERIC_DIR)/tkGrab.c \
	$(GENERIC_DIR)/tkGrid.c \
	$(GENERIC_DIR)/tkMain.c $(GENERIC_DIR)/tkOption.c \
	$(GENERIC_DIR)/tkPack.c $(GENERIC_DIR)/tkPlace.c \
	$(GENERIC_DIR)/tkSelect.c $(GENERIC_DIR)/tkUtil.c \
	$(GENERIC_DIR)/tkVisual.c $(GENERIC_DIR)/tkWindow.c \
	$(GENERIC_DIR)/tkButton.c $(GENERIC_DIR)/tkObj.c \
	$(GENERIC_DIR)/tkEntry.c $(GENERIC_DIR)/tkFrame.c \
	$(GENERIC_DIR)/tkListbox.c $(GENERIC_DIR)/tkMenu.c \
	$(GENERIC_DIR)/tkMenubutton.c $(GENERIC_DIR)/tkMenuDraw.c \
	$(GENERIC_DIR)/tkMessage.c \
	$(GENERIC_DIR)/tkScale.c $(GENERIC_DIR)/tkScrollbar.c \
	$(GENERIC_DIR)/tkCanvas.c $(GENERIC_DIR)/tkCanvArc.c \
	$(GENERIC_DIR)/tkCanvBmap.c $(GENERIC_DIR)/tkCanvImg.c \
	$(GENERIC_DIR)/tkCanvLine.c $(GENERIC_DIR)/tkCanvPoly.c \
	$(GENERIC_DIR)/tkCanvPs.c $(GENERIC_DIR)/tkCanvText.c \
	$(GENERIC_DIR)/tkCanvUtil.c \
	$(GENERIC_DIR)/tkCanvWind.c $(GENERIC_DIR)/tkRectOval.c \
	$(GENERIC_DIR)/tkTrig.c $(GENERIC_DIR)/tkImage.c \
	$(GENERIC_DIR)/tkImgBmap.c $(GENERIC_DIR)/tkImgGIF.c \
	$(GENERIC_DIR)/tkImgPPM.c \
	$(GENERIC_DIR)/tkImgPhoto.c $(GENERIC_DIR)/tkText.c \
	$(GENERIC_DIR)/tkTextBTree.c $(GENERIC_DIR)/tkTextDisp.c \
	$(GENERIC_DIR)/tkTextImage.c \
	$(GENERIC_DIR)/tkTextIndex.c $(GENERIC_DIR)/tkTextMark.c \
	$(GENERIC_DIR)/tkTextTag.c $(GENERIC_DIR)/tkTextWind.c \
	$(GENERIC_DIR)/tkOldConfig.c \
	$(GENERIC_DIR)/tkSquare.c $(GENERIC_DIR)/tkTest.c \
	$(GENERIC_DIR)/tkStubInit.c $(GENERIC_DIR)/tkStubLib.c \
	$(UNIX_DIR)/tkAppInit.c $(UNIX_DIR)/tkUnix.c \
	$(UNIX_DIR)/tkUnix3d.c \
	$(UNIX_DIR)/tkUnixButton.c $(UNIX_DIR)/tkUnixColor.c \
	$(UNIX_DIR)/tkUnixConfig.c \
	$(UNIX_DIR)/tkUnixCursor.c \
	$(UNIX_DIR)/tkUnixDraw.c \
	$(UNIX_DIR)/tkUnixEmbed.c $(UNIX_DIR)/tkUnixEvent.c \
	$(UNIX_DIR)/tkUnixFocus.c \
	$(UNIX_DIR)/tkUnixFont.c $(UNIX_DIR)/tkUnixInit.c \
	$(UNIX_DIR)/tkUnixKey.c \
	$(UNIX_DIR)/tkUnixMenu.c $(UNIX_DIR)/tkUnixMenubu.c \
	$(UNIX_DIR)/tkUnixScale.c $(UNIX_DIR)/tkUnixScrlbr.c \
	$(UNIX_DIR)/tkUnixSelect.c \
	$(UNIX_DIR)/tkUnixSend.c $(UNIX_DIR)/tkUnixWm.c \
	$(UNIX_DIR)/tkUnixXId.c


HDRS = bltList.h \
	default.h ks_names.h tkPatch.h tk.h tkButton.h tkCanvas.h tkInt.h  \
	tkPort.h tkScrollbar.h tkText.h

DEMOPROGS = browse hello ixset rmt rolodex square tcolor timer widget

all: wish

# The following target is configured by autoconf to generate either
# a shared library or non-shared library for Tk.
${TK_LIB_FILE}: ${OBJS}
	rm -f ${TK_LIB_FILE}
	@MAKE_LIB@
	$(RANLIB) ${TK_LIB_FILE}

${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
	rm -f ${STUB_LIB_FILE}
	@MAKE_STUB_LIB@
	$(RANLIB) ${STUB_LIB_FILE}

# Make target which outputs the list of the .o contained in the Tk lib
# usefull to build a single big shared library containing Tcl/Tk and other
# extensions.  used for the Tcl Plugin.  -- dl
tkLibObjs:
	@echo ${OBJS}

# This targets actually build the objects needed for the lib in the above
# case
objs: ${OBJS}


wish: $(WISH_OBJS) $(TK_LIB_FILE) $(TK_STUB_LIB_FILE)
	$(CC) @LD_FLAGS@ $(WISH_OBJS) \
		@TK_BUILD_LIB_SPEC@ \
		$(WISH_LIBS) $(TK_CC_SEARCH_FLAGS) -o wish

tktest: $(TKTEST_OBJS) $(TK_LIB_FILE)
	${CC} @LD_FLAGS@ $(TKTEST_OBJS) \
		@TK_BUILD_LIB_SPEC@ \
		$(WISH_LIBS) $(TK_CC_SEARCH_FLAGS) -o tktest

xttest: test.o tkTest.o tkSquare.o $(TK_LIB_FILE)
	${CC} @LD_FLAGS@ test.o tkTest.o tkSquare.o \
		@TK_BUILD_LIB_SPEC@ \
		$(WISH_LIBS) $(TK_LD_SEARCH_FLAGS) -lXt -o xttest

# Note, in the target below TCL_LIBRARY needs to be set or else
# "make test" won't work in the case where the compilation directory
# isn't the same as the source directory.

test: tktest
	LD_LIBRARY_PATH=`pwd`:${TCL_BIN_DIR}:${LD_LIBRARY_PATH}; \
	export LD_LIBRARY_PATH; \
	SHLIB_PATH=`pwd`:${TCL_BIN_DIR}:${SHLIB_PATH}; \
	export SHLIB_PATH; \
	TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
	TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \

	./tktest $(TOP_DIR)/tests/all.tcl -geometry +0+0


# Useful target to launch a built tktest with the proper path,...
runtest:
	LD_LIBRARY_PATH=`pwd`:${TCL_BIN_DIR}:${LD_LIBRARY_PATH}; \
	export LD_LIBRARY_PATH; \
	SHLIB_PATH=`pwd`:${TCL_BIN_DIR}:${SHLIB_PATH}; \
	export SHLIB_PATH; \
	TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
	TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \
	./tktest

install: install-binaries install-libraries install-demos install-man

# Note: before running ranlib below, must cd to target directory because
# some ranlibs write to current directory, and this might not always be
# possible (e.g. if installing as root).

install-binaries: $(TK_LIB_FILE) $(TK_STUB_LIB_FILE) $(TK_BUILD_EXP_FILE) wish
	@for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) ; \
	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		mkdir $$i; \
		chmod 755 $$i; \
		else true; \
		fi; \
	    done;
	@echo "Installing $(TK_LIB_FILE)"
	@$(INSTALL_DATA) $(TK_LIB_FILE) $(LIB_INSTALL_DIR)/$(TK_LIB_FILE)
	@(cd $(LIB_INSTALL_DIR); $(RANLIB) $(TK_LIB_FILE))
	@chmod 555 $(LIB_INSTALL_DIR)/$(TK_LIB_FILE)
	@echo "Installing wish"
	@$(INSTALL_PROGRAM) wish $(BIN_INSTALL_DIR)/wish$(VERSION)
	@echo "Installing tkConfig.sh"
	@$(INSTALL_DATA) tkConfig.sh $(LIB_INSTALL_DIR)/tkConfig.sh
	@if test "$(TK_BUILD_EXP_FILE)" != ""; then \
	    echo "Installing $(TK_EXP_FILE)"; \
	    $(INSTALL_DATA) $(TK_BUILD_EXP_FILE) \
			$(LIB_INSTALL_DIR)/$(TK_EXP_FILE); \
	    fi
	@if test "$(TK_STUB_LIB_FILE)" != "" ; then \
	    echo "Installing $(TK_STUB_LIB_FILE)"; \
	    $(INSTALL_DATA) $(STUB_LIB_FILE) \
			 $(LIB_INSTALL_DIR)/$(TK_STUB_LIB_FILE); \
	    fi

install-libraries:
	@for i in $(INSTALL_ROOT)$(prefix)/lib $(INCLUDE_INSTALL_DIR) \
		$(SCRIPT_INSTALL_DIR) $(SCRIPT_INSTALL_DIR)/images; \
	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		mkdir $$i; \
		chmod 755 $$i; \
		else true; \
		fi; \
	    done;
	@for i in $(GENERIC_DIR)/tk.h $(GENERIC_DIR)/tkDecls.h ; \
	    do \
	    echo "Installing $$i"; \
	    $(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR); \
	    done;
	for i in $(SRC_DIR)/library/*.tcl $(SRC_DIR)/library/tclIndex $(UNIX_DIR)/tkAppInit.c; \
	    do \
	    echo "Installing $$i"; \
	    $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
	    done;
	for i in $(SRC_DIR)/library/images/*; \
	    do \
	    if [ -f $$i ] ; then \
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

clean:
	rm -f *.a *.o libtk* core errs *~ \#* TAGS *.E a.out errors \
		tktest wish config.info lib.exp

distclean: clean
	rm -f Makefile config.status config.cache config.log tkConfig.sh \
		SUNWtk.* prototype

depend:
	makedepend -- $(DEPEND_SWITCHES) -- $(SRCS)

# Test binaries.  The rule for tkTestInit.o is complicated because
# it is is compiled from tkAppInit.c.  Can't use the "-o" option
# because this doesn't work on some strange compilers (e.g. UnixWare).

tkTestInit.o: $(UNIX_DIR)/tkAppInit.c
	@if test -f tkAppInit.o ; then \
	    rm -f tkAppInit.sav; \
	    mv tkAppInit.o tkAppInit.sav; \
	fi;
	$(CC) -c $(CC_SWITCHES) -DTK_TEST $(UNIX_DIR)/tkAppInit.c
	rm -f tkTestInit.o
	mv tkAppInit.o tkTestInit.o
	@if test -f tkAppInit.sav ; then \
	    mv tkAppInit.sav tkAppInit.o; \
	fi;




tk3d.o: $(GENERIC_DIR)/tk3d.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tk3d.c

tkAppInit.o: $(UNIX_DIR)/tkAppInit.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkAppInit.c

tkArgv.o: $(GENERIC_DIR)/tkArgv.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkArgv.c

tkAtom.o: $(GENERIC_DIR)/tkAtom.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkAtom.c

tkBind.o: $(GENERIC_DIR)/tkBind.c







|













|






>
>
>



<
<
<







543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576



577
578
579
580
581
582
583

clean:
	rm -f *.a *.o libtk* core errs *~ \#* TAGS *.E a.out errors \
		tktest wish config.info lib.exp

distclean: clean
	rm -f Makefile config.status config.cache config.log tkConfig.sh \
		$(PACKAGE).* prototype

depend:
	makedepend -- $(DEPEND_SWITCHES) -- $(SRCS)

# Test binaries.  The rule for tkTestInit.o is complicated because
# it is is compiled from tkAppInit.c.  Can't use the "-o" option
# because this doesn't work on some strange compilers (e.g. UnixWare).

tkTestInit.o: $(UNIX_DIR)/tkAppInit.c
	@if test -f tkAppInit.o ; then \
	    rm -f tkAppInit.sav; \
	    mv tkAppInit.o tkAppInit.sav; \
	fi;
	$(CC) -c $(CC_SWITCHES_NO_STUBS) -DTK_TEST $(UNIX_DIR)/tkAppInit.c
	rm -f tkTestInit.o
	mv tkAppInit.o tkTestInit.o
	@if test -f tkAppInit.sav ; then \
	    mv tkAppInit.sav tkAppInit.o; \
	fi;

tkAppInit.o: $(UNIX_DIR)/tkAppInit.c
	$(CC) -c $(CC_SWITCHES_NO_STUBS) $(UNIX_DIR)/tkAppInit.c

tk3d.o: $(GENERIC_DIR)/tk3d.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tk3d.c




tkArgv.o: $(GENERIC_DIR)/tkArgv.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkArgv.c

tkAtom.o: $(GENERIC_DIR)/tkAtom.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkAtom.c

tkBind.o: $(GENERIC_DIR)/tkBind.c
544
545
546
547
548
549
550






551
552
553
554
555
556
557

tkGrid.o: $(GENERIC_DIR)/tkGrid.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGrid.c

tkMain.o: $(GENERIC_DIR)/tkMain.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMain.c







tkOption.o: $(GENERIC_DIR)/tkOption.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkOption.c

tkPack.o: $(GENERIC_DIR)/tkPack.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkPack.c

tkPlace.o: $(GENERIC_DIR)/tkPlace.c







>
>
>
>
>
>







627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646

tkGrid.o: $(GENERIC_DIR)/tkGrid.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGrid.c

tkMain.o: $(GENERIC_DIR)/tkMain.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMain.c

tkObj.o: $(GENERIC_DIR)/tkObj.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkObj.c

tkOldConfig.o: $(GENERIC_DIR)/tkOldConfig.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkOldConfig.c

tkOption.o: $(GENERIC_DIR)/tkOption.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkOption.c

tkPack.o: $(GENERIC_DIR)/tkPack.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkPack.c

tkPlace.o: $(GENERIC_DIR)/tkPlace.c
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
tkScale.o: $(GENERIC_DIR)/tkScale.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkScale.c

tkScrollbar.o: $(GENERIC_DIR)/tkScrollbar.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkScrollbar.c

tkSquare.o: $(GENERIC_DIR)/tkSquare.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkSquare.c

tkCanvas.o: $(GENERIC_DIR)/tkCanvas.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvas.c

tkCanvArc.o: $(GENERIC_DIR)/tkCanvArc.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvArc.c








|







685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
tkScale.o: $(GENERIC_DIR)/tkScale.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkScale.c

tkScrollbar.o: $(GENERIC_DIR)/tkScrollbar.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkScrollbar.c

tkSquare.o: $(GENERIC_DIR)/tkSquare.c
	$(CC) -c $(CC_SWITCHES_NO_STUBS) $(GENERIC_DIR)/tkSquare.c

tkCanvas.o: $(GENERIC_DIR)/tkCanvas.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvas.c

tkCanvArc.o: $(GENERIC_DIR)/tkCanvArc.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvArc.c

650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
tkImgPPM.o: $(GENERIC_DIR)/tkImgPPM.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPPM.c

tkImgPhoto.o: $(GENERIC_DIR)/tkImgPhoto.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPhoto.c

tkTest.o: $(GENERIC_DIR)/tkTest.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTest.c

tkText.o: $(GENERIC_DIR)/tkText.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkText.c

tkTextBTree.o: $(GENERIC_DIR)/tkTextBTree.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextBTree.c








|







739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
tkImgPPM.o: $(GENERIC_DIR)/tkImgPPM.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPPM.c

tkImgPhoto.o: $(GENERIC_DIR)/tkImgPhoto.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPhoto.c

tkTest.o: $(GENERIC_DIR)/tkTest.c
	$(CC) -c $(CC_SWITCHES_NO_STUBS) $(GENERIC_DIR)/tkTest.c

tkText.o: $(GENERIC_DIR)/tkText.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkText.c

tkTextBTree.o: $(GENERIC_DIR)/tkTextBTree.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextBTree.c

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

tkTextTag.o: $(GENERIC_DIR)/tkTextTag.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextTag.c

tkTextWind.o: $(GENERIC_DIR)/tkTextWind.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextWind.c










tkUnix.o: $(UNIX_DIR)/tkUnix.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnix.c

tkUnix3d.o: $(UNIX_DIR)/tkUnix3d.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnix3d.c

tkUnixButton.o: $(UNIX_DIR)/tkUnixButton.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixButton.c

tkUnixColor.o: $(UNIX_DIR)/tkUnixColor.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixColor.c




tkUnixCursor.o: $(UNIX_DIR)/tkUnixCursor.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixCursor.c

tkUnixDialog.o: $(UNIX_DIR)/tkUnixDialog.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixDialog.c

tkUnixDraw.o: $(UNIX_DIR)/tkUnixDraw.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixDraw.c

tkUnixEmbed.o: $(UNIX_DIR)/tkUnixEmbed.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixEmbed.c

tkUnixEvent.o: $(UNIX_DIR)/tkUnixEvent.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixEvent.c

tkUnixFocus.o: $(UNIX_DIR)/tkUnixFocus.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixFocus.c

tkUnixFont.o: $(UNIX_DIR)/tkUnixFont.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixFont.c

tkUnixInit.o: $(UNIX_DIR)/tkUnixInit.c $(GENERIC_DIR)/tkInitScript.h tkConfig.sh
	$(CC) -c $(CC_SWITCHES) -DTK_LIBRARY=\"${TK_LIBRARY}\" \
	    $(UNIX_DIR)/tkUnixInit.c




tkUnixMenu.o: $(UNIX_DIR)/tkUnixMenu.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixMenu.c

tkUnixMenubu.o: $(UNIX_DIR)/tkUnixMenubu.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixMenubu.c

tkUnixScale.o: $(UNIX_DIR)/tkUnixScale.c







>
>
>
>
>
>
>
>
>












>
>
>



<
<
<



















>
>
>







765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798



799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827

tkTextTag.o: $(GENERIC_DIR)/tkTextTag.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextTag.c

tkTextWind.o: $(GENERIC_DIR)/tkTextWind.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextWind.c

tkStubInit.o: $(GENERIC_DIR)/tkStubInit.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStubInit.c

# Stub library binaries, these must be compiled for use in a shared library
# even though they will be placed in a static archive

tkStubLib.o: $(GENERIC_DIR)/tkStubLib.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStubLib.c

tkUnix.o: $(UNIX_DIR)/tkUnix.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnix.c

tkUnix3d.o: $(UNIX_DIR)/tkUnix3d.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnix3d.c

tkUnixButton.o: $(UNIX_DIR)/tkUnixButton.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixButton.c

tkUnixColor.o: $(UNIX_DIR)/tkUnixColor.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixColor.c

tkUnixConfig.o: $(UNIX_DIR)/tkUnixConfig.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixConfig.c

tkUnixCursor.o: $(UNIX_DIR)/tkUnixCursor.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixCursor.c




tkUnixDraw.o: $(UNIX_DIR)/tkUnixDraw.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixDraw.c

tkUnixEmbed.o: $(UNIX_DIR)/tkUnixEmbed.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixEmbed.c

tkUnixEvent.o: $(UNIX_DIR)/tkUnixEvent.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixEvent.c

tkUnixFocus.o: $(UNIX_DIR)/tkUnixFocus.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixFocus.c

tkUnixFont.o: $(UNIX_DIR)/tkUnixFont.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixFont.c

tkUnixInit.o: $(UNIX_DIR)/tkUnixInit.c $(GENERIC_DIR)/tkInitScript.h tkConfig.sh
	$(CC) -c $(CC_SWITCHES) -DTK_LIBRARY=\"${TK_LIBRARY}\" \
	    $(UNIX_DIR)/tkUnixInit.c

tkUnixKey.o: $(UNIX_DIR)/tkUnixKey.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixKey.c

tkUnixMenu.o: $(UNIX_DIR)/tkUnixMenu.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixMenu.c

tkUnixMenubu.o: $(UNIX_DIR)/tkUnixMenubu.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixMenubu.c

tkUnixScale.o: $(UNIX_DIR)/tkUnixScale.c
754
755
756
757
758
759
760


























761
762
763
764
765
766
767

768
769
770
771
772
773
774
775
776
777
#
# Target to make sure that only symbols with "Tk" prefixes are
# exported.
#

checkexports: $(TK_LIB_FILE)
	-nm -p $(TK_LIB_FILE) | awk '$$2 ~ /[TDB]/ { print $$3 }' | sort -n | grep -v '^[Tt]k'



























#
# Target to create a proper Tk distribution from information in the
# master source directory.  DISTDIR must be defined to indicate where
# to put the distribution.  DISTDIR must be an absolute path name.
#


DISTNAME =	tk@TK_VERSION@@TK_PATCH_LEVEL@
ZIPNAME =	tk@TK_MAJOR_VERSION@@TK_MINOR_VERSION@@[email protected]
DISTDIR =	/proj/tcl/dist/$(DISTNAME)
TCLDIR = 	@TCL_SRC_DIR@
$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.in
	autoconf $(UNIX_DIR)/configure.in > $(UNIX_DIR)/configure

dist:   $(UNIX_DIR)/configure
	rm -rf $(DISTDIR)
	mkdir $(DISTDIR)







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







>


|







855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
#
# Target to make sure that only symbols with "Tk" prefixes are
# exported.
#

checkexports: $(TK_LIB_FILE)
	-nm -p $(TK_LIB_FILE) | awk '$$2 ~ /[TDB]/ { print $$3 }' | sort -n | grep -v '^[Tt]k'

# Target to regenerate header files and stub files from the *.decls tables.
#

genstubs:
	tclsh $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
		$(GENERIC_DIR)/tk.decls $(GENERIC_DIR)/tkInt.decls

#
# Target to check that all exported functions have an entry in the stubs
# tables.
#

checkstubs:
	-@for i in `nm -p $(TK_LIB_FILE) | awk '$$2 ~ /T/ { print $$3 }' \
		| sort -n`; do \
		match=0; \
		for j in $(TK_DECLS); do \
		    if [ `grep -c $$i $$j` -gt 0 ]; then \
			match=1; \
		    fi; \
		done; \
		if [ $$match -eq 0 ]; then echo $$i; fi \
	done



#
# Target to create a proper Tk distribution from information in the
# master source directory.  DISTDIR must be defined to indicate where
# to put the distribution.  DISTDIR must be an absolute path name.
#

DISTROOT = /tmp/dist
DISTNAME =	tk@TK_VERSION@@TK_PATCH_LEVEL@
ZIPNAME =	tk@TK_MAJOR_VERSION@@TK_MINOR_VERSION@@[email protected]
DISTDIR =	$(DISTROOT)/$(DISTNAME)
TCLDIR = 	@TCL_SRC_DIR@
$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.in
	autoconf $(UNIX_DIR)/configure.in > $(UNIX_DIR)/configure

dist:   $(UNIX_DIR)/configure
	rm -rf $(DISTDIR)
	mkdir $(DISTDIR)
792
793
794
795
796
797
798
799

800
801
802
803
804
805

806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
	@(cd $(TOP_DIR); for i in bitmaps/* ; do \
	    if [ -f $$i ] ; then \
		sed -e 's/static char/static unsigned char/' \
		       $$i > $(DISTDIR)/$$i; \
	    fi; \
	done;)
	mkdir $(DISTDIR)/generic
	cp -p $(GENERIC_DIR)/*.c $(GENERIC_DIR)/*.h $(DISTDIR)/generic

	cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic
	cp -p $(TOP_DIR)/changes $(TOP_DIR)/README $(TOP_DIR)/license.terms \
		$(DISTDIR)
	rm -f $(DISTDIR)/generic/blt*.[ch]
	mkdir $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/*.c $(TOP_DIR)/win/*.h $(DISTDIR)/win

	cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/README $(DISTDIR)/win
	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win
	mkdir $(DISTDIR)/win/rc
	cp -p $(TOP_DIR)/win/rc/*.rc $(TOP_DIR)/win/rc/*.cur \
		$(TOP_DIR)/win/rc/*.ico $(TOP_DIR)/win/rc/*.bmp \
		$(DISTDIR)/win/rc
	mkdir $(DISTDIR)/mac
	sccs edit -s $(TOP_DIR)/mac/tkMacProjects.sit.hqx
	cp -p tkMacProjects.sit.hqx $(DISTDIR)/mac
	sccs unedit $(TOP_DIR)/mac/tkMacProjects.sit.hqx
	rm -f tkMacProjects.sit.hqx
	cp -p $(TOP_DIR)/mac/*.c $(TOP_DIR)/mac/*.h $(TOP_DIR)/mac/*.r \
		$(DISTDIR)/mac
	cp -p $(TOP_DIR)/mac/README $(DISTDIR)/mac
	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/mac
	cp -p $(TOP_DIR)/mac/*.pch $(DISTDIR)/mac
	cp -p $(TOP_DIR)/mac/*.doc $(DISTDIR)/mac
	cp -p $(TOP_DIR)/mac/*.exp $(DISTDIR)/mac
	cp -p $(TOP_DIR)/mac/*.tcl $(DISTDIR)/mac
	mkdir $(DISTDIR)/compat
	cp -p $(TOP_DIR)/license.terms $(TCLDIR)/compat/unistd.h \
		$(TCLDIR)/compat/stdlib.h $(TCLDIR)/compat/limits.h \
		$(DISTDIR)/compat
	mkdir $(DISTDIR)/xlib
	cp -p $(TOP_DIR)/xlib/*.h $(TOP_DIR)/xlib/*.c $(DISTDIR)/xlib
	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/xlib
	mkdir $(DISTDIR)/xlib/X11
	cp -p $(TOP_DIR)/xlib/X11/*.h $(DISTDIR)/xlib/X11
	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/xlib/X11
	mkdir $(DISTDIR)/library
	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
		$(TOP_DIR)/library/tclIndex $(TOP_DIR)/library/prolog.ps \
		$(DISTDIR)/library
	mkdir $(DISTDIR)/library/images
	@(cd $(TOP_DIR); for i in library/images/* ; do \
	    if [ -f $$i ] ; then \
		cp $$i $(DISTDIR)/$$i; \
	    fi; \
	done;)







|
>






>








<
<
|
<




















|







920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943


944

945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
	@(cd $(TOP_DIR); for i in bitmaps/* ; do \
	    if [ -f $$i ] ; then \
		sed -e 's/static char/static unsigned char/' \
		       $$i > $(DISTDIR)/$$i; \
	    fi; \
	done;)
	mkdir $(DISTDIR)/generic
	cp -p $(GENERIC_DIR)/*.c $(GENERIC_DIR)/*.h $(GENERIC_DIR)/prolog.ps \
		$(DISTDIR)/generic
	cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic
	cp -p $(TOP_DIR)/changes $(TOP_DIR)/README $(TOP_DIR)/license.terms \
		$(DISTDIR)
	rm -f $(DISTDIR)/generic/blt*.[ch]
	mkdir $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/*.c $(TOP_DIR)/win/*.h $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/README $(DISTDIR)/win
	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win
	mkdir $(DISTDIR)/win/rc
	cp -p $(TOP_DIR)/win/rc/*.rc $(TOP_DIR)/win/rc/*.cur \
		$(TOP_DIR)/win/rc/*.ico $(TOP_DIR)/win/rc/*.bmp \
		$(DISTDIR)/win/rc
	mkdir $(DISTDIR)/mac


	cp -p $(TOP_DIR)/mac/tkMacProjects.sea.hqx $(DISTDIR)/mac

	cp -p $(TOP_DIR)/mac/*.c $(TOP_DIR)/mac/*.h $(TOP_DIR)/mac/*.r \
		$(DISTDIR)/mac
	cp -p $(TOP_DIR)/mac/README $(DISTDIR)/mac
	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/mac
	cp -p $(TOP_DIR)/mac/*.pch $(DISTDIR)/mac
	cp -p $(TOP_DIR)/mac/*.doc $(DISTDIR)/mac
	cp -p $(TOP_DIR)/mac/*.exp $(DISTDIR)/mac
	cp -p $(TOP_DIR)/mac/*.tcl $(DISTDIR)/mac
	mkdir $(DISTDIR)/compat
	cp -p $(TOP_DIR)/license.terms $(TCLDIR)/compat/unistd.h \
		$(TCLDIR)/compat/stdlib.h $(TCLDIR)/compat/limits.h \
		$(DISTDIR)/compat
	mkdir $(DISTDIR)/xlib
	cp -p $(TOP_DIR)/xlib/*.h $(TOP_DIR)/xlib/*.c $(DISTDIR)/xlib
	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/xlib
	mkdir $(DISTDIR)/xlib/X11
	cp -p $(TOP_DIR)/xlib/X11/*.h $(DISTDIR)/xlib/X11
	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/xlib/X11
	mkdir $(DISTDIR)/library
	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
		$(TOP_DIR)/library/tclIndex \
		$(DISTDIR)/library
	mkdir $(DISTDIR)/library/images
	@(cd $(TOP_DIR); for i in library/images/* ; do \
	    if [ -f $$i ] ; then \
		cp $$i $(DISTDIR)/$$i; \
	    fi; \
	done;)
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942


943
944
945
946
947
948
949
	    if [ -f $$i ] ; then \
		cp $$i $(DISTDIR)/$$i; \
	    fi; \
	done;)
	mkdir $(DISTDIR)/doc
	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \
		$(TCLDIR)/doc/man.macros $(DISTDIR)/doc
	cp /home/ouster/papers/tk4.0/tk4.0.ps $(DISTDIR)/doc
	mkdir $(DISTDIR)/tests
	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/tests/*.test \
		$(TOP_DIR)/tests/visual $(TOP_DIR)/tests/*.tcl \
		$(TOP_DIR)/tests/README $(TOP_DIR)/tests/all \
		$(TOP_DIR)/tests/defs $(TOP_DIR)/tests/option.file* \
		$(DISTDIR)/tests

#
# The following target can only be used for non-patch releases.  Use
# the "allpatch" target below for patch releases.
#

alldist: dist
	rm -f /proj/tcl/dist/$(DISTNAME).tar.Z \
		/proj/tcl/dist/$(DISTNAME).tar.gz \
		/proj/tcl/dist/$(ZIPNAME)
	cd /proj/tcl/dist; tar cf $(DISTNAME).tar $(DISTNAME); \
		gzip -9 -c $(DISTNAME).tar > $(DISTNAME).tar.gz; \
		compress $(DISTNAME).tar; zip -r8 $(ZIPNAME) $(DISTNAME)

#
# The target below is similar to "alldist" except it works for patch
# releases.  It is needed because patch releases are peculiar: the
# patch designation appears in the name of the compressed file
# (e.g. tcl8.0p1.tar.gz) but the extracted source directory doesn't
# include the patch designation (e.g. tcl8.0).
#

allpatch: dist
	rm -f /proj/tcl/dist/$(DISTNAME).tar.Z \
		/proj/tcl/dist/$(DISTNAME).tar.gz \
		/proj/tcl/dist/$(ZIPNAME)
	mv /proj/tcl/dist/tk${VERSION} /proj/tcl/dist/old
	mv /proj/tcl/dist/$(DISTNAME) /proj/tcl/dist/tk${VERSION}
	cd /proj/tcl/dist; tar cf $(DISTNAME).tar tk${VERSION}; \
		gzip -9 -c $(DISTNAME).tar > $(DISTNAME).tar.gz; \
		compress $(DISTNAME).tar; zip -r8 $(ZIPNAME) tk${VERSION}
	mv /proj/tcl/dist/tk${VERSION} /proj/tcl/dist/$(DISTNAME)
	mv /proj/tcl/dist/old /proj/tcl/dist/tk${VERSION}

#
# Target to create a Macintosh version of the distribution.  This will
# do a normal distribution and then massage the output to prepare it
# for moving to the Mac platform.  This requires a few scripts and
# programs found only in the Tcl greoup's tool workspace.
#

macdist: dist
	rm -f $(DISTDIR)/mac/tkMacProjects.sit.hqx
	tclsh $(TOOL_DIR)/man2html.tcl $(DISTDIR)/tmp ../.. tk$(VERSION)
	mv $(DISTDIR)/tmp/tk$(VERSION) $(DISTDIR)/html
	rm -rf $(DISTDIR)/doc
	rm -rf $(DISTDIR)/tmp
	tclsh $(TOOL_DIR)/cvtEOL.tcl $(DISTDIR)

#
# Targets to build Solaris package of the distribution for the current
# architecture.  To build stream packages for both sun4 and i86pc
# architectures: 
#
#   On the sun4 machine, execute the following:
#     make distclean; ./configure
#     make DISTDIR=<distdir> package
#
#   Once the build is complete, execute the following on the i86pc
#   machine:
#     make DISTDIR=<distdir> package-quick
#
# <distdir> is the absolute path to a directory where the build should
# take place.  These steps will generate the SUNWtk.sun4 and
# SUNWtk.i86pc stream packages.  It is important that the packages be
# built in this fashion in order to ensure that the architecture
# independent files are exactly the same, including timestamps, in
# both packages.
#



package: dist package-config package-common package-binaries package-generate
package-quick: package-config package-binaries package-generate

#
# Configure for the current architecture in the dist directory.
#







<


<
|
|
<







|
|
|
|

|










|
|
|
|
|
|


|
|









|




















|
|




>
>







987
988
989
990
991
992
993

994
995

996
997

998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
	    if [ -f $$i ] ; then \
		cp $$i $(DISTDIR)/$$i; \
	    fi; \
	done;)
	mkdir $(DISTDIR)/doc
	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \
		$(TCLDIR)/doc/man.macros $(DISTDIR)/doc

	mkdir $(DISTDIR)/tests
	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/tests/*.test \

		$(TOP_DIR)/tests/*.tcl $(TOP_DIR)/tests/README \
		$(TOP_DIR)/tests/option.file* $(DISTDIR)/tests


#
# The following target can only be used for non-patch releases.  Use
# the "allpatch" target below for patch releases.
#

alldist: dist
	rm -f $(DISTROOT)/$(DISTNAME).tar.Z \
		$(DISTROOT)/$(DISTNAME).tar.gz \
		$(DISTROOT)/$(ZIPNAME)
	cd $(DISTROOT); tar cf $(DISTNAME).tar $(DISTNAME); \
		gzip -9 -c $(DISTNAME).tar > $(DISTNAME).tar.gz; \
		compress $(DISTNAME).tar; zip -qr8 $(ZIPNAME) $(DISTNAME)

#
# The target below is similar to "alldist" except it works for patch
# releases.  It is needed because patch releases are peculiar: the
# patch designation appears in the name of the compressed file
# (e.g. tcl8.0p1.tar.gz) but the extracted source directory doesn't
# include the patch designation (e.g. tcl8.0).
#

allpatch: dist
	rm -f $(DISTROOT)/$(DISTNAME).tar.Z \
		$(DISTROOT)/$(DISTNAME).tar.gz \
		$(DISTROOT)/$(ZIPNAME)
	mv $(DISTROOT)/tk${VERSION} $(DISTROOT)/old
	mv $(DISTROOT)/$(DISTNAME) $(DISTROOT)/tk${VERSION}
	cd $(DISTROOT); tar cf $(DISTNAME).tar tk${VERSION}; \
		gzip -9 -c $(DISTNAME).tar > $(DISTNAME).tar.gz; \
		compress $(DISTNAME).tar; zip -r8 $(ZIPNAME) tk${VERSION}
	mv $(DISTROOT)/tk${VERSION} $(DISTROOT)/$(DISTNAME)
	mv $(DISTROOT)/old $(DISTROOT)/tk${VERSION}

#
# Target to create a Macintosh version of the distribution.  This will
# do a normal distribution and then massage the output to prepare it
# for moving to the Mac platform.  This requires a few scripts and
# programs found only in the Tcl greoup's tool workspace.
#

macdist: dist
	rm -f $(DISTDIR)/mac/tkMacProjects.sea.hqx
	tclsh $(TOOL_DIR)/man2html.tcl $(DISTDIR)/tmp ../.. tk$(VERSION)
	mv $(DISTDIR)/tmp/tk$(VERSION) $(DISTDIR)/html
	rm -rf $(DISTDIR)/doc
	rm -rf $(DISTDIR)/tmp
	tclsh $(TOOL_DIR)/cvtEOL.tcl $(DISTDIR)

#
# Targets to build Solaris package of the distribution for the current
# architecture.  To build stream packages for both sun4 and i86pc
# architectures: 
#
#   On the sun4 machine, execute the following:
#     make distclean; ./configure
#     make DISTDIR=<distdir> package
#
#   Once the build is complete, execute the following on the i86pc
#   machine:
#     make DISTDIR=<distdir> package-quick
#
# <distdir> is the absolute path to a directory where the build should
# take place.  These steps will generate the $(PACKAGE).sun4 and
# $(PACKAGE).i86pc stream packages.  It is important that the packages be
# built in this fashion in order to ensure that the architecture
# independent files are exactly the same, including timestamps, in
# both packages.
#

PACKAGE=SCRPtk

package: dist package-config package-common package-binaries package-generate
package-quick: package-config package-binaries package-generate

#
# Configure for the current architecture in the dist directory.
#
993
994
995
996
997
998
999
1000
1001
1002
1003
		 $(DISTDIR)/SUNWtcl/$(TCLVERSION)/include=include \
		 $(DISTDIR)/SUNWtcl/$(TCLVERSION)/lib=lib \
		 $(DISTDIR)/SUNWtcl/$(TCLVERSION)/man=man \
		 $(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch`=`arch` \
	| tclsh $(TCLDIR)/unix/mkProto.tcl $(TCLVERSION) \
		$(UNIX_DIR) > prototype
	pkgmk -o -d . -f prototype -a `arch`
	pkgtrans -s . SUNWtk.`arch` SUNWtk
	rm -rf SUNWtk

# DO NOT DELETE THIS LINE -- make depend depends on it.







|
|


1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
		 $(DISTDIR)/SUNWtcl/$(TCLVERSION)/include=include \
		 $(DISTDIR)/SUNWtcl/$(TCLVERSION)/lib=lib \
		 $(DISTDIR)/SUNWtcl/$(TCLVERSION)/man=man \
		 $(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch`=`arch` \
	| tclsh $(TCLDIR)/unix/mkProto.tcl $(TCLVERSION) \
		$(UNIX_DIR) > prototype
	pkgmk -o -d . -f prototype -a `arch`
	pkgtrans -s . $(PACKAGE).`arch` $(PACKAGE)
	rm -rf $(PACKAGE)

# DO NOT DELETE THIS LINE -- make depend depends on it.

Changes to unix/README.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
This is the directory where you configure, compile, test, and install
UNIX versions of Tk.  This directory also contains source files for Tk
that are specific to UNIX.

The rest of this file contains instructions on how to do this.  The
release should compile and run either "out of the box" or with trivial
changes on any UNIX-like system that approximates POSIX, BSD, or System
V.  We know that it runs on workstations from Sun, H-P, DEC, IBM, and
SGI, as well as PCs running Linux, BSDI, and SCO UNIX.  To compile for
a PC running Windows, see the README file in the directory ../win.  To
compile for a Macintosh, see the README file in the directory ../mac.

SCCS: @(#) README 1.24 97/08/13 17:31:19

How To Compile And Install Tk:
------------------------------

(a) Make sure that the Tcl 8.0 release is present in the directory
    ../../tcl8.0 (or else use the "--with-tcl" switch described below). 
    This release of Tk will only work with Tcl 8.0. Also, be sure that
    you have configured Tcl before you configure Tk.

(b) Check for patches as described in ../README.

(c) If you have already compiled Tk once in this directory and are now
    preparing to compile again in the same directory but for a different
    platform, or if you have applied patches, type "make distclean" to












|




|
|
|







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
This is the directory where you configure, compile, test, and install
UNIX versions of Tk.  This directory also contains source files for Tk
that are specific to UNIX.

The rest of this file contains instructions on how to do this.  The
release should compile and run either "out of the box" or with trivial
changes on any UNIX-like system that approximates POSIX, BSD, or System
V.  We know that it runs on workstations from Sun, H-P, DEC, IBM, and
SGI, as well as PCs running Linux, BSDI, and SCO UNIX.  To compile for
a PC running Windows, see the README file in the directory ../win.  To
compile for a Macintosh, see the README file in the directory ../mac.

RCS: @(#) $Id: README,v 1.1.4.3 1999/02/11 04:13:49 stanton Exp $

How To Compile And Install Tk:
------------------------------

(a) Make sure that the Tcl 8.1 release is present in the directory
    ../../tcl8.1a2 (or else use the "--with-tcl" switch described below). 
    This release of Tk will only work with Tcl 8.1. Also, be sure that
    you have configured Tcl before you configure Tk.

(b) Check for patches as described in ../README.

(c) If you have already compiled Tk once in this directory and are now
    preparing to compile again in the same directory but for a different
    platform, or if you have applied patches, type "make distclean" to
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
    program and typing Tcl commands.  However, if you haven't installed
    Tk then you'll first need to set your TK_LIBRARY environment
    variable to hold the full path name of the "library" subdirectory.
    If you haven't installed Tcl either then you'll need to set your
    TCL_LIBRARY environment variable as well (see the Tcl README file
    for information on this).  Note that installed versions of wish,
    libtk.a, libtk.so, and the Tk library have a version number in their
    names, such as "wish8.0" or "libtk8.0.so"; to use the installed
    versions, either specify the version number or create a symbolic
    link (e.g. from "wish" to "wish8.0").

If you have trouble compiling Tk, read through the file "porting.notes".
It contains information that people have provided about changes they had
to make to compile Tcl in various environments.  Or, check out the
following Web URL:
    http://www.sunlabs.com/cgi-bin/tcl/info.8.0
This is an on-line database of porting information.  We make no guarantees
that this information is accurate, complete, or up-to-date, but you may
find it useful.  If you get Tk running on a new configuration and had to
make non-trivial changes to do it, we'd be happy to receive new information
to add to "porting.notes".  You can also make a new entry into the
on-line Web database.  We're also interested in hearing how to change the
configuration setup so that Tcl compiles on additional platforms "out of
the box".

Test suite
----------

Tk has a substantial self-test suite, consisting of a set of scripts in
the subdirectory "tests".  To run the test suite just type "make test"
in this directory.  You should then see a printout of the test files







|

|

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







74
75
76
77
78
79
80
81
82
83
84
85
86
87







88
89

90
91
92
93
94
95
96
    program and typing Tcl commands.  However, if you haven't installed
    Tk then you'll first need to set your TK_LIBRARY environment
    variable to hold the full path name of the "library" subdirectory.
    If you haven't installed Tcl either then you'll need to set your
    TCL_LIBRARY environment variable as well (see the Tcl README file
    for information on this).  Note that installed versions of wish,
    libtk.a, libtk.so, and the Tk library have a version number in their
    names, such as "wish8.1" or "libtk8.1.so"; to use the installed
    versions, either specify the version number or create a symbolic
    link (e.g. from "wish" to "wish8.1").

If you have trouble compiling Tk, read through the file
"porting.notes".  It contains information that people have provided
about changes they had to make to compile Tcl in various environments.







We're also interested in hearing how to change the configuration setup
so that Tcl compiles on additional platforms "out of the box".


Test suite
----------

Tk has a substantial self-test suite, consisting of a set of scripts in
the subdirectory "tests".  To run the test suite just type "make test"
in this directory.  You should then see a printout of the test files

Changes to unix/configure.in.


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

dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tk installation
dnl	to configure the system for the local environment.
AC_INIT(../generic/tk.h)
# SCCS: @(#) configure.in 1.90 97/11/20 12:45:45

TK_VERSION=8.0
TK_MAJOR_VERSION=8
TK_MINOR_VERSION=0
TK_PATCH_LEVEL="p2"
VERSION=${TK_VERSION}

if test "${prefix}" = "NONE"; then
    prefix=/usr/local
fi
if test "${exec_prefix}" = "NONE"; then
    exec_prefix=$prefix
fi
TK_SRC_DIR=`cd $srcdir/..; pwd`





AC_PROG_RANLIB
AC_ARG_ENABLE(gcc, [  --enable-gcc            allow use of gcc if available],
    [tk_ok=$enableval], [tkl_ok=no])
if test "$tk_ok" = "yes"; then
    AC_PROG_CC
else
    CC=${CC-cc}
AC_SUBST(CC)
fi
AC_C_CROSS
AC_HAVE_HEADERS(unistd.h limits.h)















































#--------------------------------------------------------------------
#	See if there was a command-line option for where Tcl is;  if
#	not, assume that its top-level directory is a sibling of ours.

#--------------------------------------------------------------------








AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl 8.0 binaries from DIR],
	TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl8.0/unix; pwd`)
if test ! -d $TCL_BIN_DIR; then
    AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist)
fi
if test ! -f $TCL_BIN_DIR/Makefile; then
    AC_MSG_ERROR(There's no Makefile in $TCL_BIN_DIR;  perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
fi

#--------------------------------------------------------------------
#	Read in configuration information generated by Tcl for shared
#	libraries, and arrange for it to be substituted into our
#	Makefile.
#--------------------------------------------------------------------

file=$TCL_BIN_DIR/tclConfig.sh
. $file













SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
SHLIB_LD=$TCL_SHLIB_LD
SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX
SHLIB_VERSION=$TCL_SHLIB_VERSION
DL_LIBS=$TCL_DL_LIBS
LD_FLAGS=$TCL_LD_FLAGS




LIB_RUNTIME_DIR='${LIB_RUNTIME_DIR}'

# If Tcl and Tk are installed in different places, adjust the library
# search path to reflect this.

if test "$TCL_EXEC_PREFIX" != "$exec_prefix"; then
    LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TCL_EXEC_PREFIX}"
fi

#--------------------------------------------------------------------
#	Supply a substitute for stdlib.h if it doesn't define strtol,
#	strtoul, or strtod (which it doesn't in some versions of SunOS).
#--------------------------------------------------------------------

>




|

|

|
|










>
>
>
>


|









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



>


>
>
>
>
>
>
>
|
|















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







>
>
>







|







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
#! /bin/bash -norc
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tk installation
dnl	to configure the system for the local environment.
AC_INIT(../generic/tk.h)
# RCS: @(#) $Id: configure.in,v 1.1.4.17 1999/04/06 02:17:06 stanton Exp $

TK_VERSION=8.1
TK_MAJOR_VERSION=8
TK_MINOR_VERSION=1
TK_PATCH_LEVEL=b3
VERSION=${TK_VERSION}

if test "${prefix}" = "NONE"; then
    prefix=/usr/local
fi
if test "${exec_prefix}" = "NONE"; then
    exec_prefix=$prefix
fi
TK_SRC_DIR=`cd $srcdir/..; pwd`

# Most of the checks here are duplicated from Tcl's configure.in
# and should not be redone but rather simply used from the definitions
# found in tclConfig.sh

AC_PROG_RANLIB
AC_ARG_ENABLE(gcc, [  --enable-gcc            allow use of gcc if available],
    [tk_ok=$enableval], [tk_ok=no])
if test "$tk_ok" = "yes"; then
    AC_PROG_CC
else
    CC=${CC-cc}
AC_SUBST(CC)
fi
AC_C_CROSS
AC_HAVE_HEADERS(unistd.h limits.h)

# Threads support
AC_ARG_ENABLE(threads,[  --enable-threads        enable Threads support],,enableval="no")

if test "$enableval" = "yes"; then
  AC_MSG_RESULT(Will compile with Threads support)
  AC_DEFINE(TCL_THREADS)
  AC_DEFINE(_REENTRANT)

  AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
  if test "$tcl_ok" = "yes"; then
     # The space is needed
     THREADS_LIBS=" -lpthread"
  else
     AC_MSG_WARN("Don t know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile...")
  fi
else
  AC_MSG_RESULT(Will compile without Threads support (normal))
fi

# set the warning flags depending on whether or not we are using gcc
if test "${GCC}" = "yes" ; then
    # leave -Wimplicit-int out, the X libs generate so many of these warnings
    # that they obscure everything else.

    CFLAGS_WARNING="-Wall -Wconversion -Wno-implicit-int"
else
    CFLAGS_WARNING=""
fi

#------------------------------------------------------------------------------
# If we're using GCC, see if the compiler understands -pipe.  If so, use it.
# It makes compiling go faster.  (This is only a performance feature.)
#------------------------------------------------------------------------------

if test -z "$no_pipe"; then
if test -n "$GCC"; then
  AC_MSG_CHECKING([if the compiler understands -pipe])
  OLDCC="$CC"  
  CC="$CC -pipe"
  AC_TRY_COMPILE(,,
    AC_MSG_RESULT(yes),
    CC="$OLDCC"
    AC_MSG_RESULT(no))
fi  
fi

#--------------------------------------------------------------------
#	See if there was a command-line option for where Tcl is;  if
#	not, assume that its top-level directory is a sibling of ours.
#	Try the patch-level-specific directory first, then the general one.
#--------------------------------------------------------------------


if test -d ../../tcl8.1$TK_PATCH_LEVEL/unix;  then
    TCL_BIN_DEFAULT=../../tcl8.1$TK_PATCH_LEVEL/unix
else
    TCL_BIN_DEFAULT=../../tcl8.1/unix
fi

AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl 8.1 binaries from DIR],
	TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`)
if test ! -d $TCL_BIN_DIR; then
    AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist)
fi
if test ! -f $TCL_BIN_DIR/Makefile; then
    AC_MSG_ERROR(There's no Makefile in $TCL_BIN_DIR;  perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
fi

#--------------------------------------------------------------------
#	Read in configuration information generated by Tcl for shared
#	libraries, and arrange for it to be substituted into our
#	Makefile.
#--------------------------------------------------------------------

file=$TCL_BIN_DIR/tclConfig.sh
. $file

# Set the default compiler switches based on the --enable-symbols option

AC_ARG_ENABLE(symbols, [  --enable-symbols        build with debugging symbols],
    [tcl_ok=$enableval], [tcl_ok=no])
if test "$tcl_ok" = "yes"; then
    CFLAGS_DEFAULT=CFLAGS_DEBUG
    TK_DBGX=g
else
    CFLAGS_DEFAULT=CFLAGS_OPTIMIZE
    TK_DBGX=""
fi

SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
SHLIB_LD=$TCL_SHLIB_LD
SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX
SHLIB_VERSION=$TCL_SHLIB_VERSION
DL_LIBS=$TCL_DL_LIBS
LD_FLAGS=$TCL_LD_FLAGS
CFLAGS_DEBUG=$TCL_CFLAGS_DEBUG
CFLAGS_OPTIMIZE=$TCL_CFLAGS_OPTIMIZE
EXTRA_CFLAGS=$TCL_EXTRA_CFLAGS

LIB_RUNTIME_DIR='${LIB_RUNTIME_DIR}'

# If Tcl and Tk are installed in different places, adjust the library
# search path to reflect this.

if test "$TCL_EXEC_PREFIX" != "$exec_prefix"; then
    LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TCL_EXEC_PREFIX}/lib"
fi

#--------------------------------------------------------------------
#	Supply a substitute for stdlib.h if it doesn't define strtol,
#	strtoul, or strtod (which it doesn't in some versions of SunOS).
#--------------------------------------------------------------------

119
120
121
122
123
124
125












126
127
128
129
130
131
132

#------------------------------------------------------------------------------
#       Find out about time handling differences.
#------------------------------------------------------------------------------

AC_CHECK_HEADERS(sys/time.h)
AC_HEADER_TIME













#--------------------------------------------------------------------
#	Locate the X11 header files and the X11 library archive.  Try
#	the ac_path_x macro first, but if it doesn't find the X stuff
#	(e.g. because there's no xmkmf program) then check through
#	a list of possible directories.  Under some conditions the
#	autoconf macro will return an include directory that contains







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







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

#------------------------------------------------------------------------------
#       Find out about time handling differences.
#------------------------------------------------------------------------------

AC_CHECK_HEADERS(sys/time.h)
AC_HEADER_TIME

#-------------------------------------------
#     In OS/390 struct pwd has no pw_gecos field
#-------------------------------------------

AC_MSG_CHECKING([pw_gecos in struct pwd])
AC_TRY_COMPILE([#include <pwd.h>],
      [struct passwd pwd; pwd.pw_gecos;], tk_ok=yes, tk_ok=no)
AC_MSG_RESULT($tk_ok)
if test $tk_ok = yes; then
    AC_DEFINE(HAVE_PW_GECOS)
fi

#--------------------------------------------------------------------
#	Locate the X11 header files and the X11 library archive.  Try
#	the ac_path_x macro first, but if it doesn't find the X stuff
#	(e.g. because there's no xmkmf program) then check through
#	a list of possible directories.  Under some conditions the
#	autoconf macro will return an include directory that contains
219
220
221
222
223
224
225






226





227
228
229
230
231
232
233
fi

# The statement below is very tricky!  It actually *evaluates* the
# string in TCL_LD_SEARCH_FLAGS, which causes a substitution of the
# variable LIB_RUNTIME_DIR.

eval "TK_CC_SEARCH_FLAGS=\"$TCL_LD_SEARCH_FLAGS\""






TK_LD_SEARCH_FLAGS=`echo ${TK_CC_SEARCH_FLAGS} |sed -e "s|-Wl,||g" -e "s|,| |g"`






#--------------------------------------------------------------------
#	Check for the existence of various libraries.  The order here
#	is important, so that then end up in the right order in the
#	command line generated by make.  The -lsocket and -lnsl libraries
#	require a couple of special tricks:
#	1. Use "connect" and "accept" to check for -lsocket, and







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







306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
fi

# The statement below is very tricky!  It actually *evaluates* the
# string in TCL_LD_SEARCH_FLAGS, which causes a substitution of the
# variable LIB_RUNTIME_DIR.

eval "TK_CC_SEARCH_FLAGS=\"$TCL_LD_SEARCH_FLAGS\""

# The following case handles the differences between linking with "ld"
# and the compiler

case $SHLIB_LD in
    *ld*)
      TK_LD_SEARCH_FLAGS=`echo ${TK_CC_SEARCH_FLAGS} |sed -e "s|-Wl,||g" -e "s|,| |g"`
      ;;
    *)
      TK_LD_SEARCH_FLAGS="${TK_CC_SEARCH_FLAGS}"
      ;;
esac

#--------------------------------------------------------------------
#	Check for the existence of various libraries.  The order here
#	is important, so that then end up in the right order in the
#	command line generated by make.  The -lsocket and -lnsl libraries
#	require a couple of special tricks:
#	1. Use "connect" and "accept" to check for -lsocket, and
252
253
254
255
256
257
258




259
260
261
262
263
264
265
fi
if test "$tk_checkBoth" = 1; then
    tk_oldLibs=$LIBS
    LIBS="$LIBS -lsocket -lnsl"
    AC_CHECK_FUNC(accept, tk_checkNsl=0, [LIBS=$tk_oldLibs])
fi
AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"]))





#--------------------------------------------------------------------
# One more check related to the X libraries.  The standard releases
# of Ultrix don't support the "xauth" mechanism, so send won't work
# unless TK_NO_SECURITY is defined.  However, there are usually copies
# of the MIT X server available as well, which do support xauth.
# Check for the MIT stuff and use it if it exists.







>
>
>
>







350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
fi
if test "$tk_checkBoth" = 1; then
    tk_oldLibs=$LIBS
    LIBS="$LIBS -lsocket -lnsl"
    AC_CHECK_FUNC(accept, tk_checkNsl=0, [LIBS=$tk_oldLibs])
fi
AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"]))

# Add the threads support libraries

LIBS="$LIBS$THREADS_LIBS"

#--------------------------------------------------------------------
# One more check related to the X libraries.  The standard releases
# of Ultrix don't support the "xauth" mechanism, so send won't work
# unless TK_NO_SECURITY is defined.  However, there are usually copies
# of the MIT X server available as well, which do support xauth.
# Check for the MIT stuff and use it if it exists.
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
#	work right (and it must appear before "-lm").
#--------------------------------------------------------------------

MATH_LIBS=""
AC_CHECK_FUNC(sin, , MATH_LIBS="-lm")
AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])

#--------------------------------------------------------------------
#	If this system doesn't have a memmove procedure, use memcpy
#	instead.
#--------------------------------------------------------------------

AC_CHECK_FUNC(memmove, , [AC_DEFINE(memmove, memcpy)])

#--------------------------------------------------------------------
#	Figure out whether "char" is unsigned.  If so, set a
#	#define for __CHAR_UNSIGNED__.
#--------------------------------------------------------------------

AC_C_CHAR_UNSIGNED








<
<
<
<
<
<
<







396
397
398
399
400
401
402







403
404
405
406
407
408
409
#	work right (and it must appear before "-lm").
#--------------------------------------------------------------------

MATH_LIBS=""
AC_CHECK_FUNC(sin, , MATH_LIBS="-lm")
AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])








#--------------------------------------------------------------------
#	Figure out whether "char" is unsigned.  If so, set a
#	#define for __CHAR_UNSIGNED__.
#--------------------------------------------------------------------

AC_C_CHAR_UNSIGNED

344
345
346
347
348
349
350
351
352
353
354
355
356
357
358


359
360
361
362
363


364
365



366
367
368
369
370

371




372
373


374



375


376





















377
378























379

380
381
382
383
384
385
386
387
388

389


390
391
392
393
394
395

396
397
398
399
400
401
402
403
404
405
406
407

#--------------------------------------------------------------------
#	The statements below define a collection of symbols related to
#	building libtk as a shared library instead of a static library.
#--------------------------------------------------------------------

AC_ARG_ENABLE(shared,
    [  --enable-shared         build libtk as a shared library],
    [ok=$enableval], [ok=no])
if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
    TK_SHARED_BUILD=1
    TK_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
    eval "TK_LIB_FILE=libtk${TCL_SHARED_LIB_SUFFIX}"
    MAKE_LIB="\${SHLIB_LD} -o ${TK_LIB_FILE} \${OBJS} \$(TK_LD_SEARCH_FLAGS) ${SHLIB_LD_LIBS}"
    RANLIB=":"


else
    TK_SHARED_BUILD=0
    TK_SHLIB_CFLAGS=""
    eval "TK_LIB_FILE=libtk${TCL_UNSHARED_LIB_SUFFIX}"
    MAKE_LIB="ar cr ${TK_LIB_FILE} \${OBJS}"


fi




# Note:  in the following variable, it's important to use the absolute
# path name of the Tcl directory rather than "..":  this is because
# AIX remembers this path and will attempt to use it at run-time to look
# up the Tcl library.


if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then




    TK_BUILD_LIB_SPEC="-L`pwd` -ltk${VERSION}"
    TK_LIB_SPEC="-L${exec_prefix}/lib -ltk${VERSION}"


else



    TK_BUILD_LIB_SPEC="-L`pwd` -ltk`echo ${VERSION} | tr -d .`"


    TK_LIB_SPEC="-L${exec_prefix}/lib -ltk`echo ${VERSION} | tr -d .`"





















fi
























AC_SUBST(DL_LIBS)

AC_SUBST(LD_FLAGS)
AC_SUBST(MATH_LIBS)
AC_SUBST(MAKE_LIB)
AC_SUBST(SHLIB_CFLAGS)
AC_SUBST(SHLIB_LD)
AC_SUBST(SHLIB_LD_LIBS)
AC_SUBST(SHLIB_SUFFIX)
AC_SUBST(SHLIB_VERSION)
AC_SUBST(TCL_BIN_DIR)

AC_SUBST(TCL_BUILD_LIB_SPEC)


AC_SUBST(TCL_SRC_DIR)
AC_SUBST(TCL_VERSION)
AC_SUBST(TK_BUILD_LIB_SPEC)
AC_SUBST(TK_CC_SEARCH_FLAGS)
AC_SUBST(TK_LD_SEARCH_FLAGS)
AC_SUBST(TK_LIB_FILE)

AC_SUBST(TK_LIB_SPEC)
AC_SUBST(TK_MAJOR_VERSION)
AC_SUBST(TK_MINOR_VERSION)
AC_SUBST(TK_PATCH_LEVEL)
AC_SUBST(TK_SHLIB_CFLAGS)
AC_SUBST(TK_SRC_DIR)
AC_SUBST(TK_VERSION)
AC_SUBST(XINCLUDES)
AC_SUBST(XLIBSW)
AC_SUBST(TK_SHARED_BUILD)

AC_OUTPUT(Makefile tkConfig.sh)







|
|



|
|

>
>



|
|
>
>


>
>
>





>
|
>
>
>
>
|
|
>
>

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


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

>









>

>
>






>












439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570

#--------------------------------------------------------------------
#	The statements below define a collection of symbols related to
#	building libtk as a shared library instead of a static library.
#--------------------------------------------------------------------

AC_ARG_ENABLE(shared,
    [  --enable-shared         build libtk as a shared library (on by default)],
    [ok=$enableval], [ok=yes])
if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
    TK_SHARED_BUILD=1
    TK_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
    TK_LIB_FILE=libtk${TCL_SHARED_LIB_SUFFIX}
    MAKE_LIB="\${SHLIB_LD} -o \${TK_LIB_FILE} \${OBJS} \$(TK_LD_SEARCH_FLAGS) ${TCL_BUILD_STUB_LIB_SPEC} \${LIBS}"
    RANLIB=":"

    TCL_STUB_FLAGS="-DUSE_TCL_STUBS"
else
    TK_SHARED_BUILD=0
    TK_SHLIB_CFLAGS=""
    TK_LIB_FILE=libtk${TCL_UNSHARED_LIB_SUFFIX}
    MAKE_LIB="ar cr \${TK_LIB_FILE} \${OBJS}"

    TCL_STUB_FLAGS=""
fi

DBGX='${TK_DBGX}'
eval "TK_LIB_FILE=${TK_LIB_FILE}"

# Note:  in the following variable, it's important to use the absolute
# path name of the Tcl directory rather than "..":  this is because
# AIX remembers this path and will attempt to use it at run-time to look
# up the Tcl library.

if test $TK_SHARED_BUILD = 0 -o $TCL_NEEDS_EXP_FILE = 0; then
    if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
	TK_LIB_FLAG="-ltk${VERSION}\${TK_DBGX}"
    else
	TK_LIB_FLAG="-ltk`echo ${VERSION} | tr -d .`\${TK_DBGX}"
    fi
    TK_BUILD_LIB_SPEC="-L`pwd` ${TK_LIB_FLAG}"
    TK_LIB_SPEC="-L${exec_prefix}/lib ${TK_LIB_FLAG}"
    TK_BUILD_EXP_FILE=""
    TK_EXP_FILE=""
else
    TK_BUILD_EXP_FILE="lib.exp"
    eval "TK_EXP_FILE=libtk${TCL_EXPORT_FILE_SUFFIX}"
    
    TK_BUILD_LIB_SPEC="-bI:`pwd`/${TK_BUILD_EXP_FILE}"
    TK_LIB_SPEC="-bI:${exec_prefix}/lib/${TK_EXP_FILE}"
fi

#--------------------------------------------------------------------
#       The statements below define various symbols relating to Tk
#       using tcl stub support.
#--------------------------------------------------------------------

# For now, linking to Tcl stubs is not supported with Tk. It causes
# too many problems with linking.  When Tk is a fully loadable 
# extension, linking the the Tcl stubs will be supported.


# Replace ${VERSION} with contents of ${TK_VERSION}
eval "STUB_LIB_FILE=libtkstub${TCL_UNSHARED_LIB_SUFFIX}"

MAKE_STUB_LIB="ar cr \${STUB_LIB_FILE} \${STUB_LIB_OBJS}"

TK_STUB_LIB_FILE=${STUB_LIB_FILE}

if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
    TK_STUB_LIB_FLAG="-ltkstub${TK_VERSION}\${TK_DBGX}"
else
    TK_STUB_LIB_FLAG="-ltkstub`echo ${TK_VERSION} | tr -d .`\${TK_DBGX}"
fi

TK_BUILD_STUB_LIB_SPEC="-L`pwd` ${TK_STUB_LIB_FLAG}"
TK_STUB_LIB_SPEC="-L${exec_prefix}/lib ${TK_STUB_LIB_FLAG}"
TK_BUILD_STUB_LIB_PATH="`pwd`/${TK_STUB_LIB_FILE}"
TK_STUB_LIB_PATH="${exec_prefix}/lib/${TK_STUB_LIB_FILE}"

AC_SUBST(STUB_LIB_FILE)

AC_SUBST(TK_STUB_LIB_FILE)
AC_SUBST(TK_STUB_LIB_FLAG)
AC_SUBST(TK_BUILD_STUB_LIB_SPEC)
AC_SUBST(TK_STUB_LIB_SPEC)
AC_SUBST(TK_BUILD_STUB_LIB_PATH)
AC_SUBST(TK_STUB_LIB_PATH)
AC_SUBST(MAKE_STUB_LIB)
AC_SUBST(TCL_STUB_FLAGS)
AC_SUBST(TK_BUILD_EXP_FILE)
AC_SUBST(TK_EXP_FILE)

AC_SUBST(CFLAGS_DEBUG)
AC_SUBST(CFLAGS_DEFAULT)
AC_SUBST(CFLAGS_OPTIMIZE)
AC_SUBST(CFLAGS_WARNING)
AC_SUBST(TK_DBGX)
AC_SUBST(DL_LIBS)
AC_SUBST(EXTRA_CFLAGS)
AC_SUBST(LD_FLAGS)
AC_SUBST(MATH_LIBS)
AC_SUBST(MAKE_LIB)
AC_SUBST(SHLIB_CFLAGS)
AC_SUBST(SHLIB_LD)
AC_SUBST(SHLIB_LD_LIBS)
AC_SUBST(SHLIB_SUFFIX)
AC_SUBST(SHLIB_VERSION)
AC_SUBST(TCL_BIN_DIR)
AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
AC_SUBST(TCL_BUILD_LIB_SPEC)
AC_SUBST(TCL_DBGX)
AC_SUBST(TCL_LIB_FLAG)
AC_SUBST(TCL_SRC_DIR)
AC_SUBST(TCL_VERSION)
AC_SUBST(TK_BUILD_LIB_SPEC)
AC_SUBST(TK_CC_SEARCH_FLAGS)
AC_SUBST(TK_LD_SEARCH_FLAGS)
AC_SUBST(TK_LIB_FILE)
AC_SUBST(TK_LIB_FLAG)
AC_SUBST(TK_LIB_SPEC)
AC_SUBST(TK_MAJOR_VERSION)
AC_SUBST(TK_MINOR_VERSION)
AC_SUBST(TK_PATCH_LEVEL)
AC_SUBST(TK_SHLIB_CFLAGS)
AC_SUBST(TK_SRC_DIR)
AC_SUBST(TK_VERSION)
AC_SUBST(XINCLUDES)
AC_SUBST(XLIBSW)
AC_SUBST(TK_SHARED_BUILD)

AC_OUTPUT(Makefile tkConfig.sh)

Changes to unix/mkLinks.

39
40
41
42
43
44
45




















46
47
48
49
50
51
52
    rm -f Tk_3DHorizontalBevel.3
    ln 3DBorder.3 Tk_3DHorizontalBevel.3
fi
if test -r 3DBorder.3; then
    rm -f Tk_3DVerticalBevel.3
    ln 3DBorder.3 Tk_3DVerticalBevel.3
fi




















if test -r WindowId.3; then
    rm -f Tk_Attributes.3
    ln WindowId.3 Tk_Attributes.3
fi
if test -r BindTable.3; then
    rm -f Tk_BindEvent.3
    ln BindTable.3 Tk_BindEvent.3







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







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
    rm -f Tk_3DHorizontalBevel.3
    ln 3DBorder.3 Tk_3DHorizontalBevel.3
fi
if test -r 3DBorder.3; then
    rm -f Tk_3DVerticalBevel.3
    ln 3DBorder.3 Tk_3DVerticalBevel.3
fi
if test -r 3DBorder.3; then
    rm -f Tk_Alloc3DBorderFromObj.3
    ln 3DBorder.3 Tk_Alloc3DBorderFromObj.3
fi
if test -r GetBitmap.3; then
    rm -f Tk_AllocBitmapFromObj.3
    ln GetBitmap.3 Tk_AllocBitmapFromObj.3
fi
if test -r GetColor.3; then
    rm -f Tk_AllocColorFromObj.3
    ln GetColor.3 Tk_AllocColorFromObj.3
fi
if test -r GetCursor.3; then
    rm -f Tk_AllocCursorFromObj.3
    ln GetCursor.3 Tk_AllocCursorFromObj.3
fi
if test -r GetFont.3; then
    rm -f Tk_AllocFontFromObj.3
    ln GetFont.3 Tk_AllocFontFromObj.3
fi
if test -r WindowId.3; then
    rm -f Tk_Attributes.3
    ln WindowId.3 Tk_Attributes.3
fi
if test -r BindTable.3; then
    rm -f Tk_BindEvent.3
    ln BindTable.3 Tk_BindEvent.3
187
188
189
190
191
192
193




194
195
196
197
198
199
200
    rm -f Tk_CreateImageType.3
    ln CrtImgType.3 Tk_CreateImageType.3
fi
if test -r CrtItemType.3; then
    rm -f Tk_CreateItemType.3
    ln CrtItemType.3 Tk_CreateItemType.3
fi




if test -r CrtPhImgFmt.3; then
    rm -f Tk_CreatePhotoImageFormat.3
    ln CrtPhImgFmt.3 Tk_CreatePhotoImageFormat.3
fi
if test -r CrtSelHdlr.3; then
    rm -f Tk_CreateSelHandler.3
    ln CrtSelHdlr.3 Tk_CreateSelHandler.3







>
>
>
>







207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
    rm -f Tk_CreateImageType.3
    ln CrtImgType.3 Tk_CreateImageType.3
fi
if test -r CrtItemType.3; then
    rm -f Tk_CreateItemType.3
    ln CrtItemType.3 Tk_CreateItemType.3
fi
if test -r SetOptions.3; then
    rm -f Tk_CreateOptionTable.3
    ln SetOptions.3 Tk_CreateOptionTable.3
fi
if test -r CrtPhImgFmt.3; then
    rm -f Tk_CreatePhotoImageFormat.3
    ln CrtPhImgFmt.3 Tk_CreatePhotoImageFormat.3
fi
if test -r CrtSelHdlr.3; then
    rm -f Tk_CreateSelHandler.3
    ln CrtSelHdlr.3 Tk_CreateSelHandler.3
239
240
241
242
243
244
245




246
247
248
249
250
251
252
    rm -f Tk_DeleteGenericHandler.3
    ln CrtGenHdlr.3 Tk_DeleteGenericHandler.3
fi
if test -r DeleteImg.3; then
    rm -f Tk_DeleteImage.3
    ln DeleteImg.3 Tk_DeleteImage.3
fi




if test -r CrtSelHdlr.3; then
    rm -f Tk_DeleteSelHandler.3
    ln CrtSelHdlr.3 Tk_DeleteSelHandler.3
fi
if test -r WindowId.3; then
    rm -f Tk_Depth.3
    ln WindowId.3 Tk_Depth.3







>
>
>
>







263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
    rm -f Tk_DeleteGenericHandler.3
    ln CrtGenHdlr.3 Tk_DeleteGenericHandler.3
fi
if test -r DeleteImg.3; then
    rm -f Tk_DeleteImage.3
    ln DeleteImg.3 Tk_DeleteImage.3
fi
if test -r SetOptions.3; then
    rm -f Tk_DeleteOptionTable.3
    ln SetOptions.3 Tk_DeleteOptionTable.3
fi
if test -r CrtSelHdlr.3; then
    rm -f Tk_DeleteSelHandler.3
    ln CrtSelHdlr.3 Tk_DeleteSelHandler.3
fi
if test -r WindowId.3; then
    rm -f Tk_Depth.3
    ln WindowId.3 Tk_Depth.3
307
308
309
310
311
312
313




314
315
316
317




318
319
320
321




322
323
324
325




326
327
328
329




330
331
332
333




334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349




350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365




366
367
368
369
370
371
372
373




374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389




390
391
392
393
394
395
396
397
398
399
400
401




402
403
404
405
406
407
408
409
410
411
412
413




414
415
416
417




418
419
420
421
422
423
424
    rm -f Tk_FontMetrics.3
    ln FontId.3 Tk_FontMetrics.3
fi
if test -r 3DBorder.3; then
    rm -f Tk_Free3DBorder.3
    ln 3DBorder.3 Tk_Free3DBorder.3
fi




if test -r GetBitmap.3; then
    rm -f Tk_FreeBitmap.3
    ln GetBitmap.3 Tk_FreeBitmap.3
fi




if test -r GetColor.3; then
    rm -f Tk_FreeColor.3
    ln GetColor.3 Tk_FreeColor.3
fi




if test -r GetClrmap.3; then
    rm -f Tk_FreeColormap.3
    ln GetClrmap.3 Tk_FreeColormap.3
fi




if test -r GetCursor.3; then
    rm -f Tk_FreeCursor.3
    ln GetCursor.3 Tk_FreeCursor.3
fi




if test -r GetFont.3; then
    rm -f Tk_FreeFont.3
    ln GetFont.3 Tk_FreeFont.3
fi




if test -r GetGC.3; then
    rm -f Tk_FreeGC.3
    ln GetGC.3 Tk_FreeGC.3
fi
if test -r GetImage.3; then
    rm -f Tk_FreeImage.3
    ln GetImage.3 Tk_FreeImage.3
fi
if test -r ConfigWidg.3; then
    rm -f Tk_FreeOptions.3
    ln ConfigWidg.3 Tk_FreeOptions.3
fi
if test -r GetPixmap.3; then
    rm -f Tk_FreePixmap.3
    ln GetPixmap.3 Tk_FreePixmap.3
fi




if test -r TextLayout.3; then
    rm -f Tk_FreeTextLayout.3
    ln TextLayout.3 Tk_FreeTextLayout.3
fi
if test -r FreeXId.3; then
    rm -f Tk_FreeXId.3
    ln FreeXId.3 Tk_FreeXId.3
fi
if test -r GeomReq.3; then
    rm -f Tk_GeometryRequest.3
    ln GeomReq.3 Tk_GeometryRequest.3
fi
if test -r 3DBorder.3; then
    rm -f Tk_Get3DBorder.3
    ln 3DBorder.3 Tk_Get3DBorder.3
fi




if test -r BindTable.3; then
    rm -f Tk_GetAllBindings.3
    ln BindTable.3 Tk_GetAllBindings.3
fi
if test -r GetAnchor.3; then
    rm -f Tk_GetAnchor.3
    ln GetAnchor.3 Tk_GetAnchor.3
fi




if test -r InternAtom.3; then
    rm -f Tk_GetAtomName.3
    ln InternAtom.3 Tk_GetAtomName.3
fi
if test -r BindTable.3; then
    rm -f Tk_GetBinding.3
    ln BindTable.3 Tk_GetBinding.3
fi
if test -r GetBitmap.3; then
    rm -f Tk_GetBitmap.3
    ln GetBitmap.3 Tk_GetBitmap.3
fi
if test -r GetBitmap.3; then
    rm -f Tk_GetBitmapFromData.3
    ln GetBitmap.3 Tk_GetBitmapFromData.3
fi




if test -r GetCapStyl.3; then
    rm -f Tk_GetCapStyle.3
    ln GetCapStyl.3 Tk_GetCapStyle.3
fi
if test -r GetColor.3; then
    rm -f Tk_GetColor.3
    ln GetColor.3 Tk_GetColor.3
fi
if test -r GetColor.3; then
    rm -f Tk_GetColorByValue.3
    ln GetColor.3 Tk_GetColorByValue.3
fi




if test -r GetClrmap.3; then
    rm -f Tk_GetColormap.3
    ln GetClrmap.3 Tk_GetColormap.3
fi
if test -r GetCursor.3; then
    rm -f Tk_GetCursor.3
    ln GetCursor.3 Tk_GetCursor.3
fi
if test -r GetCursor.3; then
    rm -f Tk_GetCursorFromData.3
    ln GetCursor.3 Tk_GetCursorFromData.3
fi




if test -r GetFont.3; then
    rm -f Tk_GetFont.3
    ln GetFont.3 Tk_GetFont.3
fi




if test -r GetGC.3; then
    rm -f Tk_GetGC.3
    ln GetGC.3 Tk_GetGC.3
fi
if test -r GetImage.3; then
    rm -f Tk_GetImage.3
    ln GetImage.3 Tk_GetImage.3







>
>
>
>




>
>
>
>




>
>
>
>




>
>
>
>




>
>
>
>




>
>
>
>
















>
>
>
>
















>
>
>
>








>
>
>
>
















>
>
>
>












>
>
>
>












>
>
>
>




>
>
>
>







335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
    rm -f Tk_FontMetrics.3
    ln FontId.3 Tk_FontMetrics.3
fi
if test -r 3DBorder.3; then
    rm -f Tk_Free3DBorder.3
    ln 3DBorder.3 Tk_Free3DBorder.3
fi
if test -r 3DBorder.3; then
    rm -f Tk_Free3DBorderFromObj.3
    ln 3DBorder.3 Tk_Free3DBorderFromObj.3
fi
if test -r GetBitmap.3; then
    rm -f Tk_FreeBitmap.3
    ln GetBitmap.3 Tk_FreeBitmap.3
fi
if test -r GetBitmap.3; then
    rm -f Tk_FreeBitmapFromObj.3
    ln GetBitmap.3 Tk_FreeBitmapFromObj.3
fi
if test -r GetColor.3; then
    rm -f Tk_FreeColor.3
    ln GetColor.3 Tk_FreeColor.3
fi
if test -r GetColor.3; then
    rm -f Tk_FreeColorFromObj.3
    ln GetColor.3 Tk_FreeColorFromObj.3
fi
if test -r GetClrmap.3; then
    rm -f Tk_FreeColormap.3
    ln GetClrmap.3 Tk_FreeColormap.3
fi
if test -r SetOptions.3; then
    rm -f Tk_FreeConfigOptions.3
    ln SetOptions.3 Tk_FreeConfigOptions.3
fi
if test -r GetCursor.3; then
    rm -f Tk_FreeCursor.3
    ln GetCursor.3 Tk_FreeCursor.3
fi
if test -r GetCursor.3; then
    rm -f Tk_FreeCursorFromObj.3
    ln GetCursor.3 Tk_FreeCursorFromObj.3
fi
if test -r GetFont.3; then
    rm -f Tk_FreeFont.3
    ln GetFont.3 Tk_FreeFont.3
fi
if test -r GetFont.3; then
    rm -f Tk_FreeFontFromObj.3
    ln GetFont.3 Tk_FreeFontFromObj.3
fi
if test -r GetGC.3; then
    rm -f Tk_FreeGC.3
    ln GetGC.3 Tk_FreeGC.3
fi
if test -r GetImage.3; then
    rm -f Tk_FreeImage.3
    ln GetImage.3 Tk_FreeImage.3
fi
if test -r ConfigWidg.3; then
    rm -f Tk_FreeOptions.3
    ln ConfigWidg.3 Tk_FreeOptions.3
fi
if test -r GetPixmap.3; then
    rm -f Tk_FreePixmap.3
    ln GetPixmap.3 Tk_FreePixmap.3
fi
if test -r SetOptions.3; then
    rm -f Tk_FreeSavedOptions.3
    ln SetOptions.3 Tk_FreeSavedOptions.3
fi
if test -r TextLayout.3; then
    rm -f Tk_FreeTextLayout.3
    ln TextLayout.3 Tk_FreeTextLayout.3
fi
if test -r FreeXId.3; then
    rm -f Tk_FreeXId.3
    ln FreeXId.3 Tk_FreeXId.3
fi
if test -r GeomReq.3; then
    rm -f Tk_GeometryRequest.3
    ln GeomReq.3 Tk_GeometryRequest.3
fi
if test -r 3DBorder.3; then
    rm -f Tk_Get3DBorder.3
    ln 3DBorder.3 Tk_Get3DBorder.3
fi
if test -r 3DBorder.3; then
    rm -f Tk_Get3DBorderFromObj.3
    ln 3DBorder.3 Tk_Get3DBorderFromObj.3
fi
if test -r BindTable.3; then
    rm -f Tk_GetAllBindings.3
    ln BindTable.3 Tk_GetAllBindings.3
fi
if test -r GetAnchor.3; then
    rm -f Tk_GetAnchor.3
    ln GetAnchor.3 Tk_GetAnchor.3
fi
if test -r GetAnchor.3; then
    rm -f Tk_GetAnchorFromObj.3
    ln GetAnchor.3 Tk_GetAnchorFromObj.3
fi
if test -r InternAtom.3; then
    rm -f Tk_GetAtomName.3
    ln InternAtom.3 Tk_GetAtomName.3
fi
if test -r BindTable.3; then
    rm -f Tk_GetBinding.3
    ln BindTable.3 Tk_GetBinding.3
fi
if test -r GetBitmap.3; then
    rm -f Tk_GetBitmap.3
    ln GetBitmap.3 Tk_GetBitmap.3
fi
if test -r GetBitmap.3; then
    rm -f Tk_GetBitmapFromData.3
    ln GetBitmap.3 Tk_GetBitmapFromData.3
fi
if test -r GetBitmap.3; then
    rm -f Tk_GetBitmapFromObj.3
    ln GetBitmap.3 Tk_GetBitmapFromObj.3
fi
if test -r GetCapStyl.3; then
    rm -f Tk_GetCapStyle.3
    ln GetCapStyl.3 Tk_GetCapStyle.3
fi
if test -r GetColor.3; then
    rm -f Tk_GetColor.3
    ln GetColor.3 Tk_GetColor.3
fi
if test -r GetColor.3; then
    rm -f Tk_GetColorByValue.3
    ln GetColor.3 Tk_GetColorByValue.3
fi
if test -r GetColor.3; then
    rm -f Tk_GetColorFromObj.3
    ln GetColor.3 Tk_GetColorFromObj.3
fi
if test -r GetClrmap.3; then
    rm -f Tk_GetColormap.3
    ln GetClrmap.3 Tk_GetColormap.3
fi
if test -r GetCursor.3; then
    rm -f Tk_GetCursor.3
    ln GetCursor.3 Tk_GetCursor.3
fi
if test -r GetCursor.3; then
    rm -f Tk_GetCursorFromData.3
    ln GetCursor.3 Tk_GetCursorFromData.3
fi
if test -r GetCursor.3; then
    rm -f Tk_GetCursorFromObj.3
    ln GetCursor.3 Tk_GetCursorFromObj.3
fi
if test -r GetFont.3; then
    rm -f Tk_GetFont.3
    ln GetFont.3 Tk_GetFont.3
fi
if test -r GetFont.3; then
    rm -f Tk_GetFontFromObj.3
    ln GetFont.3 Tk_GetFontFromObj.3
fi
if test -r GetGC.3; then
    rm -f Tk_GetGC.3
    ln GetGC.3 Tk_GetGC.3
fi
if test -r GetImage.3; then
    rm -f Tk_GetImage.3
    ln GetImage.3 Tk_GetImage.3
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
    rm -f Tk_GetJoinStyle.3
    ln GetJoinStl.3 Tk_GetJoinStyle.3
fi
if test -r GetJustify.3; then
    rm -f Tk_GetJustify.3
    ln GetJustify.3 Tk_GetJustify.3
fi








if test -r GetOption.3; then
    rm -f Tk_GetOption.3
    ln GetOption.3 Tk_GetOption.3
fi








if test -r GetPixels.3; then
    rm -f Tk_GetPixels.3
    ln GetPixels.3 Tk_GetPixels.3
fi




if test -r GetPixmap.3; then
    rm -f Tk_GetPixmap.3
    ln GetPixmap.3 Tk_GetPixmap.3
fi
if test -r GetRelief.3; then
    rm -f Tk_GetRelief.3
    ln GetRelief.3 Tk_GetRelief.3
fi




if test -r GetRootCrd.3; then
    rm -f Tk_GetRootCoords.3
    ln GetRootCrd.3 Tk_GetRootCoords.3
fi
if test -r GetPixels.3; then
    rm -f Tk_GetScreenMM.3
    ln GetPixels.3 Tk_GetScreenMM.3







>
>
>
>
>
>
>
>




>
>
>
>
>
>
>
>




>
>
>
>








>
>
>
>







515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
    rm -f Tk_GetJoinStyle.3
    ln GetJoinStl.3 Tk_GetJoinStyle.3
fi
if test -r GetJustify.3; then
    rm -f Tk_GetJustify.3
    ln GetJustify.3 Tk_GetJustify.3
fi
if test -r GetJustify.3; then
    rm -f Tk_GetJustifyFromObj.3
    ln GetJustify.3 Tk_GetJustifyFromObj.3
fi
if test -r GetPixels.3; then
    rm -f Tk_GetMMFromObj.3
    ln GetPixels.3 Tk_GetMMFromObj.3
fi
if test -r GetOption.3; then
    rm -f Tk_GetOption.3
    ln GetOption.3 Tk_GetOption.3
fi
if test -r SetOptions.3; then
    rm -f Tk_GetOptionInfo.3
    ln SetOptions.3 Tk_GetOptionInfo.3
fi
if test -r SetOptions.3; then
    rm -f Tk_GetOptionValue.3
    ln SetOptions.3 Tk_GetOptionValue.3
fi
if test -r GetPixels.3; then
    rm -f Tk_GetPixels.3
    ln GetPixels.3 Tk_GetPixels.3
fi
if test -r GetPixels.3; then
    rm -f Tk_GetPixelsFromObj.3
    ln GetPixels.3 Tk_GetPixelsFromObj.3
fi
if test -r GetPixmap.3; then
    rm -f Tk_GetPixmap.3
    ln GetPixmap.3 Tk_GetPixmap.3
fi
if test -r GetRelief.3; then
    rm -f Tk_GetRelief.3
    ln GetRelief.3 Tk_GetRelief.3
fi
if test -r GetRelief.3; then
    rm -f Tk_GetReliefFromObj.3
    ln GetRelief.3 Tk_GetReliefFromObj.3
fi
if test -r GetRootCrd.3; then
    rm -f Tk_GetRootCoords.3
    ln GetRootCrd.3 Tk_GetRootCoords.3
fi
if test -r GetPixels.3; then
    rm -f Tk_GetScreenMM.3
    ln GetPixels.3 Tk_GetScreenMM.3
495
496
497
498
499
500
501




502
503
504
505
506
507
508
    rm -f Tk_IdToWindow.3
    ln IdToWindow.3 Tk_IdToWindow.3
fi
if test -r ImgChanged.3; then
    rm -f Tk_ImageChanged.3
    ln ImgChanged.3 Tk_ImageChanged.3
fi




if test -r InternAtom.3; then
    rm -f Tk_InternAtom.3
    ln InternAtom.3 Tk_InternAtom.3
fi
if test -r WindowId.3; then
    rm -f Tk_InternalBorderWidth.3
    ln WindowId.3 Tk_InternalBorderWidth.3







>
>
>
>







599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
    rm -f Tk_IdToWindow.3
    ln IdToWindow.3 Tk_IdToWindow.3
fi
if test -r ImgChanged.3; then
    rm -f Tk_ImageChanged.3
    ln ImgChanged.3 Tk_ImageChanged.3
fi
if test -r SetOptions.3; then
    rm -f Tk_InitOptions.3
    ln SetOptions.3 Tk_InitOptions.3
fi
if test -r InternAtom.3; then
    rm -f Tk_InternAtom.3
    ln InternAtom.3 Tk_InternAtom.3
fi
if test -r WindowId.3; then
    rm -f Tk_InternalBorderWidth.3
    ln WindowId.3 Tk_InternalBorderWidth.3
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
    rm -f Tk_NameOfRelief.3
    ln GetRelief.3 Tk_NameOfRelief.3
fi
if test -r Name.3; then
    rm -f Tk_NameToWindow.3
    ln Name.3 Tk_NameToWindow.3
fi
if test -r ConfigWidg.3; then
    rm -f Tk_Offset.3
    ln ConfigWidg.3 Tk_Offset.3
fi
if test -r OwnSelect.3; then
    rm -f Tk_OwnSelection.3
    ln OwnSelect.3 Tk_OwnSelection.3
fi
if test -r WindowId.3; then
    rm -f Tk_Parent.3







|

|







715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
    rm -f Tk_NameOfRelief.3
    ln GetRelief.3 Tk_NameOfRelief.3
fi
if test -r Name.3; then
    rm -f Tk_NameToWindow.3
    ln Name.3 Tk_NameToWindow.3
fi
if test -r SetOptions.3; then
    rm -f Tk_Offset.3
    ln SetOptions.3 Tk_Offset.3
fi
if test -r OwnSelect.3; then
    rm -f Tk_OwnSelection.3
    ln OwnSelect.3 Tk_OwnSelection.3
fi
if test -r WindowId.3; then
    rm -f Tk_Parent.3
687
688
689
690
691
692
693




694
695
696
697
698
699
700
    rm -f Tk_ResizeWindow.3
    ln ConfigWind.3 Tk_ResizeWindow.3
fi
if test -r Restack.3; then
    rm -f Tk_RestackWindow.3
    ln Restack.3 Tk_RestackWindow.3
fi




if test -r RestrictEv.3; then
    rm -f Tk_RestrictEvents.3
    ln RestrictEv.3 Tk_RestrictEvents.3
fi
if test -r WindowId.3; then
    rm -f Tk_Screen.3
    ln WindowId.3 Tk_Screen.3







>
>
>
>







795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
    rm -f Tk_ResizeWindow.3
    ln ConfigWind.3 Tk_ResizeWindow.3
fi
if test -r Restack.3; then
    rm -f Tk_RestackWindow.3
    ln Restack.3 Tk_RestackWindow.3
fi
if test -r SetOptions.3; then
    rm -f Tk_RestoreSavedOptions.3
    ln SetOptions.3 Tk_RestoreSavedOptions.3
fi
if test -r RestrictEv.3; then
    rm -f Tk_RestrictEvents.3
    ln RestrictEv.3 Tk_RestrictEvents.3
fi
if test -r WindowId.3; then
    rm -f Tk_Screen.3
    ln WindowId.3 Tk_Screen.3
719
720
721
722
723
724
725




726
727
728
729
730
731
732
    rm -f Tk_SetGrid.3
    ln SetGrid.3 Tk_SetGrid.3
fi
if test -r GeomReq.3; then
    rm -f Tk_SetInternalBorder.3
    ln GeomReq.3 Tk_SetInternalBorder.3
fi




if test -r ConfigWind.3; then
    rm -f Tk_SetWindowBackground.3
    ln ConfigWind.3 Tk_SetWindowBackground.3
fi
if test -r ConfigWind.3; then
    rm -f Tk_SetWindowBackgroundPixmap.3
    ln ConfigWind.3 Tk_SetWindowBackgroundPixmap.3







>
>
>
>







831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
    rm -f Tk_SetGrid.3
    ln SetGrid.3 Tk_SetGrid.3
fi
if test -r GeomReq.3; then
    rm -f Tk_SetInternalBorder.3
    ln GeomReq.3 Tk_SetInternalBorder.3
fi
if test -r SetOptions.3; then
    rm -f Tk_SetOptions.3
    ln SetOptions.3 Tk_SetOptions.3
fi
if test -r ConfigWind.3; then
    rm -f Tk_SetWindowBackground.3
    ln ConfigWind.3 Tk_SetWindowBackground.3
fi
if test -r ConfigWind.3; then
    rm -f Tk_SetWindowBackgroundPixmap.3
    ln ConfigWind.3 Tk_SetWindowBackgroundPixmap.3

Changes to unix/porting.notes.

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
    http://www.sunlabs.com/cgi-bin/tcl/info.4.0
This page provides information about the platforms on which Tcl 7.4
and Tk 4.0 have been compiled and what changes were needed to get Tcl
and Tk to compile.  You can also add new entries to that database
when you install Tcl and Tk on a new platform.  The Web database is
likely to be more up-to-date than this file.

sccsid = SCCS: @(#) porting.notes 1.10 96/04/10 15:38:54

--------------------------------------------
Solaris, various versions
--------------------------------------------

1. If typing "make test" results in an error message saying that
there are no "*.test" files, or you get lots of globbing errors,







|







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
    http://www.sunlabs.com/cgi-bin/tcl/info.4.0
This page provides information about the platforms on which Tcl 7.4
and Tk 4.0 have been compiled and what changes were needed to get Tcl
and Tk to compile.  You can also add new entries to that database
when you install Tcl and Tk on a new platform.  The Web database is
likely to be more up-to-date than this file.

RCS: @(#) $Id: porting.notes,v 1.1.4.1 1998/09/30 02:19:11 stanton Exp $

--------------------------------------------
Solaris, various versions
--------------------------------------------

1. If typing "make test" results in an error message saying that
there are no "*.test" files, or you get lots of globbing errors,

Changes to unix/porting.old.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
who contributed the information, not to me;  this means that I
probably can't answer any questions about any of this stuff. In
some cases, a person has volunteered to act as a contact point for
questions about porting Tcl to a particular machine;  in these
cases the person's name and e-mail address are listed.  I'd be
happy to receive corrections or updates.

sccsid = SCCS: @(#) porting.old 1.2 96/02/16 10:27:30

---------------------------------------------
DEC Alphas:
---------------------------------------------

1. There appears to be a compiler/library bug that prevents tkTrig.c
from compiling unless you turn off optimization (remove the -O compiler







|







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
who contributed the information, not to me;  this means that I
probably can't answer any questions about any of this stuff. In
some cases, a person has volunteered to act as a contact point for
questions about porting Tcl to a particular machine;  in these
cases the person's name and e-mail address are listed.  I'd be
happy to receive corrections or updates.

RCS: @(#) $Id: porting.old,v 1.1.4.1 1998/09/30 02:19:12 stanton Exp $

---------------------------------------------
DEC Alphas:
---------------------------------------------

1. There appears to be a compiler/library bug that prevents tkTrig.c
from compiling unless you turn off optimization (remove the -O compiler

Changes to unix/tkAppInit.c.

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
/* 
 * tkAppInit.c --
 *
 *	Provides a default version of the Tcl_AppInit procedure for
 *	use in wish and similar Tk-based applications.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkAppInit.c 1.22 96/05/29 09:47:08
 */

#include "tk.h"


/*
 * The following variable is a special hack that is needed in order for
 * Sun shared libraries to be used for Tcl.
 */

extern int matherr();
int *tclDummyMathPtr = (int *) matherr;

#ifdef TK_TEST

EXTERN int		Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#endif /* TK_TEST */

/*
 *----------------------------------------------------------------------
 *
 * main --
 *







|




|



>










>
|







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
/* 
 * tkAppInit.c --
 *
 *	Provides a default version of the Tcl_AppInit procedure for
 *	use in wish and similar Tk-based applications.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkAppInit.c,v 1.1.4.3 1999/02/11 04:13:50 stanton Exp $
 */

#include "tk.h"
#include "locale.h"

/*
 * The following variable is a special hack that is needed in order for
 * Sun shared libraries to be used for Tcl.
 */

extern int matherr();
int *tclDummyMathPtr = (int *) matherr;

#ifdef TK_TEST
extern int		Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
extern int		Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#endif /* TK_TEST */

/*
 *----------------------------------------------------------------------
 *
 * main --
 *
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
 *
 *	This procedure performs application-specific initialization.
 *	Most applications, especially those that incorporate additional
 *	packages, will have their own version of this procedure.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error
 *	message in interp->result if an error occurs.
 *
 * Side effects:
 *	Depends on the startup script.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AppInit(interp)
    Tcl_Interp *interp;		/* Interpreter for application. */
{
    if (Tcl_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (Tk_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
#ifdef TK_TEST





    if (Tktest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
            (Tcl_PackageInitProc *) NULL);
#endif /* TK_TEST */








|



















>
>
>
>
>







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
 *
 *	This procedure performs application-specific initialization.
 *	Most applications, especially those that incorporate additional
 *	packages, will have their own version of this procedure.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error
 *	message in the interp's result if an error occurs.
 *
 * Side effects:
 *	Depends on the startup script.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AppInit(interp)
    Tcl_Interp *interp;		/* Interpreter for application. */
{
    if (Tcl_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (Tk_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
#ifdef TK_TEST
    if (Tcltest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
            (Tcl_PackageInitProc *) NULL);
    if (Tktest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
            (Tcl_PackageInitProc *) NULL);
#endif /* TK_TEST */

Changes to unix/tkConfig.sh.in.

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
# tkConfig.sh --
# 
# This shell script (for sh) is generated automatically by Tk's
# configure script.  It will create shell variables for most of
# the configuration options discovered by the configure script.
# This script is intended to be included by the configure scripts
# for Tk extensions so that they don't have to figure this all
# out for themselves.  This file does not duplicate information
# already provided by tclConfig.sh, so you may need to use that
# file in addition to this one.
#
# The information in this file is specific to a single platform.
#
# SCCS: @(#) tkConfig.sh.in 1.11 97/10/30 13:29:13

# Tk's version number.
TK_VERSION='@TK_VERSION@'
TK_MAJOR_VERSION='@TK_MAJOR_VERSION@'
TK_MINOR_VERSION='@TK_MINOR_VERSION@'
TK_PATCH_LEVEL='@TK_PATCH_LEVEL@'

# -D flags for use with the C compiler.
TK_DEFS='@DEFS@'

# Flag, 1: we built a shared lib, 0 we didn't
TK_SHARED_BUILD=@TK_SHARED_BUILD@




# The name of the Tk library (may be either a .a file or a shared library):
TK_LIB_FILE=@TK_LIB_FILE@

# Additional libraries to use when linking Tk.
TK_LIBS='@XLIBSW@ @DL_LIBS@ @LIBS@ @MATH_LIBS@'

# Top-level directory in which Tcl's platform-independent files are
# installed.
TK_PREFIX='@prefix@'

# Top-level directory in which Tcl's platform-specific files (e.g.
# executables) are installed.
TK_EXEC_PREFIX='@exec_prefix@'

# -I switch(es) to use to make all of the X11 include files accessible:
TK_XINCLUDES='@XINCLUDES@'

# Linker switch(es) to use to link with the X11 library archive.
TK_XLIBSW='@XLIBSW@'




# String to pass to linker to pick up the Tk library from its
# build directory.
TK_BUILD_LIB_SPEC='@TK_BUILD_LIB_SPEC@'

# String to pass to linker to pick up the Tk library from its
# installed directory.













|













>
>
>

|

















>
>
>







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
# tkConfig.sh --
# 
# This shell script (for sh) is generated automatically by Tk's
# configure script.  It will create shell variables for most of
# the configuration options discovered by the configure script.
# This script is intended to be included by the configure scripts
# for Tk extensions so that they don't have to figure this all
# out for themselves.  This file does not duplicate information
# already provided by tclConfig.sh, so you may need to use that
# file in addition to this one.
#
# The information in this file is specific to a single platform.
#
# RCS: @(#) $Id: tkConfig.sh.in,v 1.1.4.2 1999/03/10 07:13:50 stanton Exp $

# Tk's version number.
TK_VERSION='@TK_VERSION@'
TK_MAJOR_VERSION='@TK_MAJOR_VERSION@'
TK_MINOR_VERSION='@TK_MINOR_VERSION@'
TK_PATCH_LEVEL='@TK_PATCH_LEVEL@'

# -D flags for use with the C compiler.
TK_DEFS='@DEFS@'

# Flag, 1: we built a shared lib, 0 we didn't
TK_SHARED_BUILD=@TK_SHARED_BUILD@

# This indicates if Tk was build with debugging symbols
TK_DBGX=@TK_DBGX@

# The name of the Tk library (may be either a .a file or a shared library):
TK_LIB_FILE='@TK_LIB_FILE@'

# Additional libraries to use when linking Tk.
TK_LIBS='@XLIBSW@ @DL_LIBS@ @LIBS@ @MATH_LIBS@'

# Top-level directory in which Tcl's platform-independent files are
# installed.
TK_PREFIX='@prefix@'

# Top-level directory in which Tcl's platform-specific files (e.g.
# executables) are installed.
TK_EXEC_PREFIX='@exec_prefix@'

# -I switch(es) to use to make all of the X11 include files accessible:
TK_XINCLUDES='@XINCLUDES@'

# Linker switch(es) to use to link with the X11 library archive.
TK_XLIBSW='@XLIBSW@'

# -l flag to pass to the linker to pick up the Tcl library
TK_LIB_FLAG='@TK_LIB_FLAG@'

# String to pass to linker to pick up the Tk library from its
# build directory.
TK_BUILD_LIB_SPEC='@TK_BUILD_LIB_SPEC@'

# String to pass to linker to pick up the Tk library from its
# installed directory.
62
63
64
65
66
67
68



















TK_SRC_DIR='@TK_SRC_DIR@'

# Needed if you want to make a 'fat' shared library library
# containing tk objects or link a different wish.
TK_CC_SEARCH_FLAGS='@TK_CC_SEARCH_FLAGS@'
TK_LD_SEARCH_FLAGS='@TK_LD_SEARCH_FLAGS@'



























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
TK_SRC_DIR='@TK_SRC_DIR@'

# Needed if you want to make a 'fat' shared library library
# containing tk objects or link a different wish.
TK_CC_SEARCH_FLAGS='@TK_CC_SEARCH_FLAGS@'
TK_LD_SEARCH_FLAGS='@TK_LD_SEARCH_FLAGS@'

# The name of the Tk stub library (.a):
TK_STUB_LIB_FILE='@TK_STUB_LIB_FILE@'

# -l flag to pass to the linker to pick up the Tk stub library
TK_STUB_LIB_FLAG='@TK_STUB_LIB_FLAG@'

# String to pass to linker to pick up the Tk stub library from its
# build directory.
TK_BUILD_STUB_LIB_SPEC='@TK_BUILD_STUB_LIB_SPEC@'

# String to pass to linker to pick up the Tk stub library from its
# installed directory.
TK_STUB_LIB_SPEC='@TK_STUB_LIB_SPEC@'

# Path to the Tk stub library in the build directory.
TK_BUILD_STUB_LIB_PATH='@TK_BUILD_STUB_LIB_PATH@'

# Path to the Tk stub library in the install directory.
TK_STUB_LIB_PATH='@TK_STUB_LIB_PATH@'

Changes to unix/tkUnix.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkUnix.c --
 *
 *	This file contains procedures that are UNIX/X-specific, and
 *	will probably have to be written differently for Windows or
 *	Macintosh platforms.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnix.c 1.5 97/01/07 11:41:39
 */

#include <tkInt.h>

/*
 *----------------------------------------------------------------------
 *












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkUnix.c --
 *
 *	This file contains procedures that are UNIX/X-specific, and
 *	will probably have to be written differently for Windows or
 *	Macintosh platforms.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnix.c,v 1.1.4.3 1999/03/10 07:13:50 stanton Exp $
 */

#include <tkInt.h>

/*
 *----------------------------------------------------------------------
 *
36
37
38
39
40
41
42

43
44
45
46
47
48
49
50
void
TkGetServerInfo(interp, tkwin)
    Tcl_Interp *interp;		/* The server information is returned in
				 * this interpreter's result. */
    Tk_Window tkwin;		/* Token for window;  this selects a
				 * particular display and server. */
{

    char buffer[50], buffer2[50];

    sprintf(buffer, "X%dR%d ", ProtocolVersion(Tk_Display(tkwin)),
	    ProtocolRevision(Tk_Display(tkwin)));
    sprintf(buffer2, " %d", VendorRelease(Tk_Display(tkwin)));
    Tcl_AppendResult(interp, buffer, ServerVendor(Tk_Display(tkwin)),
	    buffer2, (char *) NULL);
}







>
|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
void
TkGetServerInfo(interp, tkwin)
    Tcl_Interp *interp;		/* The server information is returned in
				 * this interpreter's result. */
    Tk_Window tkwin;		/* Token for window;  this selects a
				 * particular display and server. */
{
    char buffer[8 + TCL_INTEGER_SPACE * 2];
    char buffer2[TCL_INTEGER_SPACE];

    sprintf(buffer, "X%dR%d ", ProtocolVersion(Tk_Display(tkwin)),
	    ProtocolRevision(Tk_Display(tkwin)));
    sprintf(buffer2, " %d", VendorRelease(Tk_Display(tkwin)));
    Tcl_AppendResult(interp, buffer, ServerVendor(Tk_Display(tkwin)),
	    buffer2, (char *) NULL);
}
73
74
75
76
77
78
79




























    char *screenName;		/* Screen name from command line, or NULL. */
{
    if ((screenName == NULL) || (screenName[0] == '\0')) {
	screenName = Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY);
    }
    return screenName;
}



































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
    char *screenName;		/* Screen name from command line, or NULL. */
{
    if ((screenName == NULL) || (screenName[0] == '\0')) {
	screenName = Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY);
    }
    return screenName;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_UpdatePointer --
 *
 *	Unused function in UNIX
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tk_UpdatePointer(tkwin, x, y, state)
    Tk_Window tkwin;		/* Window to which pointer event
				 * is reported. May be NULL. */
    int x, y;			/* Pointer location in root coords. */
    int state;			/* Modifier state mask. */
{
  /*
   * This function intentionally left blank
   */
}

Changes to unix/tkUnix3d.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15




16
17
18
19
20
21
22
/* 
 * tkUnix3d.c --
 *
 *	This file contains the platform specific routines for
 *	drawing 3d borders in the Motif style.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnix3d.c 1.3 96/11/20 14:24:38
 */

#include <tk3d.h>





/*
 * This structure is used to keep track of the extra colors used
 * by Unix 3d borders.
 */

typedef struct {











|



>
>
>
>







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
/* 
 * tkUnix3d.c --
 *
 *	This file contains the platform specific routines for
 *	drawing 3d borders in the Motif style.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnix3d.c,v 1.1.4.2 1999/03/10 07:13:50 stanton Exp $
 */

#include <tk3d.h>

#if !defined(__WIN32__) && !defined(MAC_TCL)
#include "tkUnixInt.h"
#endif

/*
 * This structure is used to keep track of the extra colors used
 * by Unix 3d borders.
 */

typedef struct {

Changes to unix/tkUnixButton.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkUnixButton.c --
 *
 *	This file implements the Unix specific portion of the button
 *	widgets.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixButton.c 1.4 97/06/06 11:21:40
 */

#include "tkButton.h"

/*
 * Declaration of Unix specific button structure.
 */






|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkUnixButton.c --
 *
 *	This file implements the Unix specific portion of the button
 *	widgets.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixButton.c,v 1.1.4.3 1999/03/30 04:12:59 stanton Exp $
 */

#include "tkButton.h"

/*
 * Declaration of Unix specific button structure.
 */
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
    register TkButton *butPtr = (TkButton *) clientData;
    GC gc;
    Tk_3DBorder border;
    Pixmap pixmap;
    int x = 0;			/* Initialization only needed to stop
				 * compiler warning. */
    int y, relief;
    register Tk_Window tkwin = butPtr->tkwin;
    int width, height;
    int offset;			/* 0 means this is a label widget.  1 means
				 * it is a flavor of button, so we offset
				 * the text to make the button appear to
				 * move up and down as the relief changes. */

    butPtr->flags &= ~REDRAW_PENDING;
    if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
	return;
    }

    border = butPtr->normalBorder;
    if ((butPtr->state == tkDisabledUid) && (butPtr->disabledFg != NULL)) {
	gc = butPtr->disabledGC;
    } else if ((butPtr->state == tkActiveUid)
	    && !Tk_StrictMotif(butPtr->tkwin)) {
	gc = butPtr->activeTextGC;
	border = butPtr->activeBorder;
    } else {
	gc = butPtr->normalTextGC;
    }
    if ((butPtr->flags & SELECTED) && (butPtr->state != tkActiveUid)
	    && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) {
	border = butPtr->selectBorder;
    }

    /*
     * Override the relief specified for the button if this is a
     * checkbutton or radiobutton and there's no indicator.







|

|
<
|
|







|

|






|







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
    register TkButton *butPtr = (TkButton *) clientData;
    GC gc;
    Tk_3DBorder border;
    Pixmap pixmap;
    int x = 0;			/* Initialization only needed to stop
				 * compiler warning. */
    int y, relief;
    Tk_Window tkwin = butPtr->tkwin;
    int width, height;
    int offset;			/* 1 means this is a button widget, so we

				 * offset the text to make the button appear
				 * to move up and down as the relief changes. */

    butPtr->flags &= ~REDRAW_PENDING;
    if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
	return;
    }

    border = butPtr->normalBorder;
    if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) {
	gc = butPtr->disabledGC;
    } else if ((butPtr->state == STATE_ACTIVE)
	    && !Tk_StrictMotif(butPtr->tkwin)) {
	gc = butPtr->activeTextGC;
	border = butPtr->activeBorder;
    } else {
	gc = butPtr->normalTextGC;
    }
    if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE)
	    && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) {
	border = butPtr->selectBorder;
    }

    /*
     * Override the relief specified for the button if this is a
     * checkbutton or radiobutton and there's no indicator.
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
    Tk_Fill3DRectangle(tkwin, pixmap, border, 0, 0, Tk_Width(tkwin),
	    Tk_Height(tkwin), 0, TK_RELIEF_FLAT);

    /*
     * Display image or bitmap or text for button.
     */

    if (butPtr->image != None) {
	Tk_SizeOfImage(butPtr->image, &width, &height);

	imageOrBitmap:
	TkComputeAnchor(butPtr->anchor, tkwin, 0, 0,
		butPtr->indicatorSpace + width, height, &x, &y);
	x += butPtr->indicatorSpace;








|







136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
    Tk_Fill3DRectangle(tkwin, pixmap, border, 0, 0, Tk_Width(tkwin),
	    Tk_Height(tkwin), 0, TK_RELIEF_FLAT);

    /*
     * Display image or bitmap or text for button.
     */

    if (butPtr->image != NULL) {
	Tk_SizeOfImage(butPtr->image, &width, &height);

	imageOrBitmap:
	TkComputeAnchor(butPtr->anchor, tkwin, 0, 0,
		butPtr->indicatorSpace + width, height, &x, &y);
	x += butPtr->indicatorSpace;

209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
	int dim;

	dim = butPtr->indicatorDiameter;
	x -= butPtr->indicatorSpace;
	y -= dim/2;
	if (dim > 2*butPtr->borderWidth) {
	    Tk_Draw3DRectangle(tkwin, pixmap, border, x, y, dim, dim,
		    butPtr->borderWidth, 
		    (butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN :
		    TK_RELIEF_RAISED);
	    x += butPtr->borderWidth;
	    y += butPtr->borderWidth;
	    dim -= 2*butPtr->borderWidth;
	    if (butPtr->flags & SELECTED) {
		GC gc;

		gc = Tk_3DBorderGC(tkwin,(butPtr->selectBorder != NULL)
			? butPtr->selectBorder : butPtr->normalBorder,
			TK_3D_FLAT_GC);
		XFillRectangle(butPtr->display, pixmap, gc, x, y,
			(unsigned int) dim, (unsigned int) dim);
	    } else {
		Tk_Fill3DRectangle(tkwin, pixmap, butPtr->normalBorder, x, y,
			dim, dim, butPtr->borderWidth, TK_RELIEF_FLAT);







|








|







208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
	int dim;

	dim = butPtr->indicatorDiameter;
	x -= butPtr->indicatorSpace;
	y -= dim/2;
	if (dim > 2*butPtr->borderWidth) {
	    Tk_Draw3DRectangle(tkwin, pixmap, border, x, y, dim, dim,
		    butPtr->borderWidth,
		    (butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN :
		    TK_RELIEF_RAISED);
	    x += butPtr->borderWidth;
	    y += butPtr->borderWidth;
	    dim -= 2*butPtr->borderWidth;
	    if (butPtr->flags & SELECTED) {
		GC gc;

		gc = Tk_3DBorderGC(tkwin, (butPtr->selectBorder != NULL)
			? butPtr->selectBorder : butPtr->normalBorder,
			TK_3D_FLAT_GC);
		XFillRectangle(butPtr->display, pixmap, gc, x, y,
			(unsigned int) dim, (unsigned int) dim);
	    } else {
		Tk_Fill3DRectangle(tkwin, pixmap, butPtr->normalBorder, x, y,
			dim, dim, butPtr->borderWidth, TK_RELIEF_FLAT);
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
    /*
     * If the button is disabled with a stipple rather than a special
     * foreground color, generate the stippled effect.  If the widget
     * is selected and we use a different background color when selected,
     * must temporarily modify the GC.
     */

    if ((butPtr->state == tkDisabledUid)
	    && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
	if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
		&& (butPtr->selectBorder != NULL)) {
	    XSetForeground(butPtr->display, butPtr->disabledGC,
		    Tk_3DBorderColor(butPtr->selectBorder)->pixel);
	}
	XFillRectangle(butPtr->display, pixmap, butPtr->disabledGC,







|







264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
    /*
     * If the button is disabled with a stipple rather than a special
     * foreground color, generate the stippled effect.  If the widget
     * is selected and we use a different background color when selected,
     * must temporarily modify the GC.
     */

    if ((butPtr->state == STATE_DISABLED)
	    && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
	if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
		&& (butPtr->selectBorder != NULL)) {
	    XSetForeground(butPtr->display, butPtr->disabledGC,
		    Tk_3DBorderColor(butPtr->selectBorder)->pixel);
	}
	XFillRectangle(butPtr->display, pixmap, butPtr->disabledGC,
293
294
295
296
297
298
299

300
301
302
303
304
305
306
307
     * This code is complicated by the possible combinations of focus
     * highlight and default rings.  We draw the focus and highlight rings
     * using the highlight border and highlight foreground color.
     */

    if (relief != TK_RELIEF_FLAT) {
	int inset = butPtr->highlightWidth;

	if (butPtr->defaultState == tkActiveUid) {
	    /*
	     * Draw the default ring with 2 pixels of space between the
	     * default ring and the button and the default ring and the
	     * focus ring.  Note that we need to explicitly draw the space
	     * in the highlightBorder color to ensure that we overwrite any
	     * overflow text and/or a different button background color.
	     */







>
|







292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
     * This code is complicated by the possible combinations of focus
     * highlight and default rings.  We draw the focus and highlight rings
     * using the highlight border and highlight foreground color.
     */

    if (relief != TK_RELIEF_FLAT) {
	int inset = butPtr->highlightWidth;

	if (butPtr->defaultState == DEFAULT_ACTIVE) {
	    /*
	     * Draw the default ring with 2 pixels of space between the
	     * default ring and the button and the default ring and the
	     * focus ring.  Note that we need to explicitly draw the space
	     * in the highlightBorder color to ensure that we overwrite any
	     * overflow text and/or a different button background color.
	     */
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
		    Tk_Height(tkwin) - 2*inset, 1, TK_RELIEF_SUNKEN);
	    inset++;
	    Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, inset,
		    inset, Tk_Width(tkwin) - 2*inset,
		    Tk_Height(tkwin) - 2*inset, 2, TK_RELIEF_FLAT);

	    inset += 2;
	} else if (butPtr->defaultState == tkNormalUid) {
	    /*
	     * Leave room for the default ring and write over any text or
	     * background color.
	     */

	    Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0,
		    0, Tk_Width(tkwin),
		    Tk_Height(tkwin), 5, TK_RELIEF_FLAT);
	    inset += 5;
	}

	/*
	 * Draw the button border.
	 */

	Tk_Draw3DRectangle(tkwin, pixmap, border, inset, inset,
		Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset,
		butPtr->borderWidth, relief);
    }
    if (butPtr->highlightWidth != 0) {
	GC gc;

	if (butPtr->flags & GOT_FOCUS) {
	    gc = Tk_GCForColor(butPtr->highlightColorPtr, pixmap);
	} else {
	    gc = Tk_GCForColor(Tk_3DBorderColor(butPtr->highlightBorder),
		    pixmap);
	}

	/*
	 * Make sure the focus ring shrink-wraps the actual button, not the
	 * padding space left for a default ring.
	 */

	if (butPtr->defaultState == tkNormalUid) {
	    TkDrawInsetFocusHighlight(tkwin, gc, butPtr->highlightWidth,
		    pixmap, 5);
	} else {
	    Tk_DrawFocusHighlight(tkwin, gc, butPtr->highlightWidth, pixmap);
	}
    }








|






<
|











|














|







315
316
317
318
319
320
321
322
323
324
325
326
327
328

329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
		    Tk_Height(tkwin) - 2*inset, 1, TK_RELIEF_SUNKEN);
	    inset++;
	    Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, inset,
		    inset, Tk_Width(tkwin) - 2*inset,
		    Tk_Height(tkwin) - 2*inset, 2, TK_RELIEF_FLAT);

	    inset += 2;
	} else if (butPtr->defaultState == DEFAULT_NORMAL) {
	    /*
	     * Leave room for the default ring and write over any text or
	     * background color.
	     */

	    Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0,

		    0, Tk_Width(tkwin), Tk_Height(tkwin), 5, TK_RELIEF_FLAT);
	    inset += 5;
	}

	/*
	 * Draw the button border.
	 */

	Tk_Draw3DRectangle(tkwin, pixmap, border, inset, inset,
		Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset,
		butPtr->borderWidth, relief);
    }
    if (butPtr->highlightWidth > 0) {
	GC gc;

	if (butPtr->flags & GOT_FOCUS) {
	    gc = Tk_GCForColor(butPtr->highlightColorPtr, pixmap);
	} else {
	    gc = Tk_GCForColor(Tk_3DBorderColor(butPtr->highlightBorder),
		    pixmap);
	}

	/*
	 * Make sure the focus ring shrink-wraps the actual button, not the
	 * padding space left for a default ring.
	 */

	if (butPtr->defaultState == DEFAULT_NORMAL) {
	    TkDrawInsetFocusHighlight(tkwin, gc, butPtr->highlightWidth,
		    pixmap, 5);
	} else {
	    Tk_DrawFocusHighlight(tkwin, gc, butPtr->highlightWidth, pixmap);
	}
    }

394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
void
TkpComputeButtonGeometry(butPtr)
    register TkButton *butPtr;	/* Button whose geometry may have changed. */
{
    int width, height, avgWidth;
    Tk_FontMetrics fm;

    if (butPtr->highlightWidth < 0) {
	butPtr->highlightWidth = 0;
    }
    butPtr->inset = butPtr->highlightWidth + butPtr->borderWidth;

    /*
     * Leave room for the default ring if needed.
     */

    if (butPtr->defaultState != tkDisabledUid) {
	butPtr->inset += 5;
    }
    butPtr->indicatorSpace = 0;
    if (butPtr->image != NULL) {
	Tk_SizeOfImage(butPtr->image, &width, &height);
	imageOrBitmap:
	if (butPtr->width > 0) {







<
<
<






|







393
394
395
396
397
398
399



400
401
402
403
404
405
406
407
408
409
410
411
412
413
void
TkpComputeButtonGeometry(butPtr)
    register TkButton *butPtr;	/* Button whose geometry may have changed. */
{
    int width, height, avgWidth;
    Tk_FontMetrics fm;




    butPtr->inset = butPtr->highlightWidth + butPtr->borderWidth;

    /*
     * Leave room for the default ring if needed.
     */

    if (butPtr->defaultState != DEFAULT_DISABLED) {
	butPtr->inset += 5;
    }
    butPtr->indicatorSpace = 0;
    if (butPtr->image != NULL) {
	Tk_SizeOfImage(butPtr->image, &width, &height);
	imageOrBitmap:
	if (butPtr->width > 0) {
429
430
431
432
433
434
435

436
437
438
439
440
441
442
443
444
445
	    }
	}
    } else if (butPtr->bitmap != None) {
	Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
	goto imageOrBitmap;
    } else {
	Tk_FreeTextLayout(butPtr->textLayout);

	butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
		butPtr->text, -1, butPtr->wrapLength, butPtr->justify, 0,
		&butPtr->textWidth, &butPtr->textHeight);

	width = butPtr->textWidth;
	height = butPtr->textHeight;
	avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1);
	Tk_GetFontMetrics(butPtr->tkfont, &fm);

	if (butPtr->width > 0) {







>

|
|







425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
	    }
	}
    } else if (butPtr->bitmap != None) {
	Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
	goto imageOrBitmap;
    } else {
	Tk_FreeTextLayout(butPtr->textLayout);

	butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
		Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength,
		butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight);

	width = butPtr->textWidth;
	height = butPtr->textHeight;
	avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1);
	Tk_GetFontMetrics(butPtr->tkfont, &fm);

	if (butPtr->width > 0) {

Changes to unix/tkUnixColor.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkUnixColor.c --
 *
 *	This file contains the platform specific color routines
 *	needed for X support.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixColor.c 1.1 96/10/22 16:52:31
 */

#include <tkColor.h>

/*
 * If a colormap fills up, attempts to allocate new colors from that
 * colormap will fail.  When that happens, we'll just choose the











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkUnixColor.c --
 *
 *	This file contains the platform specific color routines
 *	needed for X support.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixColor.c,v 1.1.4.1 1998/09/30 02:19:14 stanton Exp $
 */

#include <tkColor.h>

/*
 * If a colormap fills up, attempts to allocate new colors from that
 * colormap will fail.  When that happens, we'll just choose the

Added unix/tkUnixConfig.c.



























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
/* 
 * tkUnixConfig.c --
 *
 *	This module implements the Unix system defaults for
 *	the configuration package.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixConfig.c,v 1.1.2.2 1998/09/30 02:19:15 stanton Exp $
 */

#include "tk.h"
#include "tkInt.h"


/*
 *----------------------------------------------------------------------
 *
 * TkpGetSystemDefault --
 *
 *	Given a dbName and className for a configuration option,
 *	return a string representation of the option.
 *
 * Results:
 *	Returns a Tk_Uid that is the string identifier that identifies
 *	this option. Returns NULL if there are no system defaults
 *	that match this pair.
 *
 * Side effects:
 *	None, once the package is initialized.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TkpGetSystemDefault(tkwin, dbName, className)
    Tk_Window tkwin;		/* A window to use. */
    char *dbName;		/* The option database name. */
    char *className;		/* The name of the option class. */
{
    return NULL;
}

Changes to unix/tkUnixCursor.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkUnixCursor.c --
 *
 *	This file contains X specific cursor manipulation routines.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixCursor.c 1.4 96/10/08 09:33:08
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * The following data structure is a superset of the TkCursor structure





|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkUnixCursor.c --
 *
 *	This file contains X specific cursor manipulation routines.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixCursor.c,v 1.1.4.2 1998/09/30 02:19:15 stanton Exp $
 */

#include "tkPort.h"
#include "tkInt.h"

/*
 * The following data structure is a superset of the TkCursor structure
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
		}
	    }
	}
	dispPtr = ((TkWindow *) tkwin)->dispPtr;
	if (dispPtr->cursorFont == None) {
	    dispPtr->cursorFont = XLoadFont(display, CURSORFONT);
	    if (dispPtr->cursorFont == None) {
		interp->result = "couldn't load cursor font";
		goto cleanup;
	    }
	}
	cursor = XCreateGlyphCursor(display, dispPtr->cursorFont,
		dispPtr->cursorFont, namePtr->shape, maskIndex,
		&fg, &bg);
    } else {







|







214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
		}
	    }
	}
	dispPtr = ((TkWindow *) tkwin)->dispPtr;
	if (dispPtr->cursorFont == None) {
	    dispPtr->cursorFont = XLoadFont(display, CURSORFONT);
	    if (dispPtr->cursorFont == None) {
		Tcl_SetResult(interp, "couldn't load cursor font", TCL_STATIC);
		goto cleanup;
	    }
	}
	cursor = XCreateGlyphCursor(display, dispPtr->cursorFont,
		dispPtr->cursorFont, namePtr->shape, maskIndex,
		&fg, &bg);
    } else {
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
	 * should be either two elements in the list (source, color) or
	 * four (source mask fg bg).
	 */

	if ((argc != 2) && (argc != 4)) {
	    goto badString;
	}
	if (XReadBitmapFile(display,
		RootWindowOfScreen(Tk_Screen(tkwin)), &argv[0][1],
		(unsigned int *) &width, (unsigned int *) &height,
		&source, &xHot, &yHot) != BitmapSuccess) {
	    Tcl_AppendResult(interp, "cleanup reading bitmap file \"",
		    &argv[0][1], "\"", (char *) NULL);
	    goto cleanup;
	}







|







246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
	 * should be either two elements in the list (source, color) or
	 * four (source mask fg bg).
	 */

	if ((argc != 2) && (argc != 4)) {
	    goto badString;
	}
	if (TkReadBitmapFile(display,
		RootWindowOfScreen(Tk_Screen(tkwin)), &argv[0][1],
		(unsigned int *) &width, (unsigned int *) &height,
		&source, &xHot, &yHot) != BitmapSuccess) {
	    Tcl_AppendResult(interp, "cleanup reading bitmap file \"",
		    &argv[0][1], "\"", (char *) NULL);
	    goto cleanup;
	}
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286

287
288
289
290
291
292
293
		Tcl_AppendResult(interp, "invalid color name \"",
			argv[1], "\"", (char *) NULL);
		goto cleanup;
	    }
	    cursor = XCreatePixmapCursor(display, source, source,
		    &fg, &fg, (unsigned) xHot, (unsigned) yHot);
	} else {
	    if (XReadBitmapFile(display,
		    RootWindowOfScreen(Tk_Screen(tkwin)), argv[1],
		    (unsigned int *) &maskWidth, (unsigned int *) &maskHeight,
		    &mask, &dummy1, &dummy2) != BitmapSuccess) {
		Tcl_AppendResult(interp, "cleanup reading bitmap file \"",
			argv[1], "\"", (char *) NULL);
		goto cleanup;
	    }
	    if ((maskWidth != width) && (maskHeight != height)) {
		interp->result =
			"source and mask bitmaps have different sizes";

		goto cleanup;
	    }
	    if (XParseColor(display, Tk_Colormap(tkwin), argv[2],
		    &fg) == 0) {
		Tcl_AppendResult(interp, "invalid color name \"", argv[2],
			"\"", (char *) NULL);
		goto cleanup;







|








|
|
>







269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
		Tcl_AppendResult(interp, "invalid color name \"",
			argv[1], "\"", (char *) NULL);
		goto cleanup;
	    }
	    cursor = XCreatePixmapCursor(display, source, source,
		    &fg, &fg, (unsigned) xHot, (unsigned) yHot);
	} else {
	    if (TkReadBitmapFile(display,
		    RootWindowOfScreen(Tk_Screen(tkwin)), argv[1],
		    (unsigned int *) &maskWidth, (unsigned int *) &maskHeight,
		    &mask, &dummy1, &dummy2) != BitmapSuccess) {
		Tcl_AppendResult(interp, "cleanup reading bitmap file \"",
			argv[1], "\"", (char *) NULL);
		goto cleanup;
	    }
	    if ((maskWidth != width) && (maskHeight != height)) {
		Tcl_SetResult(interp,
			"source and mask bitmaps have different sizes",
			TCL_STATIC);
		goto cleanup;
	    }
	    if (XParseColor(display, Tk_Colormap(tkwin), argv[2],
		    &fg) == 0) {
		Tcl_AppendResult(interp, "invalid color name \"", argv[2],
			"\"", (char *) NULL);
		goto cleanup;
319
320
321
322
323
324
325



326
327
328
329
330
331
332
    if (mask != None) {
	Tk_FreePixmap(display, mask);
    }
    return (TkCursor *) cursorPtr;


    badString:



    Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"",
	    (char *) NULL);
    return NULL;
}

/*
 *----------------------------------------------------------------------







>
>
>







320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
    if (mask != None) {
	Tk_FreePixmap(display, mask);
    }
    return (TkCursor *) cursorPtr;


    badString:
    if (argv) {
	ckfree((char *) argv);
    }
    Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"",
	    (char *) NULL);
    return NULL;
}

/*
 *----------------------------------------------------------------------
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
    }
    return (TkCursor *) cursorPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TkFreeCursor --
 *
 *	This procedure is called to release a cursor allocated by
 *	TkGetCursorByName.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The cursor data structure is deallocated.
 *
 *----------------------------------------------------------------------
 */

void
TkFreeCursor(cursorPtr)
    TkCursor *cursorPtr;
{
    TkUnixCursor *unixCursorPtr = (TkUnixCursor *) cursorPtr;
    XFreeCursor(unixCursorPtr->display, (Cursor) unixCursorPtr->info.cursor);
    Tk_FreeXId(unixCursorPtr->display, (XID) unixCursorPtr->info.cursor);
    ckfree((char *) unixCursorPtr);
}







|














|





<

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
    }
    return (TkCursor *) cursorPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TkpFreeCursor --
 *
 *	This procedure is called to release a cursor allocated by
 *	TkGetCursorByName.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The cursor data structure is deallocated.
 *
 *----------------------------------------------------------------------
 */

void
TkpFreeCursor(cursorPtr)
    TkCursor *cursorPtr;
{
    TkUnixCursor *unixCursorPtr = (TkUnixCursor *) cursorPtr;
    XFreeCursor(unixCursorPtr->display, (Cursor) unixCursorPtr->info.cursor);
    Tk_FreeXId(unixCursorPtr->display, (XID) unixCursorPtr->info.cursor);

}

Changes to unix/tkUnixDefault.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkUnixDefault.h --
 *
 *	This file defines the defaults for all options for all of
 *	the Tk widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixDefault.h 1.105 97/10/09 17:45:10
 */

#ifndef _TKUNIXDEFAULT
#define _TKUNIXDEFAULT

/*
 * The definitions below provide symbolic names for the default colors.












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkUnixDefault.h --
 *
 *	This file defines the defaults for all options for all of
 *	the Tk widgets.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixDefault.h,v 1.1.4.4 1999/02/16 06:00:09 lfb Exp $
 */

#ifndef _TKUNIXDEFAULT
#define _TKUNIXDEFAULT

/*
 * The definitions below provide symbolic names for the default colors.
55
56
57
58
59
60
61

62
63
64
65
66
67
68
69
#define DEF_BUTTON_DEFAULT		"disabled"
#define DEF_BUTTON_DISABLED_FG_COLOR	DISABLED
#define DEF_BUTTON_DISABLED_FG_MONO	""
#define DEF_BUTTON_FG			BLACK
#define DEF_CHKRAD_FG			DEF_BUTTON_FG
#define DEF_BUTTON_FONT			"Helvetica -12 bold"
#define DEF_BUTTON_HEIGHT		"0"

#define DEF_BUTTON_HIGHLIGHT_BG		NORMAL_BG
#define DEF_BUTTON_HIGHLIGHT		BLACK
#define DEF_LABEL_HIGHLIGHT_WIDTH	"0"
#define DEF_BUTTON_HIGHLIGHT_WIDTH	"1"
#define DEF_BUTTON_IMAGE		(char *) NULL
#define DEF_BUTTON_INDICATOR		"1"
#define DEF_BUTTON_JUSTIFY		"center"
#define DEF_BUTTON_OFF_VALUE		"0"







>
|







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
#define DEF_BUTTON_DEFAULT		"disabled"
#define DEF_BUTTON_DISABLED_FG_COLOR	DISABLED
#define DEF_BUTTON_DISABLED_FG_MONO	""
#define DEF_BUTTON_FG			BLACK
#define DEF_CHKRAD_FG			DEF_BUTTON_FG
#define DEF_BUTTON_FONT			"Helvetica -12 bold"
#define DEF_BUTTON_HEIGHT		"0"
#define DEF_BUTTON_HIGHLIGHT_BG_COLOR	DEF_BUTTON_BG_COLOR
#define DEF_BUTTON_HIGHLIGHT_BG_MONO	DEF_BUTTON_BG_MONO
#define DEF_BUTTON_HIGHLIGHT		BLACK
#define DEF_LABEL_HIGHLIGHT_WIDTH	"0"
#define DEF_BUTTON_HIGHLIGHT_WIDTH	"1"
#define DEF_BUTTON_IMAGE		(char *) NULL
#define DEF_BUTTON_INDICATOR		"1"
#define DEF_BUTTON_JUSTIFY		"center"
#define DEF_BUTTON_OFF_VALUE		"0"
278
279
280
281
282
283
284

285
286
287
288
289
290
291
292
#define DEF_MENUBUTTON_CURSOR		""
#define DEF_MENUBUTTON_DIRECTION	"below"
#define DEF_MENUBUTTON_DISABLED_FG_COLOR DISABLED
#define DEF_MENUBUTTON_DISABLED_FG_MONO	""
#define DEF_MENUBUTTON_FONT		"Helvetica -12 bold"
#define DEF_MENUBUTTON_FG		BLACK
#define DEF_MENUBUTTON_HEIGHT		"0"

#define DEF_MENUBUTTON_HIGHLIGHT_BG	NORMAL_BG
#define DEF_MENUBUTTON_HIGHLIGHT	BLACK
#define DEF_MENUBUTTON_HIGHLIGHT_WIDTH	"0"
#define DEF_MENUBUTTON_IMAGE		(char *) NULL
#define DEF_MENUBUTTON_INDICATOR	"0"
#define DEF_MENUBUTTON_JUSTIFY		"center"
#define DEF_MENUBUTTON_MENU		""
#define DEF_MENUBUTTON_PADX		"4p"







>
|







279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
#define DEF_MENUBUTTON_CURSOR		""
#define DEF_MENUBUTTON_DIRECTION	"below"
#define DEF_MENUBUTTON_DISABLED_FG_COLOR DISABLED
#define DEF_MENUBUTTON_DISABLED_FG_MONO	""
#define DEF_MENUBUTTON_FONT		"Helvetica -12 bold"
#define DEF_MENUBUTTON_FG		BLACK
#define DEF_MENUBUTTON_HEIGHT		"0"
#define DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR DEF_MENUBUTTON_BG_COLOR
#define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO  DEF_MENUBUTTON_BG_MONO
#define DEF_MENUBUTTON_HIGHLIGHT	BLACK
#define DEF_MENUBUTTON_HIGHLIGHT_WIDTH	"0"
#define DEF_MENUBUTTON_IMAGE		(char *) NULL
#define DEF_MENUBUTTON_INDICATOR	"0"
#define DEF_MENUBUTTON_JUSTIFY		"center"
#define DEF_MENUBUTTON_MENU		""
#define DEF_MENUBUTTON_PADX		"4p"
337
338
339
340
341
342
343

344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
#define DEF_SCALE_COMMAND		""
#define DEF_SCALE_CURSOR		""
#define DEF_SCALE_DIGITS		"0"
#define DEF_SCALE_FONT			"Helvetica -12 bold"
#define DEF_SCALE_FG_COLOR		BLACK
#define DEF_SCALE_FG_MONO		BLACK
#define DEF_SCALE_FROM			"0"

#define DEF_SCALE_HIGHLIGHT_BG		NORMAL_BG
#define DEF_SCALE_HIGHLIGHT		BLACK
#define DEF_SCALE_HIGHLIGHT_WIDTH	"1"
#define DEF_SCALE_LABEL			""
#define DEF_SCALE_LENGTH		"100"
#define DEF_SCALE_ORIENT		"vertical"
#define DEF_SCALE_RELIEF		"flat"
#define DEF_SCALE_REPEAT_DELAY	"300"
#define DEF_SCALE_REPEAT_INTERVAL	"100"
#define DEF_SCALE_RESOLUTION		"1"
#define DEF_SCALE_TROUGH_COLOR		TROUGH
#define DEF_SCALE_TROUGH_MONO		WHITE
#define DEF_SCALE_SHOW_VALUE		"1"
#define DEF_SCALE_SLIDER_LENGTH		"30"
#define DEF_SCALE_SLIDER_RELIEF		"raised"







>
|






|







339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
#define DEF_SCALE_COMMAND		""
#define DEF_SCALE_CURSOR		""
#define DEF_SCALE_DIGITS		"0"
#define DEF_SCALE_FONT			"Helvetica -12 bold"
#define DEF_SCALE_FG_COLOR		BLACK
#define DEF_SCALE_FG_MONO		BLACK
#define DEF_SCALE_FROM			"0"
#define DEF_SCALE_HIGHLIGHT_BG_COLOR	DEF_SCALE_BG_COLOR
#define DEF_SCALE_HIGHLIGHT_BG_MONO	DEF_SCALE_BG_MONO
#define DEF_SCALE_HIGHLIGHT		BLACK
#define DEF_SCALE_HIGHLIGHT_WIDTH	"1"
#define DEF_SCALE_LABEL			""
#define DEF_SCALE_LENGTH		"100"
#define DEF_SCALE_ORIENT		"vertical"
#define DEF_SCALE_RELIEF		"flat"
#define DEF_SCALE_REPEAT_DELAY	        "300"
#define DEF_SCALE_REPEAT_INTERVAL	"100"
#define DEF_SCALE_RESOLUTION		"1"
#define DEF_SCALE_TROUGH_COLOR		TROUGH
#define DEF_SCALE_TROUGH_MONO		WHITE
#define DEF_SCALE_SHOW_VALUE		"1"
#define DEF_SCALE_SLIDER_LENGTH		"30"
#define DEF_SCALE_SLIDER_RELIEF		"raised"

Changes to unix/tkUnixDialog.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tkUnixDialog.c --
 *
 *	Contains the Unix implementation of the common dialog boxes:
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixDialog.c 1.5 96/08/28 21:21:01
 *
 */
 
#include "tkPort.h"
#include "tkInt.h"
#include "tkUnixInt.h"











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tkUnixDialog.c --
 *
 *	Contains the Unix implementation of the common dialog boxes:
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixDialog.c,v 1.1.4.2 1998/10/06 03:27:36 stanton Exp $
 *
 */
 
#include "tkPort.h"
#include "tkInt.h"
#include "tkUnixInt.h"

Changes to unix/tkUnixDraw.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15




16
17
18
19
20
21
22
/* 
 * tkUnixDraw.c --
 *
 *	This file contains X specific drawing routines.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixDraw.c 1.9 97/03/21 11:16:18
 */

#include "tkPort.h"
#include "tkInt.h"





/*
 * The following structure is used to pass information to
 * ScrollRestrictProc from TkScrollWindow.
 */

typedef struct ScrollInfo {










|




>
>
>
>







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
/* 
 * tkUnixDraw.c --
 *
 *	This file contains X specific drawing routines.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixDraw.c,v 1.1.4.2 1999/03/10 07:13:51 stanton Exp $
 */

#include "tkPort.h"
#include "tkInt.h"

#if !defined(__WIN32__) && !defined(MAC_TCL)
#include "tkUnixInt.h"
#endif

/*
 * The following structure is used to pass information to
 * ScrollRestrictProc from TkScrollWindow.
 */

typedef struct ScrollInfo {

Changes to unix/tkUnixEmbed.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkUnixEmbed.c --
 *
 *	This file contains platform-specific procedures for UNIX to provide
 *	basic operations needed for application embedding (where one
 *	application can use as its main window an internal window from
 *	some other application).
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixEmbed.c 1.22 97/08/13 11:15:51
 */

#include "tkInt.h"
#include "tkUnixInt.h"

/*
 * One of the following structures exists for each container in this













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkUnixEmbed.c --
 *
 *	This file contains platform-specific procedures for UNIX to provide
 *	basic operations needed for application embedding (where one
 *	application can use as its main window an internal window from
 *	some other application).
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixEmbed.c,v 1.1.4.3 1998/12/13 08:14:38 lfb Exp $
 */

#include "tkInt.h"
#include "tkUnixInt.h"

/*
 * One of the following structures exists for each container in this
42
43
44
45
46
47
48
49
50
51


52
53
54
55
56
57
58
					 * Note that this is *not* the
					 * same window as wrapper: wrapper is
					 * the parent of embeddedPtr. */
    struct Container *nextPtr;		/* Next in list of all containers in
					 * this process. */
} Container;

static Container *firstContainerPtr = NULL;
					/* First in list of all containers
					 * managed by this process.  */



/*
 * Prototypes for static procedures defined in this file:
 */

static void		ContainerEventProc _ANSI_ARGS_((
			    ClientData clientData, XEvent *eventPtr));







|
|

>
>







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
					 * Note that this is *not* the
					 * same window as wrapper: wrapper is
					 * the parent of embeddedPtr. */
    struct Container *nextPtr;		/* Next in list of all containers in
					 * this process. */
} Container;

typedef struct ThreadSpecificData {
    Container *firstContainerPtr;       /* First in list of all containers
					 * managed by this process.  */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Prototypes for static procedures defined in this file:
 */

static void		ContainerEventProc _ANSI_ARGS_((
			    ClientData clientData, XEvent *eventPtr));
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
 *	its parent window, rather than the root window for the screen.
 *	It is invoked by an embedded application to specify the window
 *	in which it is embedded.
 *
 * Results:
 *	The return value is normally TCL_OK.  If an error occurs (such
 *	as string not being a valid window spec), then the return value
 *	is TCL_ERROR and an error message is left in interp->result if
 *	interp is non-NULL.
 *
 * Side effects:
 *	Changes the colormap and other visual information to match that
 *	of the parent window given by "string".
 *
 *----------------------------------------------------------------------







|







81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
 *	its parent window, rather than the root window for the screen.
 *	It is invoked by an embedded application to specify the window
 *	in which it is embedded.
 *
 * Results:
 *	The return value is normally TCL_OK.  If an error occurs (such
 *	as string not being a valid window spec), then the return value
 *	is TCL_ERROR and an error message is left in the interp's result if
 *	interp is non-NULL.
 *
 * Side effects:
 *	Changes the colormap and other visual information to match that
 *	of the parent window given by "string".
 *
 *----------------------------------------------------------------------
104
105
106
107
108
109
110


111
112
113
114
115
116
117
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    int id, anyError;
    Window parent;
    Tk_ErrorHandler handler;
    Container *containerPtr;
    XWindowAttributes parentAtts;



    if (winPtr->window != None) {
	panic("TkUseWindow: X window already assigned");
    }
    if (Tcl_GetInt(interp, string, &id) != TCL_OK) {
	return TCL_ERROR;
    }







>
>







106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    int id, anyError;
    Window parent;
    Tk_ErrorHandler handler;
    Container *containerPtr;
    XWindowAttributes parentAtts;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (winPtr->window != None) {
	panic("TkUseWindow: X window already assigned");
    }
    if (Tcl_GetInt(interp, string, &id) != TCL_OK) {
	return TCL_ERROR;
    }
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
    /*
     * Save information about the container and the embedded window
     * in a Container structure.  If there is already an existing
     * Container structure, it means that both container and embedded
     * app. are in the same process.
     */

    for (containerPtr = firstContainerPtr; containerPtr != NULL;
	    containerPtr = containerPtr->nextPtr) {
	if (containerPtr->parent == parent) {
	    winPtr->flags |= TK_BOTH_HALVES;
	    containerPtr->parentPtr->flags |= TK_BOTH_HALVES;
	    break;
	}
    }
    if (containerPtr == NULL) {
	containerPtr = (Container *) ckalloc(sizeof(Container));
	containerPtr->parent = parent;
	containerPtr->parentRoot = parentAtts.root;
	containerPtr->parentPtr = NULL;
	containerPtr->wrapper = None;
	containerPtr->nextPtr = firstContainerPtr;
	firstContainerPtr = containerPtr;
    }
    containerPtr->embeddedPtr = winPtr;
    winPtr->flags |= TK_EMBEDDED;
    return TCL_OK;
}

/*







|













|
|







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
    /*
     * Save information about the container and the embedded window
     * in a Container structure.  If there is already an existing
     * Container structure, it means that both container and embedded
     * app. are in the same process.
     */

    for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL;
	    containerPtr = containerPtr->nextPtr) {
	if (containerPtr->parent == parent) {
	    winPtr->flags |= TK_BOTH_HALVES;
	    containerPtr->parentPtr->flags |= TK_BOTH_HALVES;
	    break;
	}
    }
    if (containerPtr == NULL) {
	containerPtr = (Container *) ckalloc(sizeof(Container));
	containerPtr->parent = parent;
	containerPtr->parentRoot = parentAtts.root;
	containerPtr->parentPtr = NULL;
	containerPtr->wrapper = None;
	containerPtr->nextPtr = tsdPtr->firstContainerPtr;
	tsdPtr->firstContainerPtr = containerPtr;
    }
    containerPtr->embeddedPtr = winPtr;
    winPtr->flags |= TK_EMBEDDED;
    return TCL_OK;
}

/*
200
201
202
203
204
205
206


207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
TkpMakeWindow(winPtr, parent)
    TkWindow *winPtr;		/* Tk's information about the window that
				 * is to be instantiated. */
    Window parent;		/* Window system token for the parent in
				 * which the window is to be created. */
{
    Container *containerPtr;



    if (winPtr->flags & TK_EMBEDDED) {
	/*
	 * This window is embedded.  Don't create the new window in the
	 * given parent; instead, create it as a child of the root window
	 * of the container's screen.  The window will get reparented
	 * into a wrapper window later.
	 */

	for (containerPtr = firstContainerPtr; ;
		containerPtr = containerPtr->nextPtr) {
	    if (containerPtr == NULL) {
		panic("TkMakeWindow couldn't find container for window");
	    }
	    if (containerPtr->embeddedPtr == winPtr) {
		break;
	    }







>
>









|







204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
TkpMakeWindow(winPtr, parent)
    TkWindow *winPtr;		/* Tk's information about the window that
				 * is to be instantiated. */
    Window parent;		/* Window system token for the parent in
				 * which the window is to be created. */
{
    Container *containerPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (winPtr->flags & TK_EMBEDDED) {
	/*
	 * This window is embedded.  Don't create the new window in the
	 * given parent; instead, create it as a child of the root window
	 * of the container's screen.  The window will get reparented
	 * into a wrapper window later.
	 */

	for (containerPtr = tsdPtr->firstContainerPtr; ;
		containerPtr = containerPtr->nextPtr) {
	    if (containerPtr == NULL) {
		panic("TkMakeWindow couldn't find container for window");
	    }
	    if (containerPtr->embeddedPtr == winPtr) {
		break;
	    }
255
256
257
258
259
260
261


262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
void
TkpMakeContainer(tkwin)
    Tk_Window tkwin;		/* Token for a window that is about to
				 * become a container. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    Container *containerPtr;



    /*
     * Register the window as a container so that, for example, we can
     * find out later if the embedded app. is in the same process.
     */

    Tk_MakeWindowExist(tkwin);
    containerPtr = (Container *) ckalloc(sizeof(Container));
    containerPtr->parent = Tk_WindowId(tkwin);
    containerPtr->parentRoot = RootWindowOfScreen(Tk_Screen(tkwin));
    containerPtr->parentPtr = winPtr;
    containerPtr->wrapper = None;
    containerPtr->embeddedPtr = NULL;
    containerPtr->nextPtr = firstContainerPtr;
    firstContainerPtr = containerPtr;
    winPtr->flags |= TK_CONTAINER;

    /*
     * Request SubstructureNotify events so that we can find out when
     * the embedded application creates its window or attempts to
     * resize it.  Also watch Configure events on the container so that
     * we can resize the child to match.







>
>













|
|







261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
void
TkpMakeContainer(tkwin)
    Tk_Window tkwin;		/* Token for a window that is about to
				 * become a container. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    Container *containerPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Register the window as a container so that, for example, we can
     * find out later if the embedded app. is in the same process.
     */

    Tk_MakeWindowExist(tkwin);
    containerPtr = (Container *) ckalloc(sizeof(Container));
    containerPtr->parent = Tk_WindowId(tkwin);
    containerPtr->parentRoot = RootWindowOfScreen(Tk_Screen(tkwin));
    containerPtr->parentPtr = winPtr;
    containerPtr->wrapper = None;
    containerPtr->embeddedPtr = NULL;
    containerPtr->nextPtr = tsdPtr->firstContainerPtr;
    tsdPtr->firstContainerPtr = containerPtr;
    winPtr->flags |= TK_CONTAINER;

    /*
     * Request SubstructureNotify events so that we can find out when
     * the embedded application creates its window or attempts to
     * resize it.  Also watch Configure events on the container so that
     * we can resize the child to match.
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
ContainerEventProc(clientData, eventPtr)
    ClientData clientData;		/* Token for container window. */
    XEvent *eventPtr;			/* ResizeRequest event. */
{
    TkWindow *winPtr = (TkWindow *) clientData;
    Container *containerPtr;
    Tk_ErrorHandler errHandler;



    /*
     * Ignore any X protocol errors that happen in this procedure
     * (almost any operation could fail, for example, if the embedded
     * application has deleted its window).
     */

    errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1,
	    -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL);

    /*
     * Find the Container structure associated with the parent window.
     */

    for (containerPtr = firstContainerPtr;
	    containerPtr->parent != eventPtr->xmaprequest.parent;
	    containerPtr = containerPtr->nextPtr) {
	if (containerPtr == NULL) {
	    panic("ContainerEventProc couldn't find Container record");
	}
    }








>
>














|







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
ContainerEventProc(clientData, eventPtr)
    ClientData clientData;		/* Token for container window. */
    XEvent *eventPtr;			/* ResizeRequest event. */
{
    TkWindow *winPtr = (TkWindow *) clientData;
    Container *containerPtr;
    Tk_ErrorHandler errHandler;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Ignore any X protocol errors that happen in this procedure
     * (almost any operation could fail, for example, if the embedded
     * application has deleted its window).
     */

    errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1,
	    -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL);

    /*
     * Find the Container structure associated with the parent window.
     */

    for (containerPtr = tsdPtr->firstContainerPtr;
	    containerPtr->parent != eventPtr->xmaprequest.parent;
	    containerPtr = containerPtr->nextPtr) {
	if (containerPtr == NULL) {
	    panic("ContainerEventProc couldn't find Container record");
	}
    }

693
694
695
696
697
698
699


700

701
702
703
704
705
706
707
708

TkWindow *
TkpGetOtherWindow(winPtr)
    TkWindow *winPtr;		/* Tk's structure for a container or
				 * embedded window. */
{
    Container *containerPtr;




    for (containerPtr = firstContainerPtr; containerPtr != NULL;
	    containerPtr = containerPtr->nextPtr) {
	if (containerPtr->embeddedPtr == winPtr) {
	    return containerPtr->parentPtr;
	} else if (containerPtr->parentPtr == winPtr) {
	    return containerPtr->embeddedPtr;
	}
    }







>
>

>
|







703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721

TkWindow *
TkpGetOtherWindow(winPtr)
    TkWindow *winPtr;		/* Tk's structure for a container or
				 * embedded window. */
{
    Container *containerPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    for (containerPtr = tsdPtr->firstContainerPtr; 
            containerPtr != NULL;
	    containerPtr = containerPtr->nextPtr) {
	if (containerPtr->embeddedPtr == winPtr) {
	    return containerPtr->parentPtr;
	} else if (containerPtr->parentPtr == winPtr) {
	    return containerPtr->embeddedPtr;
	}
    }
737
738
739
740
741
742
743


744
745
746
747
748
749
750
    TkWindow *winPtr;		/* Window to which the event was originally
				 * reported. */
    XEvent *eventPtr;		/* X event to redirect (should be KeyPress
				 * or KeyRelease). */
{
    Container *containerPtr;
    Window saved;



    /*
     * First, find the top-level window corresponding to winPtr.
     */

    while (1) {
	if (winPtr == NULL) {







>
>







750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
    TkWindow *winPtr;		/* Window to which the event was originally
				 * reported. */
    XEvent *eventPtr;		/* X event to redirect (should be KeyPress
				 * or KeyRelease). */
{
    Container *containerPtr;
    Window saved;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * First, find the top-level window corresponding to winPtr.
     */

    while (1) {
	if (winPtr == NULL) {
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
	/*
	 * This application is embedded.  If we got a key event without
	 * officially having the focus, it means that the focus is
	 * really in the container, but the mouse was over the embedded
	 * application.  Send the event back to the container.
	 */

	for (containerPtr = firstContainerPtr;
		containerPtr->embeddedPtr != winPtr;
		containerPtr = containerPtr->nextPtr) {
	    /* Empty loop body. */
	}
	saved = eventPtr->xkey.window;
	eventPtr->xkey.window = containerPtr->parent;
	XSendEvent(eventPtr->xkey.display, eventPtr->xkey.window, False,







|







780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
	/*
	 * This application is embedded.  If we got a key event without
	 * officially having the focus, it means that the focus is
	 * really in the container, but the mouse was over the embedded
	 * application.  Send the event back to the container.
	 */

	for (containerPtr = tsdPtr->firstContainerPtr;
		containerPtr->embeddedPtr != winPtr;
		containerPtr = containerPtr->nextPtr) {
	    /* Empty loop body. */
	}
	saved = eventPtr->xkey.window;
	eventPtr->xkey.window = containerPtr->parent;
	XSendEvent(eventPtr->xkey.display, eventPtr->xkey.window, False,
807
808
809
810
811
812
813


814
815
816
817
818
819
820
821
822
823
824
825
826
					 * focus window; should be embedded. */
    int force;				/* One means that the container should
					 * claim the focus if it doesn't
					 * currently have it. */
{
    XEvent event;
    Container *containerPtr;



    if (!(topLevelPtr->flags & TK_EMBEDDED)) {
	return;
    }

    for (containerPtr = firstContainerPtr;
	    containerPtr->embeddedPtr != topLevelPtr;
	    containerPtr = containerPtr->nextPtr) {
	/* Empty loop body. */
    }

    event.xfocus.type = FocusIn;
    event.xfocus.serial = LastKnownRequestProcessed(topLevelPtr->display);







>
>





|







822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
					 * focus window; should be embedded. */
    int force;				/* One means that the container should
					 * claim the focus if it doesn't
					 * currently have it. */
{
    XEvent event;
    Container *containerPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (!(topLevelPtr->flags & TK_EMBEDDED)) {
	return;
    }

    for (containerPtr = tsdPtr->firstContainerPtr;
	    containerPtr->embeddedPtr != topLevelPtr;
	    containerPtr = containerPtr->nextPtr) {
	/* Empty loop body. */
    }

    event.xfocus.type = FocusIn;
    event.xfocus.serial = LastKnownRequestProcessed(topLevelPtr->display);
857
858
859
860
861
862
863


864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    int all;
    Container *containerPtr;
    Tcl_DString dString;
    char buffer[50];



    if ((argc > 1) && (strcmp(argv[1], "all") == 0)) {
	all = 1;
    } else {
	all = 0;
    }
    Tcl_DStringInit(&dString);
    for (containerPtr = firstContainerPtr; containerPtr != NULL;
	    containerPtr = containerPtr->nextPtr) {
	Tcl_DStringStartSublist(&dString);
	if (containerPtr->parent == None) {
	    Tcl_DStringAppendElement(&dString, "");
	} else {
	    if (all) {
		sprintf(buffer, "0x%x", (int) containerPtr->parent);







>
>







|







874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    int all;
    Container *containerPtr;
    Tcl_DString dString;
    char buffer[50];
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if ((argc > 1) && (strcmp(argv[1], "all") == 0)) {
	all = 1;
    } else {
	all = 0;
    }
    Tcl_DStringInit(&dString);
    for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL;
	    containerPtr = containerPtr->nextPtr) {
	Tcl_DStringStartSublist(&dString);
	if (containerPtr->parent == None) {
	    Tcl_DStringAppendElement(&dString, "");
	} else {
	    if (all) {
		sprintf(buffer, "0x%x", (int) containerPtr->parent);
929
930
931
932
933
934
935


936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968

static void
EmbedWindowDeleted(winPtr)
    TkWindow *winPtr;		/* Tk's information about window that
				 * was deleted. */
{
    Container *containerPtr, *prevPtr;



    /*
     * Find the Container structure for this window work.  Delete the
     * information about the embedded application and free the container's
     * record.
     */

    prevPtr = NULL;
    containerPtr = firstContainerPtr;
    while (1) {
	if (containerPtr->embeddedPtr == winPtr) {
	    containerPtr->wrapper = None;
	    containerPtr->embeddedPtr = NULL;
	    break;
	}
	if (containerPtr->parentPtr == winPtr) {
	    containerPtr->parentPtr = NULL;
	    break;
	}
	prevPtr = containerPtr;
	containerPtr = containerPtr->nextPtr;
    }
    if ((containerPtr->embeddedPtr == NULL)
	    && (containerPtr->parentPtr == NULL)) {
	if (prevPtr == NULL) {
	    firstContainerPtr = containerPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = containerPtr->nextPtr;
	}
	ckfree((char *) containerPtr);
    }
}








>
>








|
















|







948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989

static void
EmbedWindowDeleted(winPtr)
    TkWindow *winPtr;		/* Tk's information about window that
				 * was deleted. */
{
    Container *containerPtr, *prevPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Find the Container structure for this window work.  Delete the
     * information about the embedded application and free the container's
     * record.
     */

    prevPtr = NULL;
    containerPtr = tsdPtr->firstContainerPtr;
    while (1) {
	if (containerPtr->embeddedPtr == winPtr) {
	    containerPtr->wrapper = None;
	    containerPtr->embeddedPtr = NULL;
	    break;
	}
	if (containerPtr->parentPtr == winPtr) {
	    containerPtr->parentPtr = NULL;
	    break;
	}
	prevPtr = containerPtr;
	containerPtr = containerPtr->nextPtr;
    }
    if ((containerPtr->embeddedPtr == NULL)
	    && (containerPtr->parentPtr == NULL)) {
	if (prevPtr == NULL) {
	    tsdPtr->firstContainerPtr = containerPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = containerPtr->nextPtr;
	}
	ckfree((char *) containerPtr);
    }
}

985
986
987
988
989
990
991


992
993
994
995
996
997
998
999
1000
1001
 */

Window
TkUnixContainerId(winPtr)
    TkWindow *winPtr;		/* Tk's structure for an embedded window. */
{
    Container *containerPtr;



    for (containerPtr = firstContainerPtr; containerPtr != NULL;
	    containerPtr = containerPtr->nextPtr) {
	if (containerPtr->embeddedPtr == winPtr) {
	    return containerPtr->parent;
	}
    }
    panic("TkUnixContainerId couldn't find window");
    return None;
}







>
>

|
|







1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
 */

Window
TkUnixContainerId(winPtr)
    TkWindow *winPtr;		/* Tk's structure for an embedded window. */
{
    Container *containerPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    for (containerPtr = tsdPtr->firstContainerPtr; 
            containerPtr != NULL; containerPtr = containerPtr->nextPtr) {
	if (containerPtr->embeddedPtr == winPtr) {
	    return containerPtr->parent;
	}
    }
    panic("TkUnixContainerId couldn't find window");
    return None;
}

Changes to unix/tkUnixEvent.c.

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
/* 
 * tkUnixEvent.c --
 *
 *	This file implements an event source for X displays for the
 *	UNIX version of Tk.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixEvent.c 1.17 97/09/11 12:51:04
 */

#include "tkInt.h"
#include "tkUnixInt.h"
#include <signal.h>

/*
 * The following static indicates whether this module has been initialized.

 */


static int initialized = 0;



/*
 * Prototypes for procedures that are referenced only in this file:
 */

static void		DisplayCheckProc _ANSI_ARGS_((ClientData clientData,
			    int flags));
static void		DisplayExitHandler _ANSI_ARGS_((
			    ClientData clientData));
static void		DisplayFileProc _ANSI_ARGS_((ClientData clientData,
			    int flags));
static void		DisplaySetupProc _ANSI_ARGS_((ClientData clientData,
			    int flags));



/*
 *----------------------------------------------------------------------
 *
 * TkCreateXEventSource --
 *
 *	This procedure is called during Tk initialization to create











|







|
>


>
|
>
>













>
>







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
/* 
 * tkUnixEvent.c --
 *
 *	This file implements an event source for X displays for the
 *	UNIX version of Tk.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixEvent.c,v 1.1.4.3 1998/12/13 08:14:38 lfb Exp $
 */

#include "tkInt.h"
#include "tkUnixInt.h"
#include <signal.h>

/*
 * The following static indicates whether this module has been initialized
 * in the current thread.
 */

typedef struct ThreadSpecificData {
    int initialized;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Prototypes for procedures that are referenced only in this file:
 */

static void		DisplayCheckProc _ANSI_ARGS_((ClientData clientData,
			    int flags));
static void		DisplayExitHandler _ANSI_ARGS_((
			    ClientData clientData));
static void		DisplayFileProc _ANSI_ARGS_((ClientData clientData,
			    int flags));
static void		DisplaySetupProc _ANSI_ARGS_((ClientData clientData,
			    int flags));
static void		TransferXEventsToTcl _ANSI_ARGS_((Display *display));


/*
 *----------------------------------------------------------------------
 *
 * TkCreateXEventSource --
 *
 *	This procedure is called during Tk initialization to create
51
52
53
54
55
56
57



58
59
60
61
62
63
64
65
66
 *
 *----------------------------------------------------------------------
 */

void
TkCreateXEventSource()
{



    if (!initialized) {
	initialized = 1;
	Tcl_CreateEventSource(DisplaySetupProc, DisplayCheckProc, NULL);
	Tcl_CreateExitHandler(DisplayExitHandler, NULL);
    }
}

/*
 *----------------------------------------------------------------------







>
>
>
|
|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
 *
 *----------------------------------------------------------------------
 */

void
TkCreateXEventSource()
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (!tsdPtr->initialized) {
	tsdPtr->initialized = 1;
	Tcl_CreateEventSource(DisplaySetupProc, DisplayCheckProc, NULL);
	Tcl_CreateExitHandler(DisplayExitHandler, NULL);
    }
}

/*
 *----------------------------------------------------------------------
79
80
81
82
83
84
85



86
87
88
89
90
91
92
93
94
 *----------------------------------------------------------------------
 */

static void
DisplayExitHandler(clientData)
    ClientData clientData;	/* Not used. */
{



    Tcl_DeleteEventSource(DisplaySetupProc, DisplayCheckProc, NULL);
    initialized = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TkpOpenDisplay --
 *







>
>
>

|







88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
 *----------------------------------------------------------------------
 */

static void
DisplayExitHandler(clientData)
    ClientData clientData;	/* Not used. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    Tcl_DeleteEventSource(DisplaySetupProc, DisplayCheckProc, NULL);
    tsdPtr->initialized = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TkpOpenDisplay --
 *
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
    TkDisplay *dispPtr;
    static Tcl_Time blockTime = { 0, 0 };

    if (!(flags & TCL_WINDOW_EVENTS)) {
	return;
    }

    for (dispPtr = tkDisplayList; dispPtr != NULL;
	 dispPtr = dispPtr->nextPtr) {

	/*
	 * Flush the display. If data is pending on the X queue, set
	 * the block time to zero.  This ensures that we won't block
	 * in the notifier if there is data in the X queue, but not on
	 * the server socket.
	 */

	XFlush(dispPtr->display);
	if (XQLength(dispPtr->display) > 0) {
	    Tcl_SetMaxBlockTime(&blockTime);
	}
    }
}






































/*
 *----------------------------------------------------------------------
 *
 * DisplayCheckProc --
 *
 *	This procedure checks for events sitting in the X event







|










|




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







193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
    TkDisplay *dispPtr;
    static Tcl_Time blockTime = { 0, 0 };

    if (!(flags & TCL_WINDOW_EVENTS)) {
	return;
    }

    for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
	 dispPtr = dispPtr->nextPtr) {

	/*
	 * Flush the display. If data is pending on the X queue, set
	 * the block time to zero.  This ensures that we won't block
	 * in the notifier if there is data in the X queue, but not on
	 * the server socket.
	 */

	XFlush(dispPtr->display);
	if (QLength(dispPtr->display) > 0) {
	    Tcl_SetMaxBlockTime(&blockTime);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 *  TransferXEventsToTcl
 *
 *      Transfer events from the X event queue to the Tk event queue.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Moves queued X events onto the Tcl event queue.
 *
 *----------------------------------------------------------------------
 */


static void
TransferXEventsToTcl(display)
    Display *display;
{
    int numFound;
    XEvent event;

    numFound = QLength(display);

    /*
     * Transfer events from the X event queue to the Tk event queue.
     */

    while (numFound > 0) {
	XNextEvent(display, &event);
	Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
	numFound--;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DisplayCheckProc --
 *
 *	This procedure checks for events sitting in the X event
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257

static void
DisplayCheckProc(clientData, flags)
    ClientData clientData;	/* Not used. */
    int flags;
{
    TkDisplay *dispPtr;
    XEvent event;
    int numFound;

    if (!(flags & TCL_WINDOW_EVENTS)) {
	return;
    }

    for (dispPtr = tkDisplayList; dispPtr != NULL;
	 dispPtr = dispPtr->nextPtr) {
	XFlush(dispPtr->display);
	numFound = XQLength(dispPtr->display);

	/*
	 * Transfer events from the X event queue to the Tk event queue.
	 */

	while (numFound > 0) {
	    XNextEvent(dispPtr->display, &event);
	    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
	    numFound--;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DisplayFileProc --
 *
 *	This procedure implements the file handler for the X connection.







<
<





|


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







270
271
272
273
274
275
276


277
278
279
280
281
282
283
284
285
286



287




288
289

290
291
292
293
294
295
296

static void
DisplayCheckProc(clientData, flags)
    ClientData clientData;	/* Not used. */
    int flags;
{
    TkDisplay *dispPtr;



    if (!(flags & TCL_WINDOW_EVENTS)) {
	return;
    }

    for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
	 dispPtr = dispPtr->nextPtr) {
	XFlush(dispPtr->display);
	TransferXEventsToTcl(dispPtr->display);
    }



}








/*
 *----------------------------------------------------------------------
 *
 * DisplayFileProc --
 *
 *	This procedure implements the file handler for the X connection.
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
static void
DisplayFileProc(clientData, flags)
    ClientData clientData;		/* The display pointer. */
    int flags;				/* Should be TCL_READABLE. */
{
    TkDisplay *dispPtr = (TkDisplay *) clientData;
    Display *display = dispPtr->display;
    XEvent event;
    int numFound;

    XFlush(display);
    numFound = XEventsQueued(display, QueuedAfterReading);
    if (numFound == 0) {
	
	/*







<







308
309
310
311
312
313
314

315
316
317
318
319
320
321
static void
DisplayFileProc(clientData, flags)
    ClientData clientData;		/* The display pointer. */
    int flags;				/* Should be TCL_READABLE. */
{
    TkDisplay *dispPtr = (TkDisplay *) clientData;
    Display *display = dispPtr->display;

    int numFound;

    XFlush(display);
    numFound = XEventsQueued(display, QueuedAfterReading);
    if (numFound == 0) {
	
	/*
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
	
	oldHandler = (void (*)()) signal(SIGPIPE, SIG_IGN);
	XNoOp(display);
	XFlush(display);
	(void) signal(SIGPIPE, oldHandler);
    }
    
    /*
     * Transfer events from the X event queue to the Tk event queue.
     */

    while (numFound > 0) {
	XNextEvent(display, &event);
	Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
	numFound--;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkUnixDoOneXEvent --
 *







<
<
<
|
<
<
<
<
<







345
346
347
348
349
350
351



352





353
354
355
356
357
358
359
	
	oldHandler = (void (*)()) signal(SIGPIPE, SIG_IGN);
	XNoOp(display);
	XFlush(display);
	(void) signal(SIGPIPE, oldHandler);
    }
    



    TransferXEventsToTcl(display);





}

/*
 *----------------------------------------------------------------------
 *
 * TkUnixDoOneXEvent --
 *
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407

    /*
     * Set up the select mask for all of the displays.  If a display has
     * data pending, then we want to poll instead of blocking.
     */

    memset((VOID *) readMask, 0, MASK_SIZE*sizeof(fd_mask));
    for (dispPtr = tkDisplayList; dispPtr != NULL;
	 dispPtr = dispPtr->nextPtr) {
	XFlush(dispPtr->display);
	if (XQLength(dispPtr->display) > 0) {
	    blockTime.tv_sec = 0;
	    blockTime.tv_usec = 0;
	}
	fd = ConnectionNumber(dispPtr->display);
	index = fd/(NBBY*sizeof(fd_mask));
	bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
	readMask[index] |= bit;







|


|







420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437

    /*
     * Set up the select mask for all of the displays.  If a display has
     * data pending, then we want to poll instead of blocking.
     */

    memset((VOID *) readMask, 0, MASK_SIZE*sizeof(fd_mask));
    for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
	 dispPtr = dispPtr->nextPtr) {
	XFlush(dispPtr->display);
	if (QLength(dispPtr->display) > 0) {
	    blockTime.tv_sec = 0;
	    blockTime.tv_usec = 0;
	}
	fd = ConnectionNumber(dispPtr->display);
	index = fd/(NBBY*sizeof(fd_mask));
	bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
	readMask[index] |= bit;
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
	memset((VOID *) readMask, 0, MASK_SIZE*sizeof(fd_mask));
    }

    /*
     * Process any new events on the display connections.
     */

    for (dispPtr = tkDisplayList; dispPtr != NULL;
	 dispPtr = dispPtr->nextPtr) {
	fd = ConnectionNumber(dispPtr->display);
	index = fd/(NBBY*sizeof(fd_mask));
	bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
	if ((readMask[index] & bit) || (XQLength(dispPtr->display) > 0)) {
	    DisplayFileProc((ClientData)dispPtr, TCL_READABLE);
	}
    }
    if (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {
	return 1;
    }








|




|







451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
	memset((VOID *) readMask, 0, MASK_SIZE*sizeof(fd_mask));
    }

    /*
     * Process any new events on the display connections.
     */

    for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
	 dispPtr = dispPtr->nextPtr) {
	fd = ConnectionNumber(dispPtr->display);
	index = fd/(NBBY*sizeof(fd_mask));
	bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
	if ((readMask[index] & bit) || (QLength(dispPtr->display) > 0)) {
	    DisplayFileProc((ClientData)dispPtr, TCL_READABLE);
	}
    }
    if (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {
	return 1;
    }

476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
 *----------------------------------------------------------------------
 */

void
TkpSync(display)
    Display *display;		/* Display to sync. */
{
    int numFound = 0;
    XEvent event;

    XSync(display, False);

    /*
     * Transfer events from the X event queue to the Tk event queue.
     */

    numFound = XQLength(display);
    while (numFound > 0) {
	XNextEvent(display, &event);
	Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
	numFound--;
    }
}







<
<
<





<
|
<
<
<
<
|

506
507
508
509
510
511
512



513
514
515
516
517

518




519
520
 *----------------------------------------------------------------------
 */

void
TkpSync(display)
    Display *display;		/* Display to sync. */
{



    XSync(display, False);

    /*
     * Transfer events from the X event queue to the Tk event queue.
     */

    TransferXEventsToTcl(display);





}

Changes to unix/tkUnixFocus.c.

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
/* 
 * tkUnixFocus.c --
 *
 *	This file contains platform specific procedures that manage
 *	focus for Tk.
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixFocus.c 1.9 97/10/31 09:54:04
 */

#include "tkInt.h"
#include "tkPort.h"
#include "tkUnixInt.h"

extern int tclFocusDebug;

/*
 *----------------------------------------------------------------------
 *
 * TkpChangeFocus --
 *
 *	This procedure is invoked to move the official X focus from











|






<







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
/* 
 * tkUnixFocus.c --
 *
 *	This file contains platform specific procedures that manage
 *	focus for Tk.
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixFocus.c,v 1.1.4.2 1998/12/13 08:14:39 lfb Exp $
 */

#include "tkInt.h"
#include "tkPort.h"
#include "tkUnixInt.h"



/*
 *----------------------------------------------------------------------
 *
 * TkpChangeFocus --
 *
 *	This procedure is invoked to move the official X focus from

Changes to unix/tkUnixFont.c.

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
/*
 * tkUnixFont.c --
 *
 *	Contains the Unix implementation of the platform-independant
 *	font package interface.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixFont.c 1.16 97/10/23 12:47:53
 */
 
#include "tkPort.h"
#include "tkInt.h"
#include "tkUnixInt.h"







#include "tkFont.h"











#ifndef ABS

#define ABS(n)	(((n) < 0) ? -(n) : (n))


#endif
















































/*
 * The following structure represents Unix's implementation of a font.

 */
 



typedef struct UnixFont {
    TkFont font;		/* Stuff used by generic font package.  Must
				 * be first in structure. */


    Display *display;		/* The display to which font belongs. */











    XFontStruct *fontStructPtr;	/* X information about font. */
    char types[256];		/* Array giving types of all characters in
				 * the font, used when displaying control
				 * characters.  See below for definition. */



    int widths[256];		/* Array giving widths of all possible
				 * characters in the font. */
    int underlinePos;		/* Offset from baseline to origin of
				 * underline bar (used for simulating a native
				 * underlined font). */
    int barHeight;		/* Height of underline or overstrike bar
				 * (used for simulating a native underlined or
				 * strikeout font). */
} UnixFont;

/*
 * Possible values for entries in the "types" field in a UnixFont structure,
 * which classifies the types of all characters in the given font.  This
 * information is used when measuring and displaying characters.

 *
 * NORMAL:		Standard character.
 * REPLACE:		This character doesn't print:  instead of
 *			displaying character, display a replacement
 *			sequence like "\n" (for those characters where
 *			ANSI C defines such a sequence) or a sequence
 *			of the form "\xdd" where dd is the hex equivalent
 *			of the character.


 * SKIP:		Don't display anything for this character.  This
 *			is only used where the font doesn't contain
 *			all the characters needed to generate


 *			replacement sequences.
 */ 












#define NORMAL		0
#define REPLACE		1
#define SKIP		2

/*
 * Characters used when displaying control sequences.
 */

static char hexChars[] = "0123456789abcdefxtnvr\\";

/*
 * The following table maps some control characters to sequences like '\n'
 * rather than '\x10'.  A zero entry in the table means no such mapping
 * exists, and the table only maps characters less than 0x10.


 */

static char mapChars[] = {



    0, 0, 0, 0, 0, 0, 0,
    'a', 'b', 't', 'n', 'v', 'f', 'r',
    0








};






































static UnixFont *	AllocFont _ANSI_ARGS_((TkFont *tkFontPtr,


			    Tk_Window tkwin, XFontStruct *fontStructPtr,


			    CONST char *fontName));





static void		DrawChars _ANSI_ARGS_((Display *display,



			    Drawable drawable, GC gc, UnixFont *fontPtr,
			    CONST char *source, int numChars, int x,


























			    int y));
static int		GetControlCharSubst _ANSI_ARGS_((int c, char buf[4]));


















































































































/*
 *---------------------------------------------------------------------------
 *
 * TkpGetNativeFont --
 *
 *	Map a platform-specific native font name to a TkFont.






|




|


|
|
|
>
>
>

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


|
>


>
>
>



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

|
|

|
|



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


<
<
<
>
>

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


>
>
>

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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139

140


141
142
143
144
145
146

147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166

167

168
169
170
171



172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
/*
 * tkUnixFont.c --
 *
 *	Contains the Unix implementation of the platform-independant
 *	font package interface.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixFont.c,v 1.1.4.7 1999/03/30 04:12:59 stanton Exp $
 */
 
#include "tkUnixInt.h"
#include "tkFont.h"

/*
 * The preferred font encodings.
 */

static CONST char *encodingList[] = {
    "iso8859-1", "jis0208", "jis0212", NULL
};

/*
 * The following structure represents a font family.  It is assumed that
 * all screen fonts constructed from the same "font family" share certain
 * properties; all screen fonts with the same "font family" point to a
 * shared instance of this structure.  The most important shared property
 * is the character existence metrics, used to determine if a screen font
 * can display a given Unicode character.
 *
 * Under Unix, there are three attributes that uniquely identify a "font
 * family": the foundry, face name, and charset.  
 */

#define FONTMAP_SHIFT		10

#define FONTMAP_PAGES	    	(1 << (sizeof(Tcl_UniChar)*8 - FONTMAP_SHIFT))
#define FONTMAP_BITSPERPAGE	(1 << FONTMAP_SHIFT)

typedef struct FontFamily {
    struct FontFamily *nextPtr;	/* Next in list of all known font families. */
    int refCount;		/* How many SubFonts are referring to this
				 * FontFamily.  When the refCount drops to
				 * zero, this FontFamily may be freed. */
    /*
     * Key.
     */

    Tk_Uid foundry;		/* Foundry key for this FontFamily. */
    Tk_Uid faceName;		/* Face name key for this FontFamily. */
    Tcl_Encoding encoding;	/* Encoding key for this FontFamily. */

    /*
     * Derived properties.
     */

    int isTwoByteFont;		/* 1 if this is a double-byte font, 0 
				 * otherwise. */
    char *fontMap[FONTMAP_PAGES];
				/* Two-level sparse table used to determine
				 * quickly if the specified character exists.
				 * As characters are encountered, more pages
				 * in this table are dynamically alloced.  The
				 * contents of each page is a bitmask
				 * consisting of FONTMAP_BITSPERPAGE bits,
				 * representing whether this font can be used
				 * to display the given character at the
				 * corresponding bit position.  The high bits
				 * of the character are used to pick which
				 * page of the table is used. */
} FontFamily;

/*
 * The following structure encapsulates an individual screen font.  A font
 * object is made up of however many SubFonts are necessary to display a
 * stream of multilingual characters.
 */

typedef struct SubFont {
    char **fontMap;		/* Pointer to font map from the FontFamily, 
				 * cached here to save a dereference. */
    XFontStruct *fontStructPtr;	/* The specific screen font that will be
				 * used when displaying/measuring chars
				 * belonging to the FontFamily. */
    FontFamily *familyPtr;	/* The FontFamily for this SubFont. */
} SubFont;

/*
 * The following structure represents Unix's implementation of a font
 * object.
 */
 
#define SUBFONT_SPACE		3
#define BASE_CHARS		256

typedef struct UnixFont {
    TkFont font;		/* Stuff used by generic font package.  Must
				 * be first in structure. */
    SubFont staticSubFonts[SUBFONT_SPACE];
				/* Builtin space for a limited number of
				 * SubFonts. */
    int numSubFonts;		/* Length of following array. */
    SubFont *subFontArray;	/* Array of SubFonts that have been loaded
				 * in order to draw/measure all the characters
				 * encountered by this font so far.  All fonts
				 * start off with one SubFont initialized by
				 * AllocFont() from the original set of font
				 * attributes.  Usually points to
				 * staticSubFonts, but may point to malloced
				 * space if there are lots of SubFonts. */
    SubFont controlSubFont;	/* Font to use to display control-character
				 * expansions. */

    Display *display;		/* Display that owns font. */
    int pixelSize;		/* Original pixel size used when font was
				 * constructed. */
    TkXLFDAttributes xa;	/* Additional attributes that specify the
				 * preferred foundry and encoding to use when
				 * constructing additional SubFonts. */
    int widths[BASE_CHARS];	/* Widths of first 256 chars in the base
				 * font, for handling common case. */
    int underlinePos;		/* Offset from baseline to origin of
				 * underline bar (used when drawing underlined
				 * font) (pixels). */
    int barHeight;		/* Height of underline or overstrike bar
				 * (used when drawing underlined or strikeout
				 * font) (pixels). */
} UnixFont;

/*
 * The following structure and definition is used to keep track of the
 * alternative names for various encodings.  Asking for an encoding that
 * matches one of the alias patterns will result in actually getting the
 * encoding by its real name.
 */
 

typedef struct EncodingAlias {


    char *realName;		/* The real name of the encoding to load if
				 * the provided name matched the pattern. */
    char *aliasPattern;		/* Pattern for encoding name, of the form
				 * that is acceptable to Tcl_StringMatch. */
} EncodingAlias;


/*
 * Just some utility structures used for passing around values in helper
 * procedures.
 */
 
typedef struct FontAttributes {
    TkFontAttributes fa;
    TkXLFDAttributes xa;
} FontAttributes;


typedef struct ThreadSpecificData {
    FontFamily *fontFamilyList; /* The list of font families that are 
				 * currently loaded.  As screen fonts
				 * are loaded, this list grows to hold 
				 * information about what characters
				 * exist in each font family. */
    FontFamily controlFamily;   /* FontFamily used to handle control 
				 * character expansions.  The encoding
				 * of this FontFamily converts UTF-8 to 

				 * backslashed escape sequences. */

} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*



 * The set of builtin encoding alises to convert the XLFD names for the
 * encodings into the names expected by the Tcl encoding package.
 */
 
static EncodingAlias encodingAliases[] = {
    {"gb2312",		"gb2312*"},
    {"big5",		"big5*"},
    {"cns11643-1",	"cns11643*-1"},
    {"cns11643-1",	"cns11643*.1-0"},
    {"cns11643-2",	"cns11643*-2"},
    {"cns11643-2",	"cns11643*.2-0"},
    {"jis0201",		"jisx0202*"},
    {"jis0208",		"jisc6226*"},
    {"jis0208",		"jisx0208*"},
    {"jis0212",		"jisx0212*"},
    {"tis620",		"tis620*"},
    {"ksc5601",		"ksc5601*"},
    {"dingbats",	"*dingbats"},
    {NULL,		NULL}
};

/*
 * Procedures used only in this file.
 */

static FontFamily *	AllocFontFamily _ANSI_ARGS_((Display *display,
			    XFontStruct *fontStructPtr, int base));
static SubFont *	CanUseFallback _ANSI_ARGS_((UnixFont *fontPtr,
			    char *fallbackName, int ch));
static SubFont *	CanUseFallbackWithAliases _ANSI_ARGS_((
			    UnixFont *fontPtr, char *fallbackName,
			    int ch, Tcl_DString *nameTriedPtr));
static int		ControlUtfProc _ANSI_ARGS_((ClientData clientData,
			    CONST char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst,
			    int dstLen, int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr));
static XFontStruct *	CreateClosestFont _ANSI_ARGS_((Tk_Window tkwin,
			    CONST TkFontAttributes *faPtr,
			    CONST TkXLFDAttributes *xaPtr));
static SubFont *	FindSubFontForChar _ANSI_ARGS_((UnixFont *fontPtr,
			    int ch));
static void		FontMapInsert _ANSI_ARGS_((SubFont *subFontPtr,
			    int ch));
static void		FontMapLoadPage _ANSI_ARGS_((SubFont *subFontPtr,
			    int row));
static int		FontMapLookup _ANSI_ARGS_((SubFont *subFontPtr,
			    int ch));
static void		FreeFontFamily _ANSI_ARGS_((FontFamily *afPtr));
static CONST char *	GetEncodingAlias _ANSI_ARGS_((CONST char *name));
static int		GetFontAttributes _ANSI_ARGS_((Display *display,
			    XFontStruct *fontStructPtr, FontAttributes *faPtr));
static XFontStruct *	GetScreenFont _ANSI_ARGS_((Display *display,
			    FontAttributes *wantPtr, char **nameList,
			    int bestIdx[], unsigned int bestScore[]));
static XFontStruct *	GetSystemFont _ANSI_ARGS_((Display *display));
static int		IdentifySymbolEncodings _ANSI_ARGS_((
			    FontAttributes *faPtr));
static void		InitFont _ANSI_ARGS_((Tk_Window tkwin,
			    XFontStruct *fontStructPtr, UnixFont *fontPtr));
static void		InitSubFont _ANSI_ARGS_((Display *display,
			    XFontStruct *fontStructPtr, int base,
			    SubFont *subFontPtr));
static char **		ListFonts _ANSI_ARGS_((Display *display,
			    CONST char *faceName, int *numNamesPtr));
static char **		ListFontOrAlias _ANSI_ARGS_((Display *display,
			    CONST char *faceName, int *numNamesPtr));
static unsigned int	RankAttributes _ANSI_ARGS_((FontAttributes *wantPtr,
			    FontAttributes *gotPtr));
static void		ReleaseFont _ANSI_ARGS_((UnixFont *fontPtr));
static void		ReleaseSubFont _ANSI_ARGS_((Display *display, 
			    SubFont *subFontPtr));
static int		SeenName _ANSI_ARGS_((CONST char *name,
			    Tcl_DString *dsPtr));


/*
 *-------------------------------------------------------------------------
 *
 * TkpFontPkgInit --
 *
 *	This procedure is called when an application is created.  It
 *	initializes all the structures that are used by the
 *	platform-dependent code on a per application basis.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

void
TkpFontPkgInit(mainPtr)
    TkMainInfo *mainPtr;	/* The application being created. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    Tcl_EncodingType type;
    SubFont dummy;
    int i;
    
    if (tsdPtr->controlFamily.encoding == NULL) {
	type.encodingName = "X11ControlChars";
	type.toUtfProc = ControlUtfProc;
	type.fromUtfProc = ControlUtfProc;
	type.freeProc = NULL;
	type.clientData = NULL;
	type.nullSize = 0;
	
	tsdPtr->controlFamily.refCount = 2;
	tsdPtr->controlFamily.encoding = Tcl_CreateEncoding(&type);
	tsdPtr->controlFamily.isTwoByteFont = 0;

	dummy.familyPtr = &tsdPtr->controlFamily;
	dummy.fontMap = tsdPtr->controlFamily.fontMap;
	for (i = 0x00; i < 0x20; i++) {
	    FontMapInsert(&dummy, i);
	    FontMapInsert(&dummy, i + 0x80);
	}
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * ControlUtfProc --
 *
 *	Convert from UTF-8 into the ASCII expansion of a control
 *	character.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int 
ControlUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
	srcReadPtr, dstWrotePtr, dstCharsPtr)
    ClientData clientData;	/* Not used. */
    CONST char *src;		/* Source string in UTF-8. */
    int srcLen;			/* Source string length in bytes. */
    int flags;			/* Conversion control flags. */
    Tcl_EncodingState *statePtr;/* Place for conversion routine to store
				 * state information used during a piecewise
				 * conversion.  Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    char *dst;			/* Output buffer in which converted string
				 * is stored. */
    int dstLen;			/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr;		/* Filled with the number of bytes from the
				 * source string that were converted.  This
				 * may be less than the original source length
				 * if there was a problem converting some
				 * source characters. */
    int *dstWrotePtr;		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr;		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    CONST char *srcStart, *srcEnd;
    char *dstStart, *dstEnd;
    Tcl_UniChar ch;
    int result;
    static char hexChars[] = "0123456789abcdef";
    static char mapChars[] = {
	0, 0, 0, 0, 0, 0, 0,
	'a', 'b', 't', 'n', 'v', 'f', 'r'
    };

    result = TCL_OK;    

    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - 6;

    for ( ; src < srcEnd; ) {
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	src += Tcl_UtfToUniChar(src, &ch);
	dst[0] = '\\';
	if ((ch < sizeof(mapChars)) && (mapChars[ch] != 0)) {
	    dst[1] = mapChars[ch];
	    dst += 2;
	} else if (ch < 256) {
	    dst[1] = 'x';
	    dst[2] = hexChars[(ch >> 4) & 0xf];
	    dst[3] = hexChars[ch & 0xf];
	    dst += 4;
	} else {
	    dst[1] = 'u';
	    dst[2] = hexChars[(ch >> 12) & 0xf];
	    dst[3] = hexChars[(ch >> 8) & 0xf];
	    dst[4] = hexChars[(ch >> 4) & 0xf];
	    dst[5] = hexChars[ch & 0xf];
	    dst += 6;
	}
    }
    *srcReadPtr = src - srcEnd;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = dst - dstStart;
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetNativeFont --
 *
 *	Map a platform-specific native font name to a TkFont.
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
 *	call TkpDeleteFont() when the font is no longer needed.
 *
 *	The caller is responsible for initializing the memory associated
 *	with the generic TkFont when this function returns and releasing
 *	the contents of the generic TkFont before calling TkpDeleteFont().
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

TkFont *
TkpGetNativeFont(tkwin, name)
    Tk_Window tkwin;		/* For display where font will be used. */
    CONST char *name;		/* Platform-specific font name. */
{

    XFontStruct *fontStructPtr;































    fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), name);
    if (fontStructPtr == NULL) {















	return NULL;
    }












    return (TkFont *) AllocFont(NULL, tkwin, fontStructPtr, name);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetFontFromAttributes -- 
 *







|



|





>

>
>
>

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


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







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
 *	call TkpDeleteFont() when the font is no longer needed.
 *
 *	The caller is responsible for initializing the memory associated
 *	with the generic TkFont when this function returns and releasing
 *	the contents of the generic TkFont before calling TkpDeleteFont().
 *
 * Side effects:
 *	Memory allocated.
 *
 *---------------------------------------------------------------------------
 */
 
TkFont *
TkpGetNativeFont(tkwin, name)
    Tk_Window tkwin;		/* For display where font will be used. */
    CONST char *name;		/* Platform-specific font name. */
{
    UnixFont *fontPtr;
    XFontStruct *fontStructPtr;
    FontAttributes fa;
    CONST char *p;
    int hasSpace, dashes, hasWild;

    /*
     * The behavior of X when given a name that isn't an XLFD is unspecified.
     * For example, Exceed 6 returns a valid font for any random string. This
     * is awkward since system names have higher priority than the other Tk
     * font syntaxes.  So, we need to perform a quick sanity check on the
     * name and fail if it looks suspicious.  We fail if the name:
     *     - contains a space immediately before a dash
     *	   - contains a space, but no '*' characters and fewer than 14 dashes
     */

    hasSpace = dashes = hasWild = 0;
    for (p = name; *p != '\0'; p++) {
	if (*p == ' ') {
	    if (p[1] == '-') {
		return NULL;
	    }
	    hasSpace = 1;
	} else if (*p == '-') {
	    dashes++;
	} else if (*p == '*') {
	    hasWild = 1;
	}
    }
    if ((dashes < 14) && !hasWild && hasSpace) {
	return NULL;
    }

    fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), name);
    if (fontStructPtr == NULL) {
	/*
	 * Handle all names that look like XLFDs here.  Otherwise, when
	 * TkpGetFontFromAttributes is called from generic code, any
	 * foundry or encoding information specified in the XLFD will have
	 * been parsed out and lost.  But make sure we don't have an
	 * "-option value" string since TkFontParseXLFD would return a
	 * false success when attempting to parse it.
	 */

	if (name[0] == '-') {
	    if (name[1] != '*') {
		char *dash;
		
		dash = strchr(name + 1, '-');
		if ((dash == NULL) || (isspace(UCHAR(dash[-1])))) {
		    return NULL;
		}
	    }
	} else if (name[0] != '*') {
	    return NULL;
	}
	if (TkFontParseXLFD(name, &fa.fa, &fa.xa) != TCL_OK) {
	    return NULL;
	}
	fontStructPtr = CreateClosestFont(tkwin, &fa.fa, &fa.xa);
    }
    fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont));
    InitFont(tkwin, fontStructPtr, fontPtr);

    return (TkFont *) fontPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetFontFromAttributes -- 
 *
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176

177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
 *	specific data when the font is no longer needed.  
 *
 *	The caller is responsible for initializing the memory associated
 *	with the generic TkFont when this function returns and releasing
 *	the contents of the generic TkFont before calling TkpDeleteFont().
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
TkFont *
TkpGetFontFromAttributes(tkFontPtr, tkwin, faPtr)
    TkFont *tkFontPtr;		/* If non-NULL, store the information in
				 * this existing TkFont structure, rather than
				 * allocating a new structure to hold the
				 * font; the existing contents of the font
				 * will be released.  If NULL, a new TkFont
				 * structure is allocated. */
    Tk_Window tkwin;		/* For display where font will be used. */
    CONST TkFontAttributes *faPtr;  /* Set of attributes to match. */

{
    int numNames, score, i, scaleable, pixelsize, xaPixelsize;
    int bestIdx, bestScore, bestScaleableIdx, bestScaleableScore;
    TkXLFDAttributes xa;    
    char buf[256];
    UnixFont *fontPtr;
    char **nameList;
    XFontStruct *fontStructPtr;
    CONST char *fmt, *family;
    double d;

    family = faPtr->family;
    if (family == NULL) {
	family = "*";
    }

    pixelsize = -faPtr->pointsize;
    if (pixelsize < 0) {
        d = -pixelsize * 25.4 / 72;
	d *= WidthOfScreen(Tk_Screen(tkwin));
	d /= WidthMMOfScreen(Tk_Screen(tkwin));
	d += 0.5;
        pixelsize = (int) d;
    }

    /*
     * Replace the standard Windows and Mac family names with the names that
     * X likes.
     */

    if ((strcasecmp("Times New Roman", family) == 0)
	    || (strcasecmp("New York", family) == 0)) {
	family = "Times";
    } else if ((strcasecmp("Courier New", family) == 0)
	    || (strcasecmp("Monaco", family) == 0)) {
	family = "Courier";
    } else if ((strcasecmp("Arial", family) == 0)
	    || (strcasecmp("Geneva", family) == 0)) {
	family = "Helvetica";
    }

    /*
     * First try for the Q&D exact match.  
     */

#if 0
    sprintf(buf, "-*-%.200s-%s-%c-normal-*-*-%d-*-*-*-*-iso8859-1", family,
	    ((faPtr->weight > TK_FW_NORMAL) ? "bold" : "medium"),
	    ((faPtr->slant == TK_FS_ROMAN) ? 'r' :
		    (faPtr->slant == TK_FS_ITALIC) ? 'i' : 'o'),
	    faPtr->pointsize * 10);
    fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), buf);
#else
    fontStructPtr = NULL;
#endif

    if (fontStructPtr != NULL) {
	goto end;
    }
    /*
     * Couldn't find exact match.  Now fall back to other available
     * physical fonts.  
     */

    fmt = "-*-%.240s-*-*-*-*-*-*-*-*-*-*-*-*";
    sprintf(buf, fmt, family);
    nameList = XListFonts(Tk_Display(tkwin), buf, 10000, &numNames);
    if (numNames == 0) {
	/*
	 * Try getting some system font.
	 */

	sprintf(buf, fmt, "fixed");
	nameList = XListFonts(Tk_Display(tkwin), buf, 10000, &numNames);
	if (numNames == 0) {
	    getsystem:
	    fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), "fixed");
	    if (fontStructPtr == NULL) {
		fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), "*");
		if (fontStructPtr == NULL) {
		    panic("TkpGetFontFromAttributes: cannot get any font");
		}
	    }
	    goto end;
	}
    }

    /*
     * Inspect each of the XLFDs and pick the one that most closely
     * matches the desired attributes.
     */

    bestIdx = 0;
    bestScore = INT_MAX;
    bestScaleableIdx = 0;
    bestScaleableScore = INT_MAX;

    for (i = 0; i < numNames; i++) {
	score = 0;
	scaleable = 0;
	if (TkParseXLFD(nameList[i], &xa) != TCL_OK) {
	    continue;
	}
	xaPixelsize = -xa.fa.pointsize;
	
	/*
	 * Since most people used to use -adobe-* in their XLFDs,
	 * preserve the preference for "adobe" foundry.  Otherwise
	 * some applications looks may change slightly if another foundry
	 * is chosen.
	 */
	 
	if (strcasecmp(xa.foundry, "adobe") != 0) {
	    score += 3000;
	}
	if (xa.fa.pointsize == 0) {
	    /*
	     * A scaleable font is almost always acceptable, but the
	     * corresponding bitmapped font would be better.
	     */

	    score += 10;
	    scaleable = 1;
	} else {
	    /*
	     * A font that is too small is better than one that is too
	     * big.
	     */

	    if (xaPixelsize > pixelsize) {
		score += (xaPixelsize - pixelsize) * 120;
	    } else { 
		score += (pixelsize - xaPixelsize) * 100;
	    }
	}

	score += ABS(xa.fa.weight - faPtr->weight) * 30;
	score += ABS(xa.fa.slant - faPtr->slant) * 25;
	if (xa.slant == TK_FS_OBLIQUE) {
	    /*
	     * Italic fonts are preferred over oblique. */

	    score += 4;
	}

	if (xa.setwidth != TK_SW_NORMAL) {
	    /*
	     * The normal setwidth is highly preferred.
	     */
	    score += 2000;
	}
	if (xa.charset == TK_CS_OTHER) {
	    /*
	     * The standard character set is highly preferred over
	     * foreign languages charsets (because we don't support
	     * other languages yet).
	     */
	    score += 11000;
	}
	if ((xa.charset == TK_CS_NORMAL) && (xa.encoding != 1)) {
	    /*
	     * The '1' encoding for the characters above 0x7f is highly
	     * preferred over the other encodings.
	     */
	    score += 8000;
	}

	if (scaleable) {
	    if (score < bestScaleableScore) {
		bestScaleableIdx = i;
		bestScaleableScore = score;
	    }
	} else {
	    if (score < bestScore) {
		bestIdx = i;
		bestScore = score;
	    }
	}
	if (score == 0) {
	    break;
	}
    }

    /*
     * Now we know which is the closest matching scaleable font and the
     * closest matching bitmapped font.  If the scaleable font was a
     * better match, try getting the scaleable font; however, if the
     * scalable font was not actually available in the desired
     * pointsize, fall back to the closest bitmapped font.
     */

    fontStructPtr = NULL;
    if (bestScaleableScore < bestScore) {
	char *str, *rest;
	
	/*
	 * Fill in the desired pointsize info for this font.
	 */

	tryscale:
	str = nameList[bestScaleableIdx];
	for (i = 0; i < XLFD_PIXEL_SIZE - 1; i++) {
	    str = strchr(str + 1, '-');
	}
	rest = str;
	for (i = XLFD_PIXEL_SIZE - 1; i < XLFD_REGISTRY; i++) {
	    rest = strchr(rest + 1, '-');
	}
	*str = '\0';
	sprintf(buf, "%.240s-*-%d-*-*-*-*-*%s", nameList[bestScaleableIdx],
		pixelsize, rest);
	*str = '-';
	fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), buf);
	bestScaleableScore = INT_MAX;
    }
    if (fontStructPtr == NULL) {
	strcpy(buf, nameList[bestIdx]);
	fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), buf);
	if (fontStructPtr == NULL) {
	    /*
	     * This shouldn't happen because the font name is one of the
	     * names that X gave us to use, but it does anyhow.
	     */

	    if (bestScaleableScore < INT_MAX) {
		goto tryscale;
	    } else {
		XFreeFontNames(nameList);
		goto getsystem;
	    }
	}
    }
    XFreeFontNames(nameList);

    end:
    fontPtr = AllocFont(tkFontPtr, tkwin, fontStructPtr, buf);
    fontPtr->font.fa.underline  = faPtr->underline;
    fontPtr->font.fa.overstrike = faPtr->overstrike;

    return (TkFont *) fontPtr;
}


/*
 *---------------------------------------------------------------------------
 *
 * TkpDeleteFont --
 *
 *	Called to release a font allocated by TkpGetNativeFont() or







|












|
>

<
|
|
<
<
<

<
<

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

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




<







505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527

528
529



530


531




532





































533










































































534






535





536


537



























538









539







540
541


542









































543
544
545
546
547

548
549
550
551
552
553
554
 *	specific data when the font is no longer needed.  
 *
 *	The caller is responsible for initializing the memory associated
 *	with the generic TkFont when this function returns and releasing
 *	the contents of the generic TkFont before calling TkpDeleteFont().
 *
 * Side effects:
 *	Memory allocated.
 *
 *---------------------------------------------------------------------------
 */
TkFont *
TkpGetFontFromAttributes(tkFontPtr, tkwin, faPtr)
    TkFont *tkFontPtr;		/* If non-NULL, store the information in
				 * this existing TkFont structure, rather than
				 * allocating a new structure to hold the
				 * font; the existing contents of the font
				 * will be released.  If NULL, a new TkFont
				 * structure is allocated. */
    Tk_Window tkwin;		/* For display where font will be used. */
    CONST TkFontAttributes *faPtr;
				/* Set of attributes to match. */
{

    UnixFont *fontPtr;
    TkXLFDAttributes xa;



    XFontStruct *fontStructPtr;







    TkInitXLFDAttributes(&xa);





































    fontStructPtr = CreateClosestFont(tkwin, faPtr, &xa);

















































































    fontPtr = (UnixFont *) tkFontPtr;





    if (fontPtr == NULL) {


	fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont));



























    } else {









	ReleaseFont(fontPtr);







    }
    InitFont(tkwin, fontStructPtr, fontPtr);












































    fontPtr->font.fa.underline = faPtr->underline;
    fontPtr->font.fa.overstrike = faPtr->overstrike;

    return (TkFont *) fontPtr;
}


/*
 *---------------------------------------------------------------------------
 *
 * TkpDeleteFont --
 *
 *	Called to release a font allocated by TkpGetNativeFont() or
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479

480
481

482

483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504

505
506
507
508

509
510
511
512

513







































514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536

537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567


568
569
570


571
572
573






574







575












576



577
578



579
580
581
582
583
584


585
586








587








588
















589













590
591
592
593
594
595
596
597
598
599
600
601
602

603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628

629
630
631
632
633
634
635
636
637
638
639
640
641




642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682


683
684
685

686
687

688


689
690

691

692

693
694
695
696
697
698

699



700






701
702

703
704

705
706
707


708






709
710
711
712



713
714
715
716
717

718
719


720
721
722
723






724

725

726

727
728
729
730
731
732
733
734
735
736



737


























738















739
























































































740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757



758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775

776
777


778
779
780
781
782
783
784
785
786

787
788
789
790
791
792
793

794
795



796



797

798
799
800



801




802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820

821
822
823

824
825
826
827
828
829
830
831
832
833

834
835
836
837
838
839
840



841
842
843
844
845
846
847
848



849
850
851
852

853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
void
TkpDeleteFont(tkFontPtr)
    TkFont *tkFontPtr;		/* Token of font to be deleted. */
{
    UnixFont *fontPtr;

    fontPtr = (UnixFont *) tkFontPtr;

    XFreeFont(fontPtr->display, fontPtr->fontStructPtr);
    ckfree((char *) fontPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetFontFamilies --
 *
 *	Return information about the font families that are available
 *	on the display of the given window.
 *
 * Results:
 *	interp->result is modified to hold a list of all the available
 *	font families.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
 
void
TkpGetFontFamilies(interp, tkwin)
    Tcl_Interp *interp;
    Tk_Window tkwin;
{
    int i, new, numNames;
    char *family, *end, *p;
    Tcl_HashTable familyTable;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    char **nameList;


    Tcl_InitHashTable(&familyTable, TCL_STRING_KEYS);



    nameList = XListFonts(Tk_Display(tkwin), "*", 10000, &numNames);
    for (i = 0; i < numNames; i++) {
	if (nameList[i][0] != '-') {
	    continue;
	}
	family = strchr(nameList[i] + 1, '-');
	if (family == NULL) {
	    continue;
	}
	family++;
	end = strchr(family, '-');
	if (end == NULL) {
	    continue;
	}
	*end = '\0';
	for (p = family; *p != '\0'; p++) {
	    if (isupper(UCHAR(*p))) {
		*p = tolower(UCHAR(*p));
	    }
	}
	Tcl_CreateHashEntry(&familyTable, family, &new);
    }


    hPtr = Tcl_FirstHashEntry(&familyTable, &search);
    while (hPtr != NULL) {
	Tcl_AppendElement(interp, Tcl_GetHashKey(&familyTable, hPtr));

	hPtr = Tcl_NextHashEntry(&search);
    }

    Tcl_DeleteHashTable(&familyTable);

    XFreeFontNames(nameList);







































}

/*
 *---------------------------------------------------------------------------
 *
 *  Tk_MeasureChars --
 *
 *	Determine the number of characters from the string that will fit
 *	in the given horizontal span.  The measurement is done under the
 *	assumption that Tk_DrawChars() will be used to actually display
 *	the characters.
 *
 * Results:
 *	The return value is the number of characters from source that
 *	fit into the span that extends from 0 to maxLength.  *lengthPtr is
 *	filled with the x-coordinate of the right edge of the last
 *	character that did fit.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr)
    Tk_Font tkfont;		/* Font in which characters will be drawn. */
    CONST char *source;		/* Characters to be displayed.  Need not be
				 * '\0' terminated. */
    int numChars;		/* Maximum number of characters to consider
				 * from source string. */
    int maxLength;		/* If > 0, maxLength specifies the longest
				 * permissible line length; don't consider any
				 * character that would cross this
				 * x-position.  If <= 0, then line length is
				 * unbounded and the flags argument is
				 * ignored. */
    int flags;			/* Various flag bits OR-ed together:
				 * TK_PARTIAL_OK means include the last char
				 * which only partially fit on this line.
				 * TK_WHOLE_WORDS means stop on a word
				 * boundary, if possible.
				 * TK_AT_LEAST_ONE means return at least one
				 * character even if no characters fit. */
    int *lengthPtr;		/* Filled with x-location just after the
				 * terminating character. */
{
    UnixFont *fontPtr;
    CONST char *p;		/* Current character. */
    CONST char *term;		/* Pointer to most recent character that
				 * may legally be a terminating character. */
    int termX;			/* X-position just after term. */
    int curX;			/* X-position corresponding to p. */
    int newX;			/* X-position corresponding to p+1. */
    int c, sawNonSpace;



    fontPtr = (UnixFont *) tkfont;



    if (numChars == 0) {
	*lengthPtr = 0;
	return 0;






    }




















    if (maxLength <= 0) {



	maxLength = INT_MAX;
    }




    newX = curX = termX = 0;
    p = term = source;
    sawNonSpace = !isspace(UCHAR(*p));

    /*


     * Scan the input string one character at a time, calculating width.
     */

















    for (c = UCHAR(*p); ; ) {
















	newX += fontPtr->widths[c];













	if (newX > maxLength) {
	    break;
	}
	curX = newX;
	numChars--;
	p++;
	if (numChars == 0) {
	    term = p;
	    termX = curX;
	    break;
	}

	c = UCHAR(*p);

	if (isspace(c)) {
	    if (sawNonSpace) {
		term = p;
		termX = curX;
		sawNonSpace = 0;
	    }
	} else {
	    sawNonSpace = 1;
	}
    }

    /*
     * P points to the first character that doesn't fit in the desired
     * span.  Use the flags to figure out what to return.
     */

    if ((flags & TK_PARTIAL_OK) && (numChars > 0) && (curX < maxLength)) {
	/*
	 * Include the first character that didn't quite fit in the desired
	 * span.  The width returned will include the width of that extra
	 * character.
	 */

	numChars--;
	curX = newX;
	p++;

    }
    if ((flags & TK_AT_LEAST_ONE) && (term == source) && (numChars > 0)) {
	term = p;
	termX = curX;
	if (term == source) {
	    term++;
	    termX = newX;
	}
    } else if ((numChars == 0) || !(flags & TK_WHOLE_WORDS)) {
	term = p;
	termX = curX;
    }





    *lengthPtr = termX;
    return term-source;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_DrawChars, DrawChars --
 *
 *	Draw a string of characters on the screen.  Tk_DrawChars()
 *	expands control characters that occur in the string to \X or
 *	\xXX sequences.  DrawChars() just draws the strings.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Information gets drawn on the screen.
 *
 *---------------------------------------------------------------------------
 */

void
Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y)
    Display *display;		/* Display on which to draw. */
    Drawable drawable;		/* Window or pixmap in which to draw. */
    GC gc;			/* Graphics context for drawing characters. */
    Tk_Font tkfont;		/* Font in which characters will be drawn;
				 * must be the same as font used in GC. */
    CONST char *source;		/* Characters to be displayed.  Need not be
				 * '\0' terminated.  All Tk meta-characters
				 * (tabs, control characters, and newlines)
				 * should be stripped out of the string that
				 * is passed to this function.  If they are
				 * not stripped out, they will be displayed as
				 * regular printing characters. */
    int numChars;		/* Number of characters in string. */
    int x, y;			/* Coordinates at which to place origin of
				 * string when drawing. */
{
    UnixFont *fontPtr;


    CONST char *p;
    int i, type;
    char buf[4];


    fontPtr = (UnixFont *) tkfont;




    p = source;
    for (i = 0; i < numChars; i++) {

	type = fontPtr->types[UCHAR(*p)];

	if (type != NORMAL) {

	    DrawChars(display, drawable, gc, fontPtr, source, p - source, x, y);
	    x += XTextWidth(fontPtr->fontStructPtr, source, p - source);
	    if (type == REPLACE) {
		DrawChars(display, drawable, gc, fontPtr, buf,
			GetControlCharSubst(UCHAR(*p), buf), x, y);
		x += fontPtr->widths[UCHAR(*p)];

	    }



	    source = p + 1;






	}
	p++;

    }


    DrawChars(display, drawable, gc, fontPtr, source, p - source, x, y);
}



static void






DrawChars(display, drawable, gc, fontPtr, source, numChars, x, y)
    Display *display;		/* Display on which to draw. */
    Drawable drawable;		/* Window or pixmap in which to draw. */
    GC gc;			/* Graphics context for drawing characters. */



    UnixFont *fontPtr;		/* Font in which characters will be drawn;
				 * must be the same as font used in GC. */
    CONST char *source;		/* Characters to be displayed.  Need not be
				 * '\0' terminated.  All Tk meta-characters
				 * (tabs, control characters, and newlines)

				 * should be stripped out of the string that
				 * is passed to this function.  If they are


				 * not stripped out, they will be displayed as
				 * regular printing characters. */
    int numChars;		/* Number of characters in string. */
    int x, y;			/* Coordinates at which to place origin of






				 * string when drawing. */

{		

    XDrawString(display, drawable, gc, x, y, source, numChars);


    if (fontPtr->font.fa.underline != 0) {
	XFillRectangle(display, drawable, gc, x,
		y + fontPtr->underlinePos,
		(unsigned) XTextWidth(fontPtr->fontStructPtr, source, numChars),
		(unsigned) fontPtr->barHeight);
    }
    if (fontPtr->font.fa.overstrike != 0) {
	y -= fontPtr->font.fm.descent + (fontPtr->font.fm.ascent) / 10;
	XFillRectangle(display, drawable, gc, x, y,



		(unsigned) XTextWidth(fontPtr->fontStructPtr, source, numChars),


























		(unsigned) fontPtr->barHeight);















    }
























































































}

/*
 *---------------------------------------------------------------------------
 *
 * AllocFont --
 *
 *	Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
 *	Allocates and intializes the memory for a new TkFont that
 *	wraps the platform-specific data.
 *
 * Results:
 *	Returns pointer to newly constructed TkFont.  
 *
 *	The caller is responsible for initializing the fields of the
 *	TkFont that are used exclusively by the generic TkFont code, and
 *	for releasing those fields before calling TkpDeleteFont().
 *



 * Side effects:
 *	Memory allocated.
 *
 *---------------------------------------------------------------------------
 */ 

static UnixFont *
AllocFont(tkFontPtr, tkwin, fontStructPtr, fontName)
    TkFont *tkFontPtr;		/* If non-NULL, store the information in
				 * this existing TkFont structure, rather than
				 * allocating a new structure to hold the
				 * font; the existing contents of the font
				 * will be released.  If NULL, a new TkFont
				 * structure is allocated. */
    Tk_Window tkwin;		/* For display where font will be used. */
    XFontStruct *fontStructPtr;	/* X information about font. */
    CONST char *fontName;	/* The string passed to XLoadQueryFont() to
				 * construct the fontStructPtr. */

{
    UnixFont *fontPtr;


    unsigned long value;
    int i, width, firstChar, lastChar, n, replaceOK;
    char *name, *p;
    char buf[4];
    TkXLFDAttributes xa;
    double d;
    
    if (tkFontPtr != NULL) {
	fontPtr = (UnixFont *) tkFontPtr;

	XFreeFont(fontPtr->display, fontPtr->fontStructPtr);
    } else {
        fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont));
    }

    /*
     * Encapsulate the generic stuff in the TkFont. 

     */




    fontPtr->font.fid		= fontStructPtr->fid;





    if (XGetFontProperty(fontStructPtr, XA_FONT, &value) && (value != 0)) {
	name = Tk_GetAtomName(tkwin, (Atom) value);
	TkInitFontAttributes(&xa.fa);



	if (TkParseXLFD(name, &xa) == TCL_OK) {




	    goto ok;
	}
    }
    TkInitFontAttributes(&xa.fa);
    if (TkParseXLFD(fontName, &xa) != TCL_OK) {
	TkInitFontAttributes(&fontPtr->font.fa);
	fontPtr->font.fa.family = Tk_GetUid(fontName);
    } else {
	ok:
	fontPtr->font.fa = xa.fa;
    }

    if (fontPtr->font.fa.pointsize < 0) {
	d = -fontPtr->font.fa.pointsize * 72 / 25.4;
	d *= WidthMMOfScreen(Tk_Screen(tkwin));
	d /= WidthOfScreen(Tk_Screen(tkwin));
	d += 0.5;
	fontPtr->font.fa.pointsize = (int) d;
    }

	
    fontPtr->font.fm.ascent	= fontStructPtr->ascent;
    fontPtr->font.fm.descent	= fontStructPtr->descent;

    fontPtr->font.fm.maxWidth	= fontStructPtr->max_bounds.width;
    fontPtr->font.fm.fixed	= 1;
    fontPtr->display		= Tk_Display(tkwin);
    fontPtr->fontStructPtr	= fontStructPtr;

    /*
     * Classify the characters.
     */

    firstChar = fontStructPtr->min_char_or_byte2;

    lastChar = fontStructPtr->max_char_or_byte2;
    for (i = 0; i < 256; i++) {
	if ((i == 0177) || (i < firstChar) || (i > lastChar)) {
	    fontPtr->types[i] = REPLACE;
	} else {
	    fontPtr->types[i] = NORMAL;
	}



    }

    /*
     * Compute the widths for all the normal characters.  Any other
     * characters are given an initial width of 0.  Also, this determines
     * if this is a fixed or variable width font, by comparing the widths
     * of all the normal characters.
     */




    width = 0;
    for (i = 0; i < 256; i++) {
	if (fontPtr->types[i] != NORMAL) {

	    n = 0;
	} else if (fontStructPtr->per_char == NULL) {
	    n = fontStructPtr->max_bounds.width;
	} else {
	    n = fontStructPtr->per_char[i - firstChar].width;
	}
	fontPtr->widths[i] = n;
	if (n != 0) {
	    if (width == 0) {
		width = n;
	    } else if (width != n) {
		fontPtr->font.fm.fixed = 0;
	    }
	}
    }

    /*
     * Compute the widths of the characters that should be replaced with
     * control character expansions.  If the appropriate chars are not
     * available in this font, then control character expansions will not
     * be used; control chars will be invisible & zero-width.
     */

    replaceOK = 1;
    for (p = hexChars; *p != '\0'; p++) {
	if ((UCHAR(*p) < firstChar) || (UCHAR(*p) > lastChar)) {
	    replaceOK = 0;
	    break;
	}
    }
    for (i = 0; i < 256; i++) {
	if (fontPtr->types[i] == REPLACE) {
	    if (replaceOK) {
		n = GetControlCharSubst(i, buf);
		for ( ; --n >= 0; ) {
		    fontPtr->widths[i] += fontPtr->widths[UCHAR(buf[n])];
		}
	    } else {
		fontPtr->types[i] = SKIP;
	    }
	}
    }

    if (XGetFontProperty(fontStructPtr, XA_UNDERLINE_POSITION, &value)) {
	fontPtr->underlinePos = value;
    } else {
	/*
	 * If the XA_UNDERLINE_POSITION property does not exist, the X
	 * manual recommends using the following value:
	 */

	fontPtr->underlinePos = fontStructPtr->descent / 2;
    }
    fontPtr->barHeight = 0;
    if (XGetFontProperty(fontStructPtr, XA_UNDERLINE_THICKNESS, &value)) {
	/*
	 * Sometimes this is 0 even though it shouldn't be.
	 */
	fontPtr->barHeight = value;
    }
    if (fontPtr->barHeight == 0) {
	/*
	 * If the XA_UNDERLINE_THICKNESS property does not exist, the X
	 * manual recommends using the width of the stem on a capital
	 * letter.  I don't know of a way to get the stem width of a letter,







<
<
|











|







|


|
|


|




>

<
>

>
|

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


>



|
>




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













|









>

|

|

|

|
|
|
|
|












|
|
|
|
|
|
|
>
>



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

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

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

|
|
|
|

|
|
|
|
|
|

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

>
>
>
>
|
|





|


|
|











|





|






|




>
>
|
|
|
>


>

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


|

<
|



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





|


|
|
<
<
<





>
>
>






|
|
<
<
<
<
<
<
|

<
|
>

<
>
>

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

<
>

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

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

|
>




|


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













<
<
<







568
569
570
571
572
573
574


575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608

609
610
611
612
613



614




615









616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770

771

772

773
774
775

776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827

828
829
830
831
832
833
834

835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858

859

860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942

943
944
945
946
947
948
949
950
951
952
953
954
955

956
957
958
959
960

961
962
963
964
965
966
967
968
969
970
971



972
973
974
975




976
977

978
979
980
981
982

983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998

999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148



1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164






1165
1166

1167
1168
1169

1170
1171
1172
1173


1174

1175
1176
1177
1178
1179


1180

1181

1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195

1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206







1207
1208






1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219



1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234



1235
1236

1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251





1252
1253




























1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266



1267
1268
1269
1270
1271
1272
1273
void
TkpDeleteFont(tkFontPtr)
    TkFont *tkFontPtr;		/* Token of font to be deleted. */
{
    UnixFont *fontPtr;

    fontPtr = (UnixFont *) tkFontPtr;


    ReleaseFont(fontPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetFontFamilies --
 *
 *	Return information about the font families that are available
 *	on the display of the given window.
 *
 * Results:
 *	Modifies interp's result object to hold a list of all the available
 *	font families.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void
TkpGetFontFamilies(interp, tkwin)
    Tcl_Interp *interp;		/* Interp to hold result. */
    Tk_Window tkwin;		/* For display to query. */
{
    int i, new, numNames;
    char *family;
    Tcl_HashTable familyTable;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    char **nameList;
    Tcl_Obj *resultPtr, *strPtr;


    resultPtr = Tcl_GetObjResult(interp);    

    Tcl_InitHashTable(&familyTable, TCL_STRING_KEYS);
    nameList = ListFonts(Tk_Display(tkwin), "*", &numNames);
    for (i = 0; i < numNames; i++) {



	family = strchr(nameList[i] + 1, '-') + 1;




	strchr(family, '-')[0] = '\0';









	Tcl_CreateHashEntry(&familyTable, family, &new);
    }
    XFreeFontNames(nameList);

    hPtr = Tcl_FirstHashEntry(&familyTable, &search);
    while (hPtr != NULL) {
	strPtr = Tcl_NewStringObj(Tcl_GetHashKey(&familyTable, hPtr), -1); 
	Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
	hPtr = Tcl_NextHashEntry(&search);
    }

    Tcl_DeleteHashTable(&familyTable);
}

/*
 *-------------------------------------------------------------------------
 *
 * TkpGetSubFonts --
 *
 *	A function used by the testing package for querying the actual 
 *	screen fonts that make up a font object.
 *
 * Results:
 *	Modifies interp's result object to hold a list containing the 
 *	names of the screen fonts that make up the given font object.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

void
TkpGetSubFonts(interp, tkfont)
    Tcl_Interp *interp;
    Tk_Font tkfont;
{
    int i;
    Tcl_Obj *objv[3];
    Tcl_Obj *resultPtr, *listPtr;
    UnixFont *fontPtr;
    FontFamily *familyPtr;

    resultPtr = Tcl_GetObjResult(interp);    
    fontPtr = (UnixFont *) tkfont;
    for (i = 0; i < fontPtr->numSubFonts; i++) {
	familyPtr = fontPtr->subFontArray[i].familyPtr;
	objv[0] = Tcl_NewStringObj(familyPtr->faceName, -1);
	objv[1] = Tcl_NewStringObj(familyPtr->foundry, -1);
	objv[2] = Tcl_NewStringObj(Tcl_GetEncodingName(familyPtr->encoding), -1);
	listPtr = Tcl_NewListObj(3, objv);
	Tcl_ListObjAppendElement(NULL, resultPtr, listPtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 *  Tk_MeasureChars --
 *
 *	Determine the number of characters from the string that will fit
 *	in the given horizontal span.  The measurement is done under the
 *	assumption that Tk_DrawChars() will be used to actually display
 *	the characters.
 *
 * Results:
 *	The return value is the number of bytes from source that
 *	fit into the span that extends from 0 to maxLength.  *lengthPtr is
 *	filled with the x-coordinate of the right edge of the last
 *	character that did fit.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
Tk_MeasureChars(tkfont, source, numBytes, maxLength, flags, lengthPtr)
    Tk_Font tkfont;		/* Font in which characters will be drawn. */
    CONST char *source;		/* UTF-8 string to be displayed.  Need not be
				 * '\0' terminated. */
    int numBytes;		/* Maximum number of bytes to consider
				 * from source string. */
    int maxLength;		/* If >= 0, maxLength specifies the longest
				 * permissible line length in pixels; don't
				 * consider any character that would cross
				 * this x-position.  If < 0, then line length
				 * is unbounded and the flags argument is
				 * ignored. */
    int flags;			/* Various flag bits OR-ed together:
				 * TK_PARTIAL_OK means include the last char
				 * which only partially fit on this line.
				 * TK_WHOLE_WORDS means stop on a word
				 * boundary, if possible.
				 * TK_AT_LEAST_ONE means return at least one
				 * character even if no characters fit. */
    int *lengthPtr;		/* Filled with x-location just after the
				 * terminating character. */
{
    UnixFont *fontPtr;
    SubFont *lastSubFontPtr;
    int curX, curByte;

    /*
     * Unix does not use kerning or fractional character widths when
     * displaying text on the screen.  So that means we can safely measure
     * individual characters or spans of characters and add up the widths
     * w/o any "off-by-one-pixel" errors.
     */

    fontPtr = (UnixFont *) tkfont;

    lastSubFontPtr = &fontPtr->subFontArray[0];

    if (numBytes == 0) {
	curX = 0;
	curByte = 0;
    } else if (maxLength < 0) {
	CONST char *p, *end, *next;
	Tcl_UniChar ch;
	SubFont *thisSubFontPtr;
	FontFamily *familyPtr;
	Tcl_DString runString;

	/*
	 * A three step process:
	 * 1. Find a contiguous range of characters that can all be 
	 *    represented by a single screen font.
	 * 2. Convert those chars to the encoding of that font.
	 * 3. Measure converted chars.
	 */

	curX = 0;
	end = source + numBytes;
	for (p = source; p < end; ) {
	    next = p + Tcl_UtfToUniChar(p, &ch);
	    thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
	    if (thisSubFontPtr != lastSubFontPtr) {
		familyPtr = lastSubFontPtr->familyPtr;
		Tcl_UtfToExternalDString(familyPtr->encoding, source,
			p - source, &runString);
		if (familyPtr->isTwoByteFont) {
		    curX += XTextWidth16(lastSubFontPtr->fontStructPtr,
			    (XChar2b *) Tcl_DStringValue(&runString),
			    Tcl_DStringLength(&runString) / 2);
		} else {
		    curX += XTextWidth(lastSubFontPtr->fontStructPtr,
			    Tcl_DStringValue(&runString),
			    Tcl_DStringLength(&runString));
		}
		Tcl_DStringFree(&runString);
		lastSubFontPtr = thisSubFontPtr;
		source = p;
	    }

	    p = next;

	}

	familyPtr = lastSubFontPtr->familyPtr;
	Tcl_UtfToExternalDString(familyPtr->encoding, source,  p - source,
		&runString);

	if (familyPtr->isTwoByteFont) {
	    curX += XTextWidth16(lastSubFontPtr->fontStructPtr,
		    (XChar2b *) Tcl_DStringValue(&runString),
		    Tcl_DStringLength(&runString) >> 1);
	} else {
	    curX += XTextWidth(lastSubFontPtr->fontStructPtr,
		    Tcl_DStringValue(&runString),
		    Tcl_DStringLength(&runString));
	}
	Tcl_DStringFree(&runString);
	curByte = numBytes;
    } else {
	CONST char *p, *end, *next, *term;
	int newX, termX, sawNonSpace, dstWrote;
	Tcl_UniChar ch;
	FontFamily *familyPtr;
	char buf[16];

	/*
	 * How many chars will fit in the space allotted? 
	 * This first version may be inefficient because it measures
	 * every character individually.
	 */

	next = source + Tcl_UtfToUniChar(source, &ch);
	newX = curX = termX = 0;
	
	term = source;
	end = source + numBytes;

	sawNonSpace = (ch > 255) || !isspace(ch);
	familyPtr = lastSubFontPtr->familyPtr;
	for (p = source; ; ) {
	    if ((ch < BASE_CHARS) && (fontPtr->widths[ch] != 0)) {
		newX += fontPtr->widths[ch];
	    } else {
		lastSubFontPtr = FindSubFontForChar(fontPtr, ch);
		familyPtr = lastSubFontPtr->familyPtr;
		Tcl_UtfToExternal(NULL, familyPtr->encoding, p, next - p,
			0, NULL, buf, sizeof(buf), NULL, &dstWrote, NULL);
		if (familyPtr->isTwoByteFont) {
		    newX += XTextWidth16(lastSubFontPtr->fontStructPtr,
			    (XChar2b *) buf, dstWrote >> 1);
		} else {
		    newX += XTextWidth(lastSubFontPtr->fontStructPtr, buf,
			    dstWrote);
		}
	    }
	    if (newX > maxLength) {
		break;
	    }
	    curX = newX;

	    p = next;
	    if (p >= end) {
		term = end;
		termX = curX;
		break;
	    }


	    next += Tcl_UtfToUniChar(next, &ch);
	    if ((ch < 256) && isspace(ch)) {
		if (sawNonSpace) {
		    term = p;
		    termX = curX;
		    sawNonSpace = 0;
		}
	    } else {
		sawNonSpace = 1;
	    }
	}

	/*
	 * P points to the first character that doesn't fit in the desired
	 * span.  Use the flags to figure out what to return.
	 */

	if ((flags & TK_PARTIAL_OK) && (p < end) && (curX < maxLength)) {
	    /*
	     * Include the first character that didn't quite fit in the desired
	     * span.  The width returned will include the width of that extra
	     * character.
	     */


	    curX = newX;

	    p += Tcl_UtfToUniChar(p, &ch);
	}
	if ((flags & TK_AT_LEAST_ONE) && (term == source) && (p < end)) {
	    term = p;
	    termX = curX;
	    if (term == source) {
		term += Tcl_UtfToUniChar(term, &ch);
		termX = newX;
	    }
	} else if ((p >= end) || !(flags & TK_WHOLE_WORDS)) {
	    term = p;
	    termX = curX;
	}

	curX = termX;
	curByte = term - source;	
    }

    *lengthPtr = curX;
    return curByte;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_DrawChars --
 *
 *	Draw a string of characters on the screen.  Tk_DrawChars()
 *	expands control characters that occur in the string to 
 *	\xNN sequences.  
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Information gets drawn on the screen.
 *
 *---------------------------------------------------------------------------
 */

void
Tk_DrawChars(display, drawable, gc, tkfont, source, numBytes, x, y)
    Display *display;		/* Display on which to draw. */
    Drawable drawable;		/* Window or pixmap in which to draw. */
    GC gc;			/* Graphics context for drawing characters. */
    Tk_Font tkfont;		/* Font in which characters will be drawn;
				 * must be the same as font used in GC. */
    CONST char *source;		/* UTF-8 string to be displayed.  Need not be
				 * '\0' terminated.  All Tk meta-characters
				 * (tabs, control characters, and newlines)
				 * should be stripped out of the string that
				 * is passed to this function.  If they are
				 * not stripped out, they will be displayed as
				 * regular printing characters. */
    int numBytes;		/* Number of bytes in string. */
    int x, y;			/* Coordinates at which to place origin of
				 * string when drawing. */
{
    UnixFont *fontPtr;
    SubFont *thisSubFontPtr, *lastSubFontPtr;
    Tcl_DString runString;
    CONST char *p, *end, *next;
    int xStart, needWidth;
    Tcl_UniChar ch;
    FontFamily *familyPtr;

    fontPtr = (UnixFont *) tkfont;
    lastSubFontPtr = &fontPtr->subFontArray[0];

    xStart = x;

    end = source + numBytes;
    for (p = source; p < end; ) {
	next = p + Tcl_UtfToUniChar(p, &ch);
	thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
	if (thisSubFontPtr != lastSubFontPtr) {
	    if (p > source) {
		familyPtr = lastSubFontPtr->familyPtr;
		Tcl_UtfToExternalDString(familyPtr->encoding, source,
			p - source, &runString);
		if (familyPtr->isTwoByteFont) {
		    XDrawString16(display, drawable, gc, x, y, 
			    (XChar2b *) Tcl_DStringValue(&runString),

			    Tcl_DStringLength(&runString) / 2);
			    
		    x += XTextWidth16(lastSubFontPtr->fontStructPtr,
			    (XChar2b *) Tcl_DStringValue(&runString),
			    Tcl_DStringLength(&runString) / 2);
		} else {
		    XDrawString(display, drawable, gc, x, y,
			    Tcl_DStringValue(&runString),
			    Tcl_DStringLength(&runString));
		    x += XTextWidth(lastSubFontPtr->fontStructPtr,
			    Tcl_DStringValue(&runString),
			    Tcl_DStringLength(&runString));
		}

		Tcl_DStringFree(&runString);
	    }
	    lastSubFontPtr = thisSubFontPtr;
	    source = p;
	    XSetFont(display, gc, lastSubFontPtr->fontStructPtr->fid);

	}
	p = next;
    }

    needWidth = fontPtr->font.fa.underline + fontPtr->font.fa.overstrike;
    if (p > source) {
	familyPtr = lastSubFontPtr->familyPtr;
	Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source,
		&runString);
	if (familyPtr->isTwoByteFont) {
	    XDrawString16(display, drawable, gc, x, y, 



		    (XChar2b *) Tcl_DStringValue(&runString),
		    Tcl_DStringLength(&runString) >> 1);
	    if (needWidth) {
		x += XTextWidth16(lastSubFontPtr->fontStructPtr,




			(XChar2b *) Tcl_DStringValue(&runString),
			Tcl_DStringLength(&runString) >> 1);

	    }
	} else {
	    XDrawString(display, drawable, gc, x, y, 
		    Tcl_DStringValue(&runString),
		    Tcl_DStringLength(&runString));

	    if (needWidth) {
		x += XTextWidth(lastSubFontPtr->fontStructPtr,
			Tcl_DStringValue(&runString),
			Tcl_DStringLength(&runString));
	    }
	}
	Tcl_DStringFree(&runString);
    }

    if (lastSubFontPtr != &fontPtr->subFontArray[0]) {
	XSetFont(display, gc, fontPtr->subFontArray[0].fontStructPtr->fid);
    }

    if (fontPtr->font.fa.underline != 0) {
	XFillRectangle(display, drawable, gc, xStart,
		y + fontPtr->underlinePos,

		(unsigned) (x - xStart), (unsigned) fontPtr->barHeight);
    }
    if (fontPtr->font.fa.overstrike != 0) {
	y -= fontPtr->font.fm.descent + (fontPtr->font.fm.ascent) / 10;
	XFillRectangle(display, drawable, gc, xStart, y,
		(unsigned) (x - xStart), (unsigned) fontPtr->barHeight);
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * CreateClosestFont --
 *
 *	Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
 *	Given a set of font attributes, construct a close XFontStruct.
 *	If requested face name is not available, automatically
 *	substitutes an alias for requested face name.  If encoding is
 *	not specified (or the requested one is not available),
 *	automatically chooses another encoding from the list of
 *	preferred encodings.  If the foundry is not specified (or
 *	is not available) automatically prefers "adobe" foundry.
 *	For all other attributes, if the requested value was not
 *	available, the appropriate "close" value will be used.
 *
 * Results:
 *	Return value is the XFontStruct that best matched the
 *	requested attributes.  The return value is never NULL; some
 *	font will always be returned.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static XFontStruct *
CreateClosestFont(tkwin, faPtr, xaPtr)
    Tk_Window tkwin;		/* For display where font will be used. */
    CONST TkFontAttributes *faPtr;	
				/* Set of generic attributes to match. */
    CONST TkXLFDAttributes *xaPtr;
				/* Set of X-specific attributes to match. */
{
    FontAttributes want;
    char **nameList;
    int numNames, nameIdx;
    Display *display;
    XFontStruct *fontStructPtr;
    int bestIdx[2];
    unsigned int bestScore[2];

    want.fa = *faPtr;
    want.xa = *xaPtr;

    if (want.xa.foundry == NULL) {
	want.xa.foundry = Tk_GetUid("adobe");
    }
    if (want.fa.family == NULL) {
	want.fa.family = Tk_GetUid("fixed");
    }
    want.fa.size = -TkFontGetPixels(tkwin, faPtr->size);
    if (want.xa.charset == NULL || *want.xa.charset == '\0') {
	want.xa.charset = Tk_GetUid("iso8859-1");	/* locale. */
    }

    display = Tk_Display(tkwin);

    /*
     * Algorithm to get the closest font to the name requested.
     *
     * try fontname
     * try all aliases for fontname
     * foreach fallback for fontname
     *	    try the fallback
     *	    try all aliases for the fallback
     */

    nameList = ListFontOrAlias(display, want.fa.family, &numNames);
    if (numNames == 0) {
	char ***fontFallbacks;
	int i, j;
	char *fallback;
	
	fontFallbacks = TkFontGetFallbacks();
	for (i = 0; fontFallbacks[i] != NULL; i++) {
	    for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
		if (strcasecmp(want.fa.family, fallback) == 0) {
		    break;
		}
	    }
	    if (fallback != NULL) {
		for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
		    nameList = ListFontOrAlias(display, fallback, &numNames);
		    if (numNames != 0) {
			goto found;
		    }
		}
	    }
	}
	nameList = ListFonts(display, "fixed", &numNames);
	if (numNames == 0) {
	    nameList = ListFonts(display, "*", &numNames);
	}
	if (numNames == 0) {
	    return GetSystemFont(display);
	}
    }
    found:
    bestIdx[0] = -1;
    bestIdx[1] = -1;
    bestScore[0] = (unsigned int) -1;
    bestScore[1] = (unsigned int) -1;
    for (nameIdx = 0; nameIdx < numNames; nameIdx++) {
	FontAttributes got;
	int scalable;
	unsigned int score;
	
	if (TkFontParseXLFD(nameList[nameIdx], &got.fa, &got.xa) != TCL_OK) {
	    continue;
	}
	IdentifySymbolEncodings(&got);
	scalable = (got.fa.size == 0);
	score = RankAttributes(&want, &got);
	if (score <= bestScore[scalable]) {
	    bestIdx[scalable] = nameIdx;
	    bestScore[scalable] = score;
	}
	if (score == 0) {
	    break;
	}
    }

    fontStructPtr = GetScreenFont(display, &want, nameList, bestIdx, bestScore);
    XFreeFontNames(nameList);
    
    if (fontStructPtr == NULL) {
	return GetSystemFont(display);
    }
    return fontStructPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * InitFont --
 *
 *	Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
 *	Initializes the memory for a new UnixFont that 	wraps the
 *	platform-specific data.



 *
 *	The caller is responsible for initializing the fields of the
 *	TkFont that are used exclusively by the generic TkFont code, and
 *	for releasing those fields before calling TkpDeleteFont().
 *
 * Results:
 *	Fills the WinFont structure.
 *
 * Side effects:
 *	Memory allocated.
 *
 *---------------------------------------------------------------------------
 */ 

static void
InitFont(tkwin, fontStructPtr, fontPtr)






    Tk_Window tkwin;		/* For screen where font will be used. */
    XFontStruct *fontStructPtr;	/* X information about font. */

    UnixFont *fontPtr;		/* Filled with information constructed from
				 * the above arguments. */
{

    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    unsigned long value;
    int minHi, maxHi, minLo, maxLo, fixed, width, limit, i, n;


    FontAttributes fa;

    TkFontAttributes *faPtr;
    TkFontMetrics *fmPtr;
    SubFont *controlPtr, *subFontPtr;
    char *pageMap;
    Display *display;




    /*

     * Get all font attributes and metrics.
     */
     
    display = Tk_Display(tkwin);
    GetFontAttributes(display, fontStructPtr, &fa);

    minHi = fontStructPtr->min_byte1;
    maxHi = fontStructPtr->max_byte1;
    minLo = fontStructPtr->min_char_or_byte2;
    maxLo = fontStructPtr->max_char_or_byte2;
	
    fixed = 1;
    if (fontStructPtr->per_char != NULL) {
	width = 0;

	limit = (maxHi - minHi + 1) * (maxLo - minLo + 1);
	for (i = 0; i < limit; i++) {
	    n = fontStructPtr->per_char[i].width;
	    if (n != 0) {
		if (width == 0) {
		    width = n;
		} else if (width != n) {
		    fixed = 0;
		    break;
		}
	    }







	}
    }







    fontPtr->font.fid	= fontStructPtr->fid;

    faPtr		= &fontPtr->font.fa;
    faPtr->family	= fa.fa.family;
    faPtr->size		= TkFontGetPoints(tkwin, fa.fa.size);
    faPtr->weight	= fa.fa.weight;
    faPtr->slant	= fa.fa.slant;
    faPtr->underline	= 0;
    faPtr->overstrike	= 0;




    fmPtr		= &fontPtr->font.fm;
    fmPtr->ascent	= fontStructPtr->ascent;
    fmPtr->descent	= fontStructPtr->descent;
    fmPtr->maxWidth	= fontStructPtr->max_bounds.width;
    fmPtr->fixed	= fixed;

    fontPtr->display	= display;
    fontPtr->pixelSize	= TkFontGetPixels(tkwin, fa.fa.size);
    fontPtr->xa		= fa.xa;

    fontPtr->numSubFonts	= 1;
    fontPtr->subFontArray	= fontPtr->staticSubFonts;
    InitSubFont(display, fontStructPtr, 1, &fontPtr->subFontArray[0]);

    fontPtr->controlSubFont	= fontPtr->subFontArray[0];



    subFontPtr			= FindSubFontForChar(fontPtr, '0');
    controlPtr			= &fontPtr->controlSubFont;

    controlPtr->fontStructPtr	= subFontPtr->fontStructPtr;
    controlPtr->familyPtr	= &tsdPtr->controlFamily;
    controlPtr->fontMap		= tsdPtr->controlFamily.fontMap;
    
    pageMap = fontPtr->subFontArray[0].fontMap[0];
    for (i = 0; i < 256; i++) {
	if ((minHi > 0) || (i < minLo) || (i > maxLo) ||
		(((pageMap[i >> 3] >> (i & 7)) & 1) == 0)) {
	    n = 0;
	} else if (fontStructPtr->per_char == NULL) {
	    n = fontStructPtr->max_bounds.width;
	} else {
	    n = fontStructPtr->per_char[i - minLo].width;
	}
	fontPtr->widths[i] = n;





    }
    





























    if (XGetFontProperty(fontStructPtr, XA_UNDERLINE_POSITION, &value)) {
	fontPtr->underlinePos = value;
    } else {
	/*
	 * If the XA_UNDERLINE_POSITION property does not exist, the X
	 * manual recommends using the following value:
	 */

	fontPtr->underlinePos = fontStructPtr->descent / 2;
    }
    fontPtr->barHeight = 0;
    if (XGetFontProperty(fontStructPtr, XA_UNDERLINE_THICKNESS, &value)) {



	fontPtr->barHeight = value;
    }
    if (fontPtr->barHeight == 0) {
	/*
	 * If the XA_UNDERLINE_THICKNESS property does not exist, the X
	 * manual recommends using the width of the stem on a capital
	 * letter.  I don't know of a way to get the stem width of a letter,
932
933
934
935
936
937
938
























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































939
























940
941
942
943
944
945
946
947
948
949
950

951
952


953
954


955
956
957
958
959
960
961
962
963
964
965
966
967
968


969

970

971
972





973





974



















975





976






977
978
979


	fontPtr->barHeight = fontStructPtr->descent - fontPtr->underlinePos;
	if (fontPtr->barHeight == 0) {
	    fontPtr->underlinePos--;
	    fontPtr->barHeight = 1;
	}
    }

















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































    return fontPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * GetControlCharSubst --
 *
 *	When displaying text in a widget, a backslashed escape sequence
 *	is substituted for control characters that occur in the text.
 *	Given a control character, fill in a buffer with the replacement

 *	string that should be displayed.
 *


 * Results:
 *	The return value is the length of the substitute string.  buf is


 *	filled with the substitute string; it is not '\0' terminated.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
GetControlCharSubst(c, buf)
    int		c;		/* The control character to be replaced. */
    char	buf[4];		/* Buffer that gets replacement string.  It
				 * only needs to be 4 characters long. */
{


    buf[0] = '\\';

    if ((c < sizeof(mapChars)) && (mapChars[c] != 0)) {

	buf[1] = mapChars[c];
	return 2;





    } else {





	buf[1] = 'x';



















	buf[2] = hexChars[(c >> 4) & 0xf];





	buf[3] = hexChars[c & 0xf];






	return 4;
    }
}








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

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





|

|
|
|
>
|

>
>

|
>
>
|








|
|
<
<

>
>
|
>
|
>
|
|
>
>
>
>
>
|
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
|
>
>
>
>
>
>
|
|
|
>
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526


2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583

	fontPtr->barHeight = fontStructPtr->descent - fontPtr->underlinePos;
	if (fontPtr->barHeight == 0) {
	    fontPtr->underlinePos--;
	    fontPtr->barHeight = 1;
	}
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * ReleaseFont --
 * 
 *	Called to release the unix-specific contents of a TkFont.
 *	The caller is responsible for freeing the memory used by the
 *	font itself.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is freed.
 *
 *---------------------------------------------------------------------------
 */
 
static void
ReleaseFont(fontPtr)
    UnixFont *fontPtr;		/* The font to delete. */
{
    int i;

    for (i = 0; i < fontPtr->numSubFonts; i++) {
	ReleaseSubFont(fontPtr->display, &fontPtr->subFontArray[i]);
    }
    if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
	ckfree((char *) fontPtr->subFontArray);
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * InitSubFont --
 *
 *	Wrap a screen font and load the FontFamily that represents
 *	it.  Used to prepare a SubFont so that characters can be mapped
 *	from UTF-8 to the charset of the font.
 *
 * Results:
 *	The subFontPtr is filled with information about the font.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static void
InitSubFont(display, fontStructPtr, base, subFontPtr)
    Display *display;		/* Display in which font will be used. */
    XFontStruct *fontStructPtr;	/* The screen font. */
    int base;			/* Non-zero if this SubFont is being used
				 * as the base font for a font object. */
    SubFont *subFontPtr;	/* Filled with SubFont constructed from 
    				 * above attributes. */
{
    subFontPtr->fontStructPtr = fontStructPtr;
    subFontPtr->familyPtr   = AllocFontFamily(display, fontStructPtr, base);
    subFontPtr->fontMap	    = subFontPtr->familyPtr->fontMap;
}

/*
 *-------------------------------------------------------------------------
 *
 * ReleaseSubFont --
 *
 *	Called to release the contents of a SubFont.  The caller is 
 *	responsible for freeing the memory used by the SubFont itself.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory and resources are freed.
 *
 *---------------------------------------------------------------------------
 */

static void
ReleaseSubFont(display, subFontPtr)
    Display *display;		/* Display which owns screen font. */
    SubFont *subFontPtr;	/* The SubFont to delete. */
{
    XFreeFont(display, subFontPtr->fontStructPtr);
    FreeFontFamily(subFontPtr->familyPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * AllocFontFamily --
 *
 *	Find the FontFamily structure associated with the given font
 *	name.  The information should be stored by the caller in a 
 *	SubFont and used when determining if that SubFont supports a 
 *	character.
 *
 *	Cannot use the string name used to construct the font as the 
 *	key, because the capitalization may not be canonical.  Therefore
 *	use the face name actually retrieved from the font metrics as
 *	the key.
 *
 * Results:
 *	A pointer to a FontFamily.  The reference count in the FontFamily
 *	is automatically incremented.  When the SubFont is released, the
 *	reference count is decremented.  When no SubFont is using this
 *	FontFamily, it may be deleted.
 *
 * Side effects:
 *	A new FontFamily structure will be allocated if this font family
 *	has not been seen.  TrueType character existence metrics are
 *	loaded into the FontFamily structure.
 *
 *-------------------------------------------------------------------------
 */

static FontFamily *
AllocFontFamily(display, fontStructPtr, base)
    Display *display;		/* Display in which font will be used. */
    XFontStruct *fontStructPtr;	/* Screen font whose FontFamily is to be
				 * returned. */
    int base;			/* Non-zero if this font family is to be
				 * used in the base font of a font object. */
{
    FontFamily *familyPtr;
    FontAttributes fa;
    Tcl_Encoding encoding;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    GetFontAttributes(display, fontStructPtr, &fa);
    encoding = Tcl_GetEncoding(NULL, GetEncodingAlias(fa.xa.charset));

    familyPtr = tsdPtr->fontFamilyList;
    for (; familyPtr != NULL; familyPtr = familyPtr->nextPtr) {
	if ((familyPtr->faceName == fa.fa.family)
		&& (familyPtr->foundry == fa.xa.foundry)
		&& (familyPtr->encoding == encoding)) {
	    Tcl_FreeEncoding(encoding);
	    familyPtr->refCount++;
	    return familyPtr;
	}
    }

    familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily));
    memset(familyPtr, 0, sizeof(FontFamily));
    familyPtr->nextPtr = tsdPtr->fontFamilyList;
    tsdPtr->fontFamilyList = familyPtr;

    /* 
     * Set key for this FontFamily. 
     */
     
    familyPtr->foundry = fa.xa.foundry;
    familyPtr->faceName = fa.fa.family;
    familyPtr->encoding = encoding;

    /* 
     * An initial refCount of 2 means that FontFamily information will
     * persist even when the SubFont that loaded the FontFamily is released.
     * Change it to 1 to cause FontFamilies to be unloaded when not in use.
     */

    familyPtr->refCount = 2;
    familyPtr->isTwoByteFont = (fontStructPtr->min_byte1 > 0);
    return familyPtr;
}

/*
 *-------------------------------------------------------------------------
 *
 * FreeFontFamily --
 *
 *	Called to free an FontFamily when the SubFont is finished using
 *	it. Frees the contents of the FontFamily and the memory used by
 *	the FontFamily itself.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */
 
static void
FreeFontFamily(familyPtr)
    FontFamily *familyPtr;	/* The FontFamily to delete. */
{
    FontFamily **familyPtrPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    int i;

    if (familyPtr == NULL) {
        return;
    }
    familyPtr->refCount--;
    if (familyPtr->refCount > 0) {
    	return;
    }
    Tcl_FreeEncoding(familyPtr->encoding);
    for (i = 0; i < FONTMAP_PAGES; i++) {
        if (familyPtr->fontMap[i] != NULL) {
            ckfree(familyPtr->fontMap[i]);
        }
    }
    
    /* 
     * Delete from list. 
     */
         
    for (familyPtrPtr = &tsdPtr->fontFamilyList; ; ) {
        if (*familyPtrPtr == familyPtr) {
  	    *familyPtrPtr = familyPtr->nextPtr;
	    break;
	}
	familyPtrPtr = &(*familyPtrPtr)->nextPtr;
    }
    
    ckfree((char *) familyPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * FindSubFontForChar --
 *
 *	Determine which screen font is necessary to use to 
 *	display the given character.  If the font object does not have
 *	a screen font that can display the character, another screen font
 *	may be loaded into the font object, following a set of preferred
 *	fallback rules.
 *
 * Results:
 *	The return value is the SubFont to use to display the given 
 *	character. 
 *
 * Side effects:
 *	The contents of fontPtr are modified to cache the results
 *	of the lookup and remember any SubFonts that were dynamically 
 *	loaded.
 *
 *-------------------------------------------------------------------------
 */

static SubFont *
FindSubFontForChar(fontPtr, ch)
    UnixFont *fontPtr;		/* The font object with which the character
				 * will be displayed. */
    int ch;			/* The Unicode character to be displayed. */
{
    int i, j, k, numNames;
    char *faceName, *fallback;
    char **aliases, **nameList, **anyFallbacks;
    char ***fontFallbacks;
    SubFont *subFontPtr;
    Tcl_DString ds;

    if (FontMapLookup(&fontPtr->subFontArray[0], ch)) {
	return &fontPtr->subFontArray[0];
    }

    for (i = 1; i < fontPtr->numSubFonts; i++) {
	if (FontMapLookup(&fontPtr->subFontArray[i], ch)) {
	    return &fontPtr->subFontArray[i];
	}
    }

    if (FontMapLookup(&fontPtr->controlSubFont, ch)) {
	return &fontPtr->controlSubFont;
    }

    /*
     * Keep track of all face names that we check, so we don't check some
     * name multiple times if it can be reached by multiple paths.
     */
     
    Tcl_DStringInit(&ds);

    /*
     * Are there any other fonts with the same face name as the base
     * font that could display this character, e.g., if the base font
     * is adobe:fixed:iso8859-1, we could might be able to use
     * misc:fixed:iso8859-8 or sony:fixed:jisx0208.1983-0
     */
     
    faceName = fontPtr->font.fa.family;
    if (SeenName(faceName, &ds) == 0) {
	subFontPtr = CanUseFallback(fontPtr, faceName, ch);
	if (subFontPtr != NULL) {
	    goto end;
	}
    }

    aliases = TkFontGetAliasList(faceName);

    subFontPtr = NULL;
    fontFallbacks = TkFontGetFallbacks();
    for (i = 0; fontFallbacks[i] != NULL; i++) {
	for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
	    if (strcasecmp(fallback, faceName) == 0) {
		/*
		 * If the base font has a fallback...
		 */

		goto tryfallbacks;
	    } else if (aliases != NULL) {
		/* 
		 * Or if an alias for the base font has a fallback...
		 */

		for (k = 0; aliases[k] != NULL; k++) {
		    if (strcasecmp(fallback, aliases[k]) == 0) {
			goto tryfallbacks;
		    }
		}
	    }
	}
	continue;

	tryfallbacks:

	/* 
	 * ...then see if we can use one of the fallbacks, or an
	 * alias for one of the fallbacks.
	 */

	for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
	    subFontPtr = CanUseFallbackWithAliases(fontPtr, fallback, ch, &ds);
	    if (subFontPtr != NULL) {
		goto end;
	    }
	}
    }

    /*
     * See if we can use something from the global fallback list. 
     */

    anyFallbacks = TkFontGetGlobalClass();
    for (i = 0; (fallback = anyFallbacks[i]) != NULL; i++) {
	subFontPtr = CanUseFallbackWithAliases(fontPtr, fallback, ch, &ds);
	if (subFontPtr != NULL) {
	    goto end;
	}
    }

    /*
     * Try all face names available in the whole system until we
     * find one that can be used.
     */

    nameList = ListFonts(fontPtr->display, "*", &numNames);
    for (i = 0; i < numNames; i++) {
	fallback = strchr(nameList[i] + 1, '-') + 1;
	strchr(fallback, '-')[0] = '\0';
	if (SeenName(fallback, &ds) == 0) {
	    subFontPtr = CanUseFallback(fontPtr, fallback, ch);
	    if (subFontPtr != NULL) {
		XFreeFontNames(nameList);
		goto end;
	    }
	}
    }
    XFreeFontNames(nameList);

    end:
    Tcl_DStringFree(&ds);

    if (subFontPtr == NULL) {
	/*
	 * No font can display this character, so it will be displayed as a
	 * control character expansion.
	 */

	subFontPtr = &fontPtr->controlSubFont;
	FontMapInsert(subFontPtr, ch);
    }
    return subFontPtr;
}

/*
 *-------------------------------------------------------------------------
 *
 * FontMapLookup --
 *
 *	See if the screen font can display the given character.
 *
 * Results:
 *	The return value is 0 if the screen font cannot display the
 *	character, non-zero otherwise.
 *
 * Side effects:
 *	New pages are added to the font mapping cache whenever the
 *	character belongs to a page that hasn't been seen before.
 *	When a page is loaded, information about all the characters on
 *	that page is stored, not just for the single character in
 *	question.
 *
 *-------------------------------------------------------------------------
 */

static int
FontMapLookup(subFontPtr, ch)
    SubFont *subFontPtr;	/* Contains font mapping cache to be queried
				 * and possibly updated. */
    int ch;			/* Character to be tested. */
{
    int row, bitOffset;

    row = ch >> FONTMAP_SHIFT;
    if (subFontPtr->fontMap[row] == NULL) {
	FontMapLoadPage(subFontPtr, row);
    }
    bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
    return (subFontPtr->fontMap[row][bitOffset >> 3] >> (bitOffset & 7)) & 1;
}

/*
 *-------------------------------------------------------------------------
 *
 * FontMapInsert --
 *
 *	Tell the font mapping cache that the given screen font should be
 *	used to display the specified character.  This is called when no
 *	font on the system can be be found that can display that 
 *	character; we lie to the font and tell it that it can display
 *	the character, otherwise we would end up re-searching the entire
 *	fallback hierarchy every time that character was seen.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	New pages are added to the font mapping cache whenever the
 *	character belongs to a page that hasn't been seen before.
 *	When a page is loaded, information about all the characters on
 *	that page is stored, not just for the single character in
 *	question.
 *
 *-------------------------------------------------------------------------
 */

static void
FontMapInsert(subFontPtr, ch)
    SubFont *subFontPtr;	/* Contains font mapping cache to be 
				 * updated. */
    int ch;			/* Character to be added to cache. */
{
    int row, bitOffset;

    row = ch >> FONTMAP_SHIFT;
    if (subFontPtr->fontMap[row] == NULL) {
	FontMapLoadPage(subFontPtr, row);
    }
    bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
    subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
}

/*
 *-------------------------------------------------------------------------
 *
 * FontMapLoadPage --
 *
 *	Load information about all the characters on a given page.
 *	This information consists of one bit per character that indicates
 *	whether the associated screen font can (1) or cannot (0) display
 *	the characters on the page.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Mempry allocated.
 *
 *-------------------------------------------------------------------------
 */
static void 
FontMapLoadPage(subFontPtr, row)
    SubFont *subFontPtr;	/* Contains font mapping cache to be 
				 * updated. */
    int row;			/* Index of the page to be loaded into 
				 * the cache. */
{
    char src[TCL_UTF_MAX], buf[16];
    int minHi, maxHi, minLo, maxLo, scale, checkLo;
    int i, end, bitOffset, isTwoByteFont, n;
    Tcl_Encoding encoding;
    XFontStruct *fontStructPtr;
    XCharStruct *widths;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8);
    memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8);

    if (subFontPtr->familyPtr == &tsdPtr->controlFamily) {
	return;
    }

    fontStructPtr   = subFontPtr->fontStructPtr;
    encoding	    = subFontPtr->familyPtr->encoding;
    isTwoByteFont   = subFontPtr->familyPtr->isTwoByteFont;

    widths	= fontStructPtr->per_char;
    minHi	= fontStructPtr->min_byte1;
    maxHi	= fontStructPtr->max_byte1;
    minLo	= fontStructPtr->min_char_or_byte2;
    maxLo	= fontStructPtr->max_char_or_byte2;
    scale	= maxLo - minLo + 1;
    checkLo	= minLo;

    if (! isTwoByteFont) {
	if (minLo < 32) {
	    checkLo = 32;
	}
    }

    end = (row + 1) << FONTMAP_SHIFT;
    for (i = row << FONTMAP_SHIFT; i < end; i++) {
	int hi, lo;
	
	if (Tcl_UtfToExternal(NULL, encoding, src, Tcl_UniCharToUtf(i, src),
        	TCL_ENCODING_STOPONERROR, NULL, buf, sizeof(buf), NULL, 
		NULL, NULL) != TCL_OK) {
	    continue;
	}
	if (isTwoByteFont) {
	    hi = ((unsigned char *) buf)[0];
	    lo = ((unsigned char *) buf)[1];
	} else {
	    hi = 0;
	    lo = ((unsigned char *) buf)[0];
	}
	if ((hi < minHi) || (hi > maxHi) || (lo < checkLo) || (lo > maxLo)) {
	    continue;
	}
	n = (hi - minHi) * scale + lo - minLo;
	if ((widths == NULL) || ((widths[n].width + widths[n].rbearing) != 0)) {
	    bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
	    subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
	}
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * CanUseFallbackWithAliases --
 *
 *	Helper function for FindSubFontForChar.  Determine if the
 *	specified face name (or an alias of the specified face name)
 *	can be used to construct a screen font that can display the
 *	given character.
 *
 * Results:
 *	See CanUseFallback().
 *
 * Side effects:
 *	If the name and/or one of its aliases was rejected, the
 *	rejected string is recorded in nameTriedPtr so that it won't
 *	be tried again.
 *
 *---------------------------------------------------------------------------
 */

static SubFont *
CanUseFallbackWithAliases(fontPtr, faceName, ch, nameTriedPtr)
    UnixFont *fontPtr;		/* The font object that will own the new
				 * screen font. */
    char *faceName;		/* Desired face name for new screen font. */
    int ch;			/* The Unicode character that the new
				 * screen font must be able to display. */
    Tcl_DString *nameTriedPtr;	/* Records face names that have already
				 * been tried.  It is possible for the same
				 * face name to be queried multiple times when
				 * trying to find a suitable screen font. */
{
    SubFont *subFontPtr;
    char **aliases;
    int i;
    
    if (SeenName(faceName, nameTriedPtr) == 0) {
	subFontPtr = CanUseFallback(fontPtr, faceName, ch);
	if (subFontPtr != NULL) {
	    return subFontPtr;
	}
    }
    aliases = TkFontGetAliasList(faceName);
    if (aliases != NULL) {
	for (i = 0; aliases[i] != NULL; i++) {
	    if (SeenName(aliases[i], nameTriedPtr) == 0) {
		subFontPtr = CanUseFallback(fontPtr, aliases[i], ch);
		if (subFontPtr != NULL) {
		    return subFontPtr;
		}
	    }
	}
    }
    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * SeenName --
 *
 *	Used to determine we have already tried and rejected the given
 *	face name when looking for a screen font that can support some
 *	Unicode character.
 *
 * Results:
 *	The return value is 0 if this face name has not already been seen,
 *	non-zero otherwise.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
SeenName(name, dsPtr)
    CONST char *name;		/* The name to check. */
    Tcl_DString *dsPtr;		/* Contains names that have already been
				 * seen. */
{
    CONST char *seen, *end;

    seen = Tcl_DStringValue(dsPtr);
    end = seen + Tcl_DStringLength(dsPtr);
    while (seen < end) {
	if (strcasecmp(seen, name) == 0) {
	    return 1;
	}
	seen += strlen(seen) + 1;
    }
    Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1));
    return 0;
}

/*
 *-------------------------------------------------------------------------
 *
 * CanUseFallback --
 *
 *	If the specified screen font has not already been loaded 
 *	into the font object, determine if the specified screen 
 *	font can display the given character.
 *
 * Results:
 *	The return value is a pointer to a newly allocated SubFont,
 *	owned by the font object.  This SubFont can be used to display
 *	the given character.  The SubFont represents the screen font
 *	with the base set of font attributes from the font object, but
 *	using the specified face name.  NULL is returned if the font
 *	object already holds a reference to the specified font or if
 *	the specified font doesn't exist or cannot display the given
 *	character.
 *
 * Side effects:				       
 *	The font object's subFontArray is updated to contain a reference
 *	to the newly allocated SubFont.
 *
 *-------------------------------------------------------------------------
 */

static SubFont *
CanUseFallback(fontPtr, faceName, ch)
    UnixFont *fontPtr;		/* The font object that will own the new
				 * screen font. */
    char *faceName;		/* Desired face name for new screen font. */
    int ch;			/* The Unicode character that the new
				 * screen font must be able to display. */
{
    int i, nameIdx, numNames, srcLen;
    Tk_Uid hateFoundry;
    int bestIdx[2];
    CONST char *charset, *hateCharset;
    unsigned int bestScore[2];
    char **nameList, **nameListOrig;
    FontAttributes want, got;
    char src[TCL_UTF_MAX];
    Display *display;
    SubFont subFont;
    XFontStruct *fontStructPtr;
    Tcl_DString dsEncodings;
    int numEncodings;
    Tcl_Encoding *encodingCachePtr;

    /*
     * Assume: the face name is times.
     * Assume: adobe:times:iso8859-1 has already been used.
     *
     * Are there any versions of times that can display this
     *    character (e.g., perhaps linotype:times:iso8859-2)?
     *	  a. Get list of all times fonts.
     *	  b1. Cross out all names whose encodings we've already used.
     *	  b2. Cross out all names whose foundry & encoding we've already seen.
     *	  c. Cross out all names whose encoding cannot handle the character.
     *	  d. Rank each name and pick the best match.
     *	  e. If that font cannot actually display the character, cross
     *	     out all names with the same foundry and encoding and go
     *	     back to (c).
     */

    display = fontPtr->display;
    nameList = ListFonts(display, faceName, &numNames);
    if (numNames == 0) {
	return NULL;
    }
    nameListOrig = nameList;

    srcLen = Tcl_UniCharToUtf(ch, src);

    want.fa = fontPtr->font.fa;
    want.xa = fontPtr->xa;

    want.fa.family = Tk_GetUid(faceName);
    want.fa.size = -fontPtr->pixelSize;

    hateFoundry = NULL;
    hateCharset = NULL;
    numEncodings = 0;
    Tcl_DStringInit(&dsEncodings);

    charset = NULL;	/* lint, since numNames must be > 0 to get here. */

    retry:
    bestIdx[0] = -1;
    bestIdx[1] = -1;
    bestScore[0] = (unsigned int) -1;
    bestScore[1] = (unsigned int) -1;
    for (nameIdx = 0; nameIdx < numNames; nameIdx++) {
	Tcl_Encoding encoding;
	char dst[16];
	int scalable, srcRead, dstWrote;
	unsigned int score;
	
	if (nameList[nameIdx] == NULL) {
	    continue;
	}
	if (TkFontParseXLFD(nameList[nameIdx], &got.fa, &got.xa) != TCL_OK) {
	    goto crossout;
	}
	IdentifySymbolEncodings(&got);
	charset = GetEncodingAlias(got.xa.charset);
	if (hateFoundry != NULL) {
	    /*
	     * E. If the font we picked cannot actually display the
	     * character, cross out all names with the same foundry and
	     * encoding. 
	     */

	    if ((hateFoundry == got.xa.foundry)
		    && (strcmp(hateCharset, charset) == 0)) {
		goto crossout;
	    }
	} else {
	    /*
	     * B. Cross out all names whose encodings we've already used.
	     */
	     
	    for (i = 0; i < fontPtr->numSubFonts; i++) {
		encoding = fontPtr->subFontArray[i].familyPtr->encoding;
		if (strcmp(charset, Tcl_GetEncodingName(encoding)) == 0) {
		    goto crossout;
		}
	    }
	}
	
	/*
	 * C. Cross out all names whose encoding cannot handle the character.
	 */
	 
	encodingCachePtr = (Tcl_Encoding *) Tcl_DStringValue(&dsEncodings);
	for (i = numEncodings; --i >= 0; encodingCachePtr++) {
	    encoding = *encodingCachePtr;
	    if (strcmp(Tcl_GetEncodingName(encoding), charset) == 0) {
		break;
	    }
	}
	if (i < 0) {
	    encoding = Tcl_GetEncoding(NULL, charset);
	    if (encoding == NULL) {
		goto crossout;
	    }

	    Tcl_DStringAppend(&dsEncodings, (char *) &encoding,
		    sizeof(encoding));
	    numEncodings++;
	}
	Tcl_UtfToExternal(NULL, encoding, src, srcLen, 
		TCL_ENCODING_STOPONERROR, NULL, dst, sizeof(dst), &srcRead, 
		&dstWrote, NULL);
	if (dstWrote == 0) {
	    goto crossout;
	}

	/*
	 * D. Rank each name and pick the best match.
	 */

	scalable = (got.fa.size == 0);
	score = RankAttributes(&want, &got);
	if (score <= bestScore[scalable]) {
	    bestIdx[scalable] = nameIdx;
	    bestScore[scalable] = score;
	}
	if (score == 0) {
	    break;
	}
	continue;

	crossout:
	if (nameList == nameListOrig) {
	    /*
	     * Not allowed to change pointers to memory that X gives you,
	     * so make a copy.
	     */

	    nameList = (char **) ckalloc(numNames * sizeof(char *));
	    memcpy(nameList, nameListOrig, numNames * sizeof(char *));
	}
	nameList[nameIdx] = NULL;
    }

    fontStructPtr = GetScreenFont(display, &want, nameList, bestIdx, bestScore);

    encodingCachePtr = (Tcl_Encoding *) Tcl_DStringValue(&dsEncodings);
    for (i = numEncodings; --i >= 0; encodingCachePtr++) {
	Tcl_FreeEncoding(*encodingCachePtr);
    }
    Tcl_DStringFree(&dsEncodings);
    numEncodings = 0;

    if (fontStructPtr == NULL) {
	if (nameList != nameListOrig) {
	    ckfree((char *) nameList);
	}
	XFreeFontNames(nameListOrig);
	return NULL;
    }

    InitSubFont(display, fontStructPtr, 0, &subFont);
    if (FontMapLookup(&subFont, ch) == 0) {
	/*
	 * E. If the font we picked cannot actually display the character,
	 * cross out all names with the same foundry and encoding and pick
	 * another font.
	 */

	hateFoundry = got.xa.foundry;
	hateCharset = charset;
	ReleaseSubFont(display, &subFont);
	goto retry;
    }
    if (nameList != nameListOrig) {
	ckfree((char *) nameList);
    }
    XFreeFontNames(nameListOrig);

    if (fontPtr->numSubFonts >= SUBFONT_SPACE) {
	SubFont *newPtr;
	
	newPtr = (SubFont *) ckalloc(sizeof(SubFont) * (fontPtr->numSubFonts + 1));
	memcpy((char *) newPtr, fontPtr->subFontArray,
		fontPtr->numSubFonts * sizeof(SubFont));
	if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
	    ckfree((char *) fontPtr->subFontArray);
	}
	fontPtr->subFontArray = newPtr;
    }
    fontPtr->subFontArray[fontPtr->numSubFonts] = subFont;
    fontPtr->numSubFonts++;
    return &fontPtr->subFontArray[fontPtr->numSubFonts - 1];
}

/*
 *---------------------------------------------------------------------------
 *
 * RankAttributes --
 *
 *	Determine how close the attributes of the font in question match
 *	the attributes that we want.
 *
 * Results:
 *	The return value is the score; lower numbers are better.
 *	*scalablePtr is set to 0 if the font was not scalable, 1 otherwise.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static unsigned int
RankAttributes(wantPtr, gotPtr)
    FontAttributes *wantPtr;	/* The desired attributes. */
    FontAttributes *gotPtr;	/* The attributes we have to live with. */
{
    unsigned int penalty;

    penalty = 0;
    if (gotPtr->xa.foundry != wantPtr->xa.foundry) {
	penalty += 4500;
    }
    if (gotPtr->fa.family != wantPtr->fa.family) {
	penalty += 9000;
    }
    if (gotPtr->fa.weight != wantPtr->fa.weight) {
	penalty += 90;
    }
    if (gotPtr->fa.slant != wantPtr->fa.slant) {
	penalty += 60;
    }
    if (gotPtr->xa.slant != wantPtr->xa.slant) {
	penalty += 10;
    }
    if (gotPtr->xa.setwidth != wantPtr->xa.setwidth) {
	penalty += 1000;
    }

    if (gotPtr->fa.size == 0) {
	/*
	 * A scalable font is almost always acceptable, but the
	 * corresponding bitmapped font would be better.
	 */

	penalty += 10;
    } else {
	int diff;

	/*
	 * It's worse to be too large than to be too small.
	 */
	 
	diff = (-gotPtr->fa.size - -wantPtr->fa.size);
	if (diff > 0) {
	    penalty += 600;
	} else if (diff < 0) {
	    penalty += 150;
	    diff = -diff;
	}
	penalty += 150 * diff;
    }
    if (gotPtr->xa.charset != wantPtr->xa.charset) {
	int i;
	CONST char *gotAlias, *wantAlias;

	penalty += 65000;
	gotAlias = GetEncodingAlias(gotPtr->xa.charset);
	wantAlias = GetEncodingAlias(wantPtr->xa.charset); 
	if (strcmp(gotAlias, wantAlias) != 0) {
	    penalty += 30000;
	    for (i = 0; encodingList[i] != NULL; i++) {
		if (strcmp(gotAlias, encodingList[i]) == 0) {
		    penalty -= 30000;
		    break;
		}
		penalty += 20000;
	    }
	}
    }
    return penalty;
}

/*
 *---------------------------------------------------------------------------
 *
 * GetScreenFont --
 *
 *	Given the names for the best scalable and best bitmapped font,
 *	actually construct an XFontStruct based on the best XLFD.
 *	This is where all the alias and fallback substitution bottoms
 *	out.
 *
 * Results:
 *	The screen font that best corresponds to the set of attributes.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static XFontStruct *
GetScreenFont(display, wantPtr, nameList, bestIdx, bestScore)
    Display *display;		/* Display for new XFontStruct. */
    FontAttributes *wantPtr;	/* Contains desired actual pixel-size if the
				 * best font was scalable. */
    char **nameList;		/* Array of XLFDs. */
    int bestIdx[2];		/* Indices into above array for XLFD of
				 * best bitmapped and best scalable font. */
    unsigned int bestScore[2];	/* Scores of best bitmapped and best
				 * scalable font.  XLFD corresponding to
				 * lowest score will be constructed. */
{
    XFontStruct *fontStructPtr;

    if ((bestIdx[0] < 0) && (bestIdx[1] < 0)) {
	return NULL;
    }

    /*
     * Now we know which is the closest matching scalable font and the
     * closest matching bitmapped font.  If the scalable font was a
     * better match, try getting the scalable font; however, if the
     * scalable font was not actually available in the desired
     * pointsize, fall back to the closest bitmapped font.
     */

    fontStructPtr = NULL;
    if (bestScore[1] < bestScore[0]) {
	char *str, *rest;
	char buf[256];
	int i;
	
	/*
	 * Fill in the desired pixel size for this font.
	 */

	tryscale:
	str = nameList[bestIdx[1]];
	for (i = 0; i < XLFD_PIXEL_SIZE; i++) {
	    str = strchr(str + 1, '-');
	}
	rest = str;
	for (i = XLFD_PIXEL_SIZE; i < XLFD_CHARSET; i++) {
	    rest = strchr(rest + 1, '-');
	}
	*str = '\0';
	sprintf(buf, "%.200s-%d-*-*-*-*-*%s", nameList[bestIdx[1]],
		-wantPtr->fa.size, rest);
	*str = '-';
	fontStructPtr = XLoadQueryFont(display, buf);
	bestScore[1] = INT_MAX;
    }
    if (fontStructPtr == NULL) {
	fontStructPtr = XLoadQueryFont(display, nameList[bestIdx[0]]);
	if (fontStructPtr == NULL) {
	    /*
	     * This shouldn't happen because the font name is one of the
	     * names that X gave us to use, but it does anyhow.
	     */

	    if (bestScore[1] < INT_MAX) {
		goto tryscale;
	    }
	    return GetSystemFont(display);
	}
    }
    return fontStructPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * GetSystemFont --
 *
 *	Absolute fallback mechanism, called when we need a font and no
 *	other font can be found and/or instantiated.
 *
 * Results:
 *	A pointer to a font.  Never NULL.
 *
 * Side effects:
 *	If there are NO fonts installed on the system, this call will
 *	panic, but how did you get X running in that case?
 *
 *---------------------------------------------------------------------------
 */

static XFontStruct *
GetSystemFont(display)
    Display *display;		/* Display for new XFontStruct. */
{
    XFontStruct *fontStructPtr;

    fontStructPtr = XLoadQueryFont(display, "fixed");
    if (fontStructPtr == NULL) {
	fontStructPtr = XLoadQueryFont(display, "*");
	if (fontStructPtr == NULL) {
	    panic("TkpGetFontFromAttributes: cannot get any font");
	}
    }
    return fontStructPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * GetFontAttributes --
 *
 *	Given a screen font, determine its actual attributes, which are
 *	not necessarily the attributes that were used to construct it.
 *
 * Results:
 *	*faPtr is filled with the screen font's attributes.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
GetFontAttributes(display, fontStructPtr, faPtr)
    Display *display;		/* Display that owns the screen font. */
    XFontStruct *fontStructPtr;	/* Screen font to query. */
    FontAttributes *faPtr;	/* For storing attributes of screen font. */
{
    unsigned long value;
    char *p, *name;
    
    if ((XGetFontProperty(fontStructPtr, XA_FONT, &value) != False) &&
	    (value != 0)) {
	name = XGetAtomName(display, (Atom) value);
	for (p = name; *p != '\0'; p++) {
	    if (isupper(UCHAR(*p))) { /* INTL: native text */
		*p = tolower(UCHAR(*p)); /* INTL: native text */
	    }
	}
	if (TkFontParseXLFD(name, &faPtr->fa, &faPtr->xa) != TCL_OK) {
	    faPtr->fa.family = Tk_GetUid(name);
	    faPtr->xa.foundry = Tk_GetUid("");
	    faPtr->xa.charset = Tk_GetUid("");
	}
	XFree(name);
    } else {
	TkInitFontAttributes(&faPtr->fa);
	TkInitXLFDAttributes(&faPtr->xa);
	faPtr->fa.family = Tk_GetUid("");
	faPtr->xa.foundry = Tk_GetUid("");
	faPtr->xa.charset = Tk_GetUid("");
    }
    return IdentifySymbolEncodings(faPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * ListFonts --
 *
 *	Utility function to return the array of all XLFDs on the system
 *	with the specified face name.
 *
 * Results:
 *	The return value is an array of XLFDs, which should be freed with
 *	XFreeFontNames(), or NULL if no XLFDs matched the requested name.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
 
static char **
ListFonts(display, faceName, numNamesPtr)
    Display *display;		/* Display to query. */
    CONST char *faceName;	/* Desired face name, or "*" for all. */
    int *numNamesPtr;		/* Filled with length of returned array, or
				 * 0 if no names were found. */
{
    char buf[256];

    sprintf(buf, "-*-%.80s-*-*-*-*-*-*-*-*-*-*-*-*", faceName);
    return XListFonts(display, buf, 10000, numNamesPtr);
}

static char **
ListFontOrAlias(display, faceName, numNamesPtr)
    Display *display;		/* Display to query. */
    CONST char *faceName;	/* Desired face name, or "*" for all. */
    int *numNamesPtr;		/* Filled with length of returned array, or
				 * 0 if no names were found. */
{
    char **nameList, **aliases;
    int i;
    
    nameList = ListFonts(display, faceName, numNamesPtr);
    if (nameList != NULL) {
	return nameList;
    }
    aliases = TkFontGetAliasList(faceName);
    if (aliases != NULL) {
	for (i = 0; aliases[i] != NULL; i++) {
	    nameList = ListFonts(display, aliases[i], numNamesPtr);
	    if (nameList != NULL) {
		return nameList;
	    }
	}
    }
    *numNamesPtr = 0;
    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * IdentifySymbolEncodings --
 *
 *	If the font attributes refer to a symbol font, update the
 *	charset field of the font attributes so that it reflects the
 *	encoding of that symbol font.  In general, the raw value for
 *	the charset field parsed from an XLFD is meaningless for symbol
 *	fonts.
 *
 *	Symbol fonts are all fonts whose name appears in the symbolClass.
 *
 * Results:
 *	The return value is non-zero if the font attributes specify a
 *	symbol font, or 0 otherwise.  If a non-zero value is returned
 *	the charset field of the font attributes will be changed to
 *	the string that represents the actual encoding for the symbol font.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
IdentifySymbolEncodings(faPtr)
    FontAttributes *faPtr;


{
    int i, j;
    char **aliases, **symbolClass;

    symbolClass = TkFontGetSymbolClass();
    for (i = 0; symbolClass[i] != NULL; i++) {
	if (strcasecmp(faPtr->fa.family, symbolClass[i]) == 0) {
	    faPtr->xa.charset = Tk_GetUid(GetEncodingAlias(symbolClass[i]));
	    return 1;
	}
	aliases = TkFontGetAliasList(symbolClass[i]);
	for (j = 0; (aliases != NULL) && (aliases[j] != NULL); j++) {
	    if (strcasecmp(faPtr->fa.family, aliases[j]) == 0) {
		faPtr->xa.charset = Tk_GetUid(GetEncodingAlias(aliases[j]));
		return 1;
	    }
	}
    }
    return 0;
}

/*
 *---------------------------------------------------------------------------
 *
 * GetEncodingAlias --
 *
 *	Map the name of an encoding to another name that should be used
 *	when actually loading the encoding.  For instance, the encodings
 *	"jisc6226.1978", "jisx0208.1983", "jisx0208.1990", and
 *	"jisx0208.1996" are well-known names for the same encoding and
 *	are represented by one encoding table: "jis0208".
 *
 * Results:
 *	As above.  If the name has no alias, the original name is returned.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static CONST char *
GetEncodingAlias(name)
    CONST char *name;		/* The name to look up. */
{
    EncodingAlias *aliasPtr;
    
    for (aliasPtr = encodingAliases; aliasPtr->aliasPattern != NULL; ) {
	if (Tcl_StringMatch((char *) name, aliasPtr->aliasPattern)) {
	    return aliasPtr->realName;
	}
	aliasPtr++;
    }
    return name;
}


Changes to unix/tkUnixInit.c.

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
/* 
 * tkUnixInit.c --
 *
 *	This file contains Unix-specific interpreter initialization
 *	functions.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixInit.c 1.24 97/07/24 14:46:09
 */

#include "tkInt.h"
#include "tkUnixInt.h"

/*
 * The Init script (common to Windows and Unix platforms) is
 * defined in tkInitScript.h
 */
#include "tkInitScript.h"


/*
 * Default directory in which to look for libraries:
 */

static char defaultLibraryDir[200] = TK_LIBRARY;


/*
 *----------------------------------------------------------------------
 *
 * TkpInit --
 *
 *	Performs Unix-specific interpreter initialization related to the
 *      tk_library variable.
 *
 * Results:
 *	Returns a standard Tcl result.  Leaves an error message or result
 *	in interp->result.
 *
 * Side effects:
 *	Sets "tk_library" Tcl variable, runs "tk.tcl" script.
 *
 *----------------------------------------------------------------------
 */

int
TkpInit(interp)
    Tcl_Interp *interp;
{
    char *libDir;

    libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY);
    if (libDir == NULL) {
	Tcl_SetVar(interp, "tk_library", defaultLibraryDir, TCL_GLOBAL_ONLY);
    }
    TkCreateXEventSource();
    return Tcl_Eval(interp, initScript);
}

/*
 *----------------------------------------------------------------------
 *











|











<
<
<
<
<
<
<











|











<
<
<
<
<
<







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
/* 
 * tkUnixInit.c --
 *
 *	This file contains Unix-specific interpreter initialization
 *	functions.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixInit.c,v 1.1.4.2 1998/09/30 02:19:18 stanton Exp $
 */

#include "tkInt.h"
#include "tkUnixInt.h"

/*
 * The Init script (common to Windows and Unix platforms) is
 * defined in tkInitScript.h
 */
#include "tkInitScript.h"









/*
 *----------------------------------------------------------------------
 *
 * TkpInit --
 *
 *	Performs Unix-specific interpreter initialization related to the
 *      tk_library variable.
 *
 * Results:
 *	Returns a standard Tcl result.  Leaves an error message or result
 *	in the interp's result.
 *
 * Side effects:
 *	Sets "tk_library" Tcl variable, runs "tk.tcl" script.
 *
 *----------------------------------------------------------------------
 */

int
TkpInit(interp)
    Tcl_Interp *interp;
{






    TkCreateXEventSource();
    return Tcl_Eval(interp, initScript);
}

/*
 *----------------------------------------------------------------------
 *
118
119
120
121
122
123
124
125
126
127
128
129
130
void
TkpDisplayWarning(msg, title)
    char *msg;			/* Message to be displayed. */
    char *title;		/* Title of warning. */
{
    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
    if (errChannel) {
	Tcl_Write(errChannel, title, -1);
	Tcl_Write(errChannel, ": ", 2);
	Tcl_Write(errChannel, msg, -1);
	Tcl_Write(errChannel, "\n", 1);
    }
}







|
|
|
|


105
106
107
108
109
110
111
112
113
114
115
116
117
void
TkpDisplayWarning(msg, title)
    char *msg;			/* Message to be displayed. */
    char *title;		/* Title of warning. */
{
    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
    if (errChannel) {
	Tcl_WriteChars(errChannel, title, -1);
	Tcl_WriteChars(errChannel, ": ", 2);
	Tcl_WriteChars(errChannel, msg, -1);
	Tcl_WriteChars(errChannel, "\n", 1);
    }
}

Changes to unix/tkUnixInt.h.

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
/*
 * tkUnixInt.h --
 *
 *	This file contains declarations that are shared among the
 *	UNIX-specific parts of Tk but aren't used by the rest of
 *	Tk.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixInt.h 1.9 97/05/08 11:20:12
 */

#ifndef _TKUNIXINT
#define _TKUNIXINT





/*
 * Prototypes for procedures that are referenced in files other
 * than the ones they're defined in.
 */

EXTERN void		TkCreateXEventSource _ANSI_ARGS_((void));
EXTERN TkWindow *	TkpGetContainer _ANSI_ARGS_((TkWindow *embeddedPtr));
EXTERN TkWindow *	TkpGetWrapperWindow _ANSI_ARGS_((TkWindow *winPtr));
EXTERN Window		TkUnixContainerId _ANSI_ARGS_((TkWindow *winPtr));
EXTERN int		TkUnixDoOneXEvent _ANSI_ARGS_((Tcl_Time *timePtr));
EXTERN void		TkUnixSetMenubar _ANSI_ARGS_((Tk_Window tkwin,
				Tk_Window menubar));

#endif /* _TKUNIXINT */












|





>
>
>
>




|
<
<
<
<
<
<
<


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
/*
 * tkUnixInt.h --
 *
 *	This file contains declarations that are shared among the
 *	UNIX-specific parts of Tk but aren't used by the rest of
 *	Tk.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixInt.h,v 1.1.4.3 1999/03/10 07:13:51 stanton Exp $
 */

#ifndef _TKUNIXINT
#define _TKUNIXINT

#ifndef _TKINT
#include "tkInt.h"
#endif

/*
 * Prototypes for procedures that are referenced in files other
 * than the ones they're defined in.
 */
#include "tkIntPlatDecls.h"








#endif /* _TKUNIXINT */

Added unix/tkUnixKey.c.





















































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
/* 
 * tkUnixKey.c --
 *
 *	This file contains routines for dealing with international keyboard
 *	input.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixKey.c,v 1.1.2.2 1998/09/30 02:19:19 stanton Exp $
 */

#include "tkInt.h"


/*
 *----------------------------------------------------------------------
 *
 * TkpGetString --
 *
 *	Retrieve the UTF string associated with a keyboard event.
 *
 * Results:
 *	Returns the UTF string.
 *
 * Side effects:
 *	Stores the input string in the specified Tcl_DString.  Modifies
 *	the internal input state.  This routine can only be called
 *	once for a given event.
 *
 *----------------------------------------------------------------------
 */

char *
TkpGetString(winPtr, eventPtr, dsPtr)
    TkWindow *winPtr;		/* Window where event occurred:  needed to
				 * get input context. */
    XEvent *eventPtr;		/* X keyboard event. */
    Tcl_DString *dsPtr;		/* Uninitialized or empty string to hold
				 * result. */
{
    int len;
    Tcl_DString buf;
    Status status;

    /*
     * Overallocate the dstring to the maximum stack amount.
     */

    Tcl_DStringInit(&buf);
    Tcl_DStringSetLength(&buf, TCL_DSTRING_STATIC_SIZE-1);
    
#ifdef TK_USE_INPUT_METHODS
    if ((winPtr->inputContext != NULL)
	    && (eventPtr->type == KeyPress)) {
	len = XmbLookupString(winPtr->inputContext, &eventPtr->xkey,
		Tcl_DStringValue(&buf), Tcl_DStringLength(&buf),
		(KeySym *) NULL, &status);
	/*
	 * If the buffer wasn't big enough, grow the buffer and try again.
	 */

	if (status == XBufferOverflow) {
	    Tcl_DStringSetLength(&buf, len);
	    len = XmbLookupString(winPtr->inputContext, &eventPtr->xkey,
		    Tcl_DStringValue(&buf), len, (KeySym *) NULL, &status);
	}
	if ((status != XLookupChars)
		&& (status != XLookupBoth)) {
	    len = 0;
	}
    } else {
	len = XLookupString(&eventPtr->xkey, Tcl_DStringValue(&buf),
		Tcl_DStringLength(&buf), (KeySym *) NULL,
		(XComposeStatus *) NULL);
    }
#else /* TK_USE_INPUT_METHODS */
    len = XLookupString(&eventPtr->xkey, Tcl_DStringValue(&buf),
	    Tcl_DStringLength(&buf), (KeySym *) NULL,
	    (XComposeStatus *) NULL);
#endif /* TK_USE_INPUT_METHODS */
    Tcl_DStringSetLength(&buf, len);

    Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buf), len, dsPtr);
    Tcl_DStringFree(&buf);

    return Tcl_DStringValue(dsPtr);
}

Changes to unix/tkUnixMenu.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkUnixMenu.c --
 *
 *	This module implements the UNIX platform-specific features of menus.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixMenu.c 1.76 97/11/05 09:08:22
 */

#include "tkPort.h"
#include "default.h"
#include "tkInt.h"
#include "tkUnixInt.h"
#include "tkMenu.h"





|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkUnixMenu.c --
 *
 *	This module implements the UNIX platform-specific features of menus.
 *
 * Copyright (c) 1996-1998 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixMenu.c,v 1.1.4.7 1999/03/30 04:13:00 stanton Exp $
 */

#include "tkPort.h"
#include "default.h"
#include "tkInt.h"
#include "tkUnixInt.h"
#include "tkMenu.h"
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
 * TkpConfigureMenuEntry --
 *
 *	Processes configuration options for menu entries. Called when
 *	the generic options are processed for the menu.
 *
 * Results:
 *	Returns standard TCL result. If TCL_ERROR is returned, then
 *	interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information get set for mePtr; old resources
 *	get freed, if any need it.
 *
 *----------------------------------------------------------------------
 */

int
TkpConfigureMenuEntry(mePtr)
    register TkMenuEntry *mePtr;	/* Information about menu entry;  may
					 * or may not already have values for
					 * some fields. */
{
    /*
     * If this is a cascade menu, and the child menu exists, check to
     * see if the child menu is a help menu.
     */

    if ((mePtr->type == CASCADE_ENTRY) && (mePtr->name != NULL)) {
	TkMenuReferences *menuRefPtr;

	menuRefPtr = TkFindMenuReferences(mePtr->menuPtr->interp,
		mePtr->name);
	if ((menuRefPtr != NULL) && (menuRefPtr->menuPtr != NULL)) {
	    SetHelpMenu(menuRefPtr->menuPtr);
	}
    }
    return TCL_OK;
}








|



















|


|
|







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
 * TkpConfigureMenuEntry --
 *
 *	Processes configuration options for menu entries. Called when
 *	the generic options are processed for the menu.
 *
 * Results:
 *	Returns standard TCL result. If TCL_ERROR is returned, then
 *	the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information get set for mePtr; old resources
 *	get freed, if any need it.
 *
 *----------------------------------------------------------------------
 */

int
TkpConfigureMenuEntry(mePtr)
    register TkMenuEntry *mePtr;	/* Information about menu entry;  may
					 * or may not already have values for
					 * some fields. */
{
    /*
     * If this is a cascade menu, and the child menu exists, check to
     * see if the child menu is a help menu.
     */

    if ((mePtr->type == CASCADE_ENTRY) && (mePtr->namePtr != NULL)) {
	TkMenuReferences *menuRefPtr;

	menuRefPtr = TkFindMenuReferencesObj(mePtr->menuPtr->interp,
		mePtr->namePtr);
	if ((menuRefPtr != NULL) && (menuRefPtr->menuPtr != NULL)) {
	    SetHelpMenu(menuRefPtr->menuPtr);
	}
    }
    return TCL_OK;
}

317
318
319
320
321
322
323
324
325
326

327
328
329
330
331
332

333
334
335

336
337
338
339
340
341
342
343
344
345
346
347




348



349





350
351
352
353
354
355
356
    TkMenu *menuPtr;			/* The menu we are drawing. */
    TkMenuEntry *mePtr;			/* The entry we are interested in. */
    Tk_Font tkfont;			/* The precalculated font */
    CONST Tk_FontMetrics *fmPtr;	/* The precalculated metrics */
    int *widthPtr;			/* The resulting width */
    int *heightPtr;			/* The resulting height */
{
    if (!mePtr->hideMargin && mePtr->indicatorOn &&
	    ((mePtr->type == CHECK_BUTTON_ENTRY)
	    || (mePtr->type == RADIO_BUTTON_ENTRY))) {

        if ((mePtr->image != NULL) || (mePtr->bitmap != None)) {
            *widthPtr = (14 * mePtr->height) / 10;
            *heightPtr = mePtr->height;
            if (mePtr->type == CHECK_BUTTON_ENTRY) {
    		mePtr->platformEntryData = 
			(TkMenuPlatformEntryData) ((65 * mePtr->height) / 100);

	    } else {
    	    	mePtr->platformEntryData = 
			(TkMenuPlatformEntryData) ((75 * mePtr->height) / 100);

    	    }	            
        } else {
            *widthPtr = *heightPtr = mePtr->height;
	    if (mePtr->type == CHECK_BUTTON_ENTRY) {
		mePtr->platformEntryData = (TkMenuPlatformEntryData)
			((80 * mePtr->height) / 100);
	    } else {
		mePtr->platformEntryData = (TkMenuPlatformEntryData)
			mePtr->height;
	    }
	}
    } else {




        *heightPtr = 0;



        *widthPtr = menuPtr->borderWidth;





    }
}


/*
 *----------------------------------------------------------------------
 *







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

|
|

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







317
318
319
320
321
322
323

324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
    TkMenu *menuPtr;			/* The menu we are drawing. */
    TkMenuEntry *mePtr;			/* The entry we are interested in. */
    Tk_Font tkfont;			/* The precalculated font */
    CONST Tk_FontMetrics *fmPtr;	/* The precalculated metrics */
    int *widthPtr;			/* The resulting width */
    int *heightPtr;			/* The resulting height */
{

    if ((mePtr->type == CHECK_BUTTON_ENTRY)
	    || (mePtr->type == RADIO_BUTTON_ENTRY)) {
	if (!mePtr->hideMargin && mePtr->indicatorOn) {
	    if ((mePtr->image != NULL) || (mePtr->bitmapPtr != NULL)) {
		*widthPtr = (14 * mePtr->height) / 10;
		*heightPtr = mePtr->height;
		if (mePtr->type == CHECK_BUTTON_ENTRY) {
		    mePtr->platformEntryData = 
			    (TkMenuPlatformEntryData) ((65 * mePtr->height)
			    / 100);
		} else {
		    mePtr->platformEntryData = 
			    (TkMenuPlatformEntryData) ((75 * mePtr->height)
			    / 100);
		}	            
	    } else {
		*widthPtr = *heightPtr = mePtr->height;
		if (mePtr->type == CHECK_BUTTON_ENTRY) {
		    mePtr->platformEntryData = (TkMenuPlatformEntryData)
			((80 * mePtr->height) / 100);
		} else {
		    mePtr->platformEntryData = (TkMenuPlatformEntryData)
			mePtr->height;
		}
	    }
	} else {
	    int borderWidth;

	    Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
		    menuPtr->borderWidthPtr, &borderWidth);
	    *heightPtr = 0;
	    *widthPtr = borderWidth;
	}
    } else {
	int borderWidth;

	Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
		&borderWidth);
        *heightPtr = 0;
        *widthPtr = borderWidth;
    }
}


/*
 *----------------------------------------------------------------------
 *
375
376
377
378
379
380
381
382



383
384
385
386
387
388
389
390
    CONST Tk_FontMetrics *fmPtr;/* The precalculated font metrics */
    int *widthPtr;		/* The width of the acclerator area */
    int *heightPtr;		/* The height of the accelerator area */
{
    *heightPtr = fmPtr->linespace;
    if (mePtr->type == CASCADE_ENTRY) {
    	*widthPtr = 2 * CASCADE_ARROW_WIDTH;
    } else if ((menuPtr->menuType != MENUBAR) && (mePtr->accel != NULL)) {



    	*widthPtr = Tk_TextWidth(tkfont, mePtr->accel, mePtr->accelLength);
    } else {
    	*widthPtr = 0;
    }
}

/*
 *----------------------------------------------------------------------







|
>
>
>
|







389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
    CONST Tk_FontMetrics *fmPtr;/* The precalculated font metrics */
    int *widthPtr;		/* The width of the acclerator area */
    int *heightPtr;		/* The height of the accelerator area */
{
    *heightPtr = fmPtr->linespace;
    if (mePtr->type == CASCADE_ENTRY) {
    	*widthPtr = 2 * CASCADE_ARROW_WIDTH;
    } else if ((menuPtr->menuType != MENUBAR)
	    && (mePtr->accelPtr != NULL)) {
	char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
	
    	*widthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength);
    } else {
    	*widthPtr = 0;
    }
}

/*
 *----------------------------------------------------------------------
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
    Tk_3DBorder activeBorder;	/* The border for an active item */
    Tk_3DBorder bgBorder;	/* The background border */
    int x;			/* Left coordinate of entry rect */
    int y;			/* Right coordinate of entry rect */
    int width;			/* Width of entry rect */
    int height;			/* Height of entry rect */
{
    if (mePtr->state == tkActiveUid) {
	int relief;


    	bgBorder = activeBorder;

	if ((menuPtr->menuType == MENUBAR)
		&& ((menuPtr->postedCascade == NULL)
		|| (menuPtr->postedCascade != mePtr))) {
	    relief = TK_RELIEF_FLAT;
	} else {
	    relief = TK_RELIEF_RAISED;
	}
	


	Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height,
		menuPtr->activeBorderWidth, relief);
    } else {
	Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height,
		0, TK_RELIEF_FLAT);
    }
}

/*







|

>
>









|
>
>

|







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
    Tk_3DBorder activeBorder;	/* The border for an active item */
    Tk_3DBorder bgBorder;	/* The background border */
    int x;			/* Left coordinate of entry rect */
    int y;			/* Right coordinate of entry rect */
    int width;			/* Width of entry rect */
    int height;			/* Height of entry rect */
{
    if (mePtr->state == ENTRY_ACTIVE) {
	int relief;
	int activeBorderWidth;

    	bgBorder = activeBorder;

	if ((menuPtr->menuType == MENUBAR)
		&& ((menuPtr->postedCascade == NULL)
		|| (menuPtr->postedCascade != mePtr))) {
	    relief = TK_RELIEF_FLAT;
	} else {
	    relief = TK_RELIEF_RAISED;
	}

	Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
		menuPtr->activeBorderWidthPtr, &activeBorderWidth);
	Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height,
		activeBorderWidth, relief);
    } else {
	Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height,
		0, TK_RELIEF_FLAT);
    }
}

/*
466
467
468
469
470
471
472

473
474
475
476
477
478
479
480
481




482
483
484
485
486
487
488
489
490
491
492
493
494

495
496

497
498
499
500
501
502
503
504
505
506
507
    int x;				/* Left coordinate of entry rect */
    int y;				/* Top coordinate of entry rect */
    int width;				/* Width of entry */
    int height;				/* Height of entry */
    int drawArrow;			/* Whether or not to draw arrow. */
{
    XPoint points[3];

    
    /*
     * Draw accelerator or cascade arrow.
     */

    if (menuPtr->menuType == MENUBAR) {
	return;
    }





    if ((mePtr->type == CASCADE_ENTRY) && drawArrow) {
    	points[0].x = x + width - menuPtr->borderWidth
	        - menuPtr->activeBorderWidth - CASCADE_ARROW_WIDTH;
    	points[0].y = y + (height - CASCADE_ARROW_HEIGHT)/2;
    	points[1].x = points[0].x;
    	points[1].y = points[0].y + CASCADE_ARROW_HEIGHT;
    	points[2].x = points[0].x + CASCADE_ARROW_WIDTH;
    	points[2].y = points[0].y + CASCADE_ARROW_HEIGHT/2;
    	Tk_Fill3DPolygon(menuPtr->tkwin, d, activeBorder, points, 3,
		DECORATION_BORDER_WIDTH,
	    	(menuPtr->postedCascade == mePtr)
	    	? TK_RELIEF_SUNKEN : TK_RELIEF_RAISED);
    } else if (mePtr->accel != NULL) {

	int left = x + mePtr->labelWidth + menuPtr->activeBorderWidth
	        + mePtr->indicatorSpace;

	if (menuPtr->menuType == MENUBAR) {
	    left += 5;
	}
    	Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel,
		mePtr->accelLength, left,
		(y + (height + fmPtr->ascent - fmPtr->descent) / 2));
    }
}

/*
 *----------------------------------------------------------------------







>









>
>
>
>

|
|









|
>
|

>



|







487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
    int x;				/* Left coordinate of entry rect */
    int y;				/* Top coordinate of entry rect */
    int width;				/* Width of entry */
    int height;				/* Height of entry */
    int drawArrow;			/* Whether or not to draw arrow. */
{
    XPoint points[3];
    int borderWidth, activeBorderWidth;
    
    /*
     * Draw accelerator or cascade arrow.
     */

    if (menuPtr->menuType == MENUBAR) {
	return;
    }

    Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
	    &borderWidth);
    Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
	    &activeBorderWidth);
    if ((mePtr->type == CASCADE_ENTRY) && drawArrow) {
    	points[0].x = x + width - borderWidth - activeBorderWidth
	        - CASCADE_ARROW_WIDTH;
    	points[0].y = y + (height - CASCADE_ARROW_HEIGHT)/2;
    	points[1].x = points[0].x;
    	points[1].y = points[0].y + CASCADE_ARROW_HEIGHT;
    	points[2].x = points[0].x + CASCADE_ARROW_WIDTH;
    	points[2].y = points[0].y + CASCADE_ARROW_HEIGHT/2;
    	Tk_Fill3DPolygon(menuPtr->tkwin, d, activeBorder, points, 3,
		DECORATION_BORDER_WIDTH,
	    	(menuPtr->postedCascade == mePtr)
	    	? TK_RELIEF_SUNKEN : TK_RELIEF_RAISED);
    } else if (mePtr->accelPtr != NULL) {
	char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
	int left = x + mePtr->labelWidth + activeBorderWidth
	        + mePtr->indicatorSpace;
	
	if (menuPtr->menuType == MENUBAR) {
	    left += 5;
	}
    	Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
		mePtr->accelLength, left,
		(y + (height + fmPtr->ascent - fmPtr->descent) / 2));
    }
}

/*
 *----------------------------------------------------------------------
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545


546
547

548
549
550
551
552
553


554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573

574


575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
    Tk_Font tkfont;			/* The font to draw with */
    CONST Tk_FontMetrics *fmPtr;	/* The font metrics of the font */
    int x;				/* The left of the entry rect */
    int y;				/* The top of the entry rect */
    int width;				/* Width of menu entry */
    int height;				/* Height of menu entry */
{

    /*
     * Draw check-button indicator.
     */

    if ((mePtr->type == CHECK_BUTTON_ENTRY)
	    && mePtr->indicatorOn) {
    	int dim, top, left;


	
	dim = (int) mePtr->platformEntryData;

    	left = x + menuPtr->activeBorderWidth
		+ (mePtr->indicatorSpace - dim)/2;
	if (menuPtr->menuType == MENUBAR) {
	    left += 5;
	}
    	top = y + (height - dim)/2;


    	Tk_Fill3DRectangle(menuPtr->tkwin, d, menuPtr->border, left, top, dim,
		dim, DECORATION_BORDER_WIDTH, TK_RELIEF_SUNKEN);
    	left += DECORATION_BORDER_WIDTH;
    	top += DECORATION_BORDER_WIDTH;
    	dim -= 2*DECORATION_BORDER_WIDTH;
    	if ((dim > 0) && (mePtr->entryFlags
	    	& ENTRY_SELECTED)) {
	    XFillRectangle(menuPtr->display, d, indicatorGC, left, top,
		    (unsigned int) dim, (unsigned int) dim);
    	}
    }

    /*
     * Draw radio-button indicator.
     */

    if ((mePtr->type == RADIO_BUTTON_ENTRY)
	    && mePtr->indicatorOn) {
    	XPoint points[4];
    	int radius;




	radius = ((int) mePtr->platformEntryData)/2;
    	points[0].x = x + (mePtr->indicatorSpace
		- (int) mePtr->platformEntryData)/2;
	points[0].y = y + (height)/2;
    	points[1].x = points[0].x + radius;
    	points[1].y = points[0].y + radius;
    	points[2].x = points[1].x + radius;
    	points[2].y = points[0].y;
    	points[3].x = points[1].x;
    	points[3].y = points[0].y - radius;
    	if (mePtr->entryFlags & ENTRY_SELECTED) {
	    XFillPolygon(menuPtr->display, d, indicatorGC, points, 4, Convex,
		    CoordModeOrigin);
    	} else {
	    Tk_Fill3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 4,
		    DECORATION_BORDER_WIDTH, TK_RELIEF_FLAT);
    	}
        Tk_Draw3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 4,
	        DECORATION_BORDER_WIDTH, TK_RELIEF_SUNKEN);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DrawMenuSeparator --







<




|
<
|
>
>


>
|
|



|
>
>
|

|
|
|
|
|


|






|
<
|
|
>

>
>

|


|
|
|
|
|
|
|
|
|
|
|

|
|
|







559
560
561
562
563
564
565

566
567
568
569
570

571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601

602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
    Tk_Font tkfont;			/* The font to draw with */
    CONST Tk_FontMetrics *fmPtr;	/* The font metrics of the font */
    int x;				/* The left of the entry rect */
    int y;				/* The top of the entry rect */
    int width;				/* Width of menu entry */
    int height;				/* Height of menu entry */
{

    /*
     * Draw check-button indicator.
     */

    if ((mePtr->type == CHECK_BUTTON_ENTRY) && mePtr->indicatorOn) {

	int dim, top, left;
	int activeBorderWidth;
	Tk_3DBorder border;
	
	dim = (int) mePtr->platformEntryData;
	Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
		menuPtr->activeBorderWidthPtr, &activeBorderWidth);
	left = x + activeBorderWidth + (mePtr->indicatorSpace - dim)/2;
	if (menuPtr->menuType == MENUBAR) {
	    left += 5;
	}
	top = y + (height - dim)/2;
	border = Tk_Get3DBorderFromObj(menuPtr->tkwin,
		menuPtr->borderPtr);
	Tk_Fill3DRectangle(menuPtr->tkwin, d, border, left, top, dim,
		dim, DECORATION_BORDER_WIDTH, TK_RELIEF_SUNKEN);
	left += DECORATION_BORDER_WIDTH;
	top += DECORATION_BORDER_WIDTH;
	dim -= 2*DECORATION_BORDER_WIDTH;
	if ((dim > 0) && (mePtr->entryFlags
		& ENTRY_SELECTED)) {
	    XFillRectangle(menuPtr->display, d, indicatorGC, left, top,
		    (unsigned int) dim, (unsigned int) dim);
	}
    }

    /*
     * Draw radio-button indicator.
     */

    if ((mePtr->type == RADIO_BUTTON_ENTRY) && mePtr->indicatorOn) {

	XPoint points[4];
	int radius;
	Tk_3DBorder border;

	border = Tk_Get3DBorderFromObj(menuPtr->tkwin, 
		menuPtr->borderPtr);
	radius = ((int) mePtr->platformEntryData)/2;
	points[0].x = x + (mePtr->indicatorSpace
		- (int) mePtr->platformEntryData)/2;
	points[0].y = y + (height)/2;
	points[1].x = points[0].x + radius;
	points[1].y = points[0].y + radius;
	points[2].x = points[1].x + radius;
	points[2].y = points[0].y;
	points[3].x = points[1].x;
	points[3].y = points[0].y - radius;
	if (mePtr->entryFlags & ENTRY_SELECTED) {
	    XFillPolygon(menuPtr->display, d, indicatorGC, points, 4,
		    Convex, CoordModeOrigin);
	} else {
	    Tk_Fill3DPolygon(menuPtr->tkwin, d, border, points, 4,
		    DECORATION_BORDER_WIDTH, TK_RELIEF_FLAT);
	}
	Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 4,
		DECORATION_BORDER_WIDTH, TK_RELIEF_SUNKEN);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DrawMenuSeparator --
622
623
624
625
626
627
628

629
630
631
632
633
634
635
636
637
638

639
640
641
642
643
644
645
646
    int x;
    int y;
    int width;
    int height;
{
    XPoint points[2];
    int margin;


    if (menuPtr->menuType == MENUBAR) {
	return;
    }
    
    margin = (fmPtr->ascent + fmPtr->descent)/2;
    points[0].x = x;
    points[0].y = y + height/2;
    points[1].x = width - 1;
    points[1].y = points[0].y;

    Tk_Draw3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 2, 1,
	    TK_RELIEF_RAISED);
}

/*
 *----------------------------------------------------------------------
 *
 * DrawMenuEntryLabel --







>










>
|







655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
    int x;
    int y;
    int width;
    int height;
{
    XPoint points[2];
    int margin;
    Tk_3DBorder border;

    if (menuPtr->menuType == MENUBAR) {
	return;
    }
    
    margin = (fmPtr->ascent + fmPtr->descent)/2;
    points[0].x = x;
    points[0].y = y + height/2;
    points[1].x = width - 1;
    points[1].y = points[0].y;
    border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
    Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
	    TK_RELIEF_RAISED);
}

/*
 *----------------------------------------------------------------------
 *
 * DrawMenuEntryLabel --
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681

682
683
684



685
686
687
688
689
690
691
 *	Commands are output to X to display the menu in its
 *	current mode.
 *
 *----------------------------------------------------------------------
 */

static void
DrawMenuEntryLabel(
    menuPtr,			/* The menu we are drawing */
    mePtr,			/* The entry we are drawing */
    d,				/* What we are drawing into */
    gc,				/* The gc we are drawing into */
    tkfont,			/* The precalculated font */
    fmPtr,			/* The precalculated font metrics */
    x,				/* left edge */
    y,				/* right edge */
    width,			/* width of entry */
    height)			/* height of entry */
    TkMenu *menuPtr;
    TkMenuEntry *mePtr;
    Drawable d;
    GC gc;
    Tk_Font tkfont;
    CONST Tk_FontMetrics *fmPtr;
    int x, y, width, height;
{
    int baseline;
    int indicatorSpace =  mePtr->indicatorSpace;

    int leftEdge = x + indicatorSpace + menuPtr->activeBorderWidth;
    int imageHeight, imageWidth;




    if (menuPtr->menuType == MENUBAR) {
	leftEdge += 5;
    }
    
    /*
     * Draw label or bitmap or image for entry.
     */







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



>
|


>
>
>







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
 *	Commands are output to X to display the menu in its
 *	current mode.
 *
 *----------------------------------------------------------------------
 */

static void
DrawMenuEntryLabel(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
    TkMenu *menuPtr;		/* The menu we are drawing. */
    TkMenuEntry *mePtr;		/* The entry we are drawing. */
    Drawable d;			/* What we are drawing into. */
    GC gc;			/* The gc we are drawing into.*/
    Tk_Font tkfont;		/* The precalculated font. */
    CONST Tk_FontMetrics *fmPtr;/* The precalculated font metrics. */
    int x;			/* Left edge. */
    int y;			/* Top edge. */
    int width;			/* width of entry. */
    int height;			/* height of entry. */







{
    int baseline;
    int indicatorSpace =  mePtr->indicatorSpace;
    int activeBorderWidth;
    int leftEdge;
    int imageHeight, imageWidth;

    Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
	    &activeBorderWidth);
    leftEdge = x + indicatorSpace + activeBorderWidth;
    if (menuPtr->menuType == MENUBAR) {
	leftEdge += 5;
    }
    
    /*
     * Draw label or bitmap or image for entry.
     */
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
		    imageWidth, imageHeight, d, leftEdge,
	            (int) (y + (mePtr->height - imageHeight)/2));
    	} else {
	    Tk_RedrawImage(mePtr->image, 0, 0, imageWidth,
		    imageHeight, d, leftEdge,
		    (int) (y + (mePtr->height - imageHeight)/2));
    	}
    } else if (mePtr->bitmap != None) {
    	int width, height;

        Tk_SizeOfBitmap(menuPtr->display,
	        mePtr->bitmap, &width, &height);
    	XCopyPlane(menuPtr->display,
	    	mePtr->bitmap, d,
	    	gc, 0, 0, (unsigned) width, (unsigned) height, leftEdge,
	    	(int) (y + (mePtr->height - height)/2), 1);
    } else {
    	if (mePtr->labelLength > 0) {

	    Tk_DrawChars(menuPtr->display, d, gc,
		    tkfont, mePtr->label, mePtr->labelLength,
		    leftEdge, baseline);
	    DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y,
		    width, height);
    	}
    }

    if (mePtr->state == tkDisabledUid) {
	if (menuPtr->disabledFg == NULL) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
		    (unsigned) width, (unsigned) height);
	} else if ((mePtr->image != NULL) 
		&& (menuPtr->disabledImageGC != None)) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
		    leftEdge,
		    (int) (y + (mePtr->height - imageHeight)/2),







|

|
|
<
|
<
|



>
|
<
|





|
|







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
		    imageWidth, imageHeight, d, leftEdge,
	            (int) (y + (mePtr->height - imageHeight)/2));
    	} else {
	    Tk_RedrawImage(mePtr->image, 0, 0, imageWidth,
		    imageHeight, d, leftEdge,
		    (int) (y + (mePtr->height - imageHeight)/2));
    	}
    } else if (mePtr->bitmapPtr != None) {
    	int width, height;
	Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
        Tk_SizeOfBitmap(menuPtr->display,bitmap, &width, &height);

    	XCopyPlane(menuPtr->display, bitmap, d,	gc, 0, 0, (unsigned) width,

		(unsigned) height, leftEdge,
	    	(int) (y + (mePtr->height - height)/2), 1);
    } else {
    	if (mePtr->labelLength > 0) {
	    char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
	    Tk_DrawChars(menuPtr->display, d, gc, tkfont, label,

		    mePtr->labelLength, leftEdge, baseline);
	    DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y,
		    width, height);
    	}
    }

    if (mePtr->state == ENTRY_DISABLED) {
	if (menuPtr->disabledFgPtr == NULL) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
		    (unsigned) width, (unsigned) height);
	} else if ((mePtr->image != NULL) 
		&& (menuPtr->disabledImageGC != None)) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
		    leftEdge,
		    (int) (y + (mePtr->height - imageHeight)/2),
764
765
766
767
768
769
770

771








772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
    CONST Tk_FontMetrics *fmPtr;	/* The precalculated font metrics */
    int x;
    int y;
    int width;
    int height;
{
    int indicatorSpace = mePtr->indicatorSpace;

    if (mePtr->underline >= 0) {








	int leftEdge = x + indicatorSpace + menuPtr->activeBorderWidth;
	if (menuPtr->menuType == MENUBAR) {
	    leftEdge += 5;
	}
	
    	Tk_UnderlineChars(menuPtr->display, d, gc, tkfont, mePtr->label,
    		leftEdge, y + (height + fmPtr->ascent - fmPtr->descent) / 2,
		mePtr->underline, mePtr->underline + 1);
    }		
}

/*
 *----------------------------------------------------------------------
 *
 * TkpPostMenu --







>

>
>
>
>
>
>
>
>
|



|
|

|







794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
    CONST Tk_FontMetrics *fmPtr;	/* The precalculated font metrics */
    int x;
    int y;
    int width;
    int height;
{
    int indicatorSpace = mePtr->indicatorSpace;

    if (mePtr->underline >= 0) {
	int activeBorderWidth;
	int leftEdge;
	char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
	char *start = Tcl_UtfAtIndex(label, mePtr->underline);
	char *end = Tcl_UtfNext(start);

	Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
		menuPtr->activeBorderWidthPtr, &activeBorderWidth);
	leftEdge = x + indicatorSpace + activeBorderWidth;
	if (menuPtr->menuType == MENUBAR) {
	    leftEdge += 5;
	}

	Tk_UnderlineChars(menuPtr->display, d, gc, tkfont, label,
    		leftEdge, y + (height + fmPtr->ascent - fmPtr->descent) / 2,
		start - label, end - label);
    }		
}

/*
 *----------------------------------------------------------------------
 *
 * TkpPostMenu --
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
    int *heightPtr;			/* The resulting height */
{
    if (menuPtr->menuType != MASTER_MENU) {
	*heightPtr = 0;
	*widthPtr = 0;
    } else {
	*heightPtr = fmPtr->linespace;
	*widthPtr = Tk_TextWidth(tkfont, "W", -1);
    }
}

/*
 *--------------------------------------------------------------
 *
 * TkpComputeMenubarGeometry --







|







901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
    int *heightPtr;			/* The resulting height */
{
    if (menuPtr->menuType != MASTER_MENU) {
	*heightPtr = 0;
	*widthPtr = 0;
    } else {
	*heightPtr = fmPtr->linespace;
	*widthPtr = Tk_TextWidth(tkfont, "W", 1);
    }
}

/*
 *--------------------------------------------------------------
 *
 * TkpComputeMenubarGeometry --
899
900
901
902
903
904
905



906
907
908
909
910




911
912
913
914


915
916
917
918
919

920

921
922
923
924
925
926
927
928
929
930
931
932

933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
    int i, j;
    int x, y, currentRowHeight, currentRowWidth, maxWidth;
    int maxWindowWidth;
    int lastRowBreak;
    int helpMenuIndex = -1;
    TkMenuEntry *mePtr;
    int lastEntry;



    
    if (menuPtr->tkwin == NULL) {
	return;
    }





    maxWidth = 0;
    if (menuPtr->numEntries == 0) {
	height = 0;
    } else {


	maxWindowWidth = Tk_Width(menuPtr->tkwin);
	if (maxWindowWidth == 1) {
	    maxWindowWidth = 0x7ffffff;
	}
	currentRowHeight = 0;

	x = y = menuPtr->borderWidth;

	lastRowBreak = 0;
	currentRowWidth = 0;
	
	/*
	 * On the Mac especially, getting font metrics can be quite slow,
	 * so we want to do it intelligently. We are going to precalculate
	 * them and pass them down to all of the measureing and drawing
	 * routines. We will measure the font metrics of the menu once,
	 * and if an entry has a font set, we will measure it as we come
	 * to it, and then we decide which set to give the geometry routines.
	 */
	

	Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics);
	
	for (i = 0; i < menuPtr->numEntries; i++) {
	    mePtr = menuPtr->entries[i];
	    mePtr->entryFlags &= ~ENTRY_LAST_COLUMN;
	    tkfont = mePtr->tkfont;
	    if (tkfont == NULL) {
		tkfont = menuPtr->tkfont;
		fmPtr = &menuMetrics;
	    } else {
		Tk_GetFontMetrics(tkfont, &entryMetrics);
		fmPtr = &entryMetrics;
	    }
	    
	    /*
	     * For every entry, we need to check to see whether or not we
	     * wrap. If we do wrap, then we have to adjust all of the previous
	     * entries' height and y position, because when we see them
	     * the first time, we don't know how big its neighbor might
	     * be.
	     */
	    
	    if ((mePtr->type == SEPARATOR_ENTRY)
		    || (mePtr->type == TEAROFF_ENTRY)) {
		mePtr->height = mePtr->width = 0;
	    } else {
		
		GetMenuLabelGeometry(mePtr, tkfont, fmPtr,
			&width, &height);
		mePtr->height = height + 2 * menuPtr->activeBorderWidth + 10;
		mePtr->width = width;
		
		GetMenuIndicatorGeometry(menuPtr, mePtr,
			tkfont, fmPtr, &width, &height);
		mePtr->indicatorSpace = width;
		if (width > 0) {
		    mePtr->width += width;
		}
		mePtr->width += 2 * menuPtr->activeBorderWidth + 10;
	    }
	    if (mePtr->entryFlags & ENTRY_HELP_MENU) {
		helpMenuIndex = i;
	    } else if (x + mePtr->width + menuPtr->borderWidth
		    > maxWindowWidth) {

		if (i == lastRowBreak) {
		    mePtr->y = y;
		    mePtr->x = x;
		    lastRowBreak++;
		    y += mePtr->height;
		    currentRowHeight = 0;
		} else {
		    x = menuPtr->borderWidth;
		    for (j = lastRowBreak; j < i; j++) {
			menuPtr->entries[j]->y = y + currentRowHeight
			        - menuPtr->entries[j]->height;
			menuPtr->entries[j]->x = x;
			x += menuPtr->entries[j]->width;
		    }
		    lastRowBreak = i;
		    y += currentRowHeight;
		    currentRowHeight = mePtr->height;
		}
		if (x > maxWidth) {
		    maxWidth = x;
		}
		x = menuPtr->borderWidth;
	    } else {
		x += mePtr->width;
		if (mePtr->height > currentRowHeight) {
		    currentRowHeight = mePtr->height;
		}
	    } 
	}

	lastEntry = menuPtr->numEntries - 1;
	if (helpMenuIndex == lastEntry) {
	    lastEntry--;
	}
	if ((lastEntry >= 0) && (x + menuPtr->entries[lastEntry]->width
		+ menuPtr->borderWidth > maxWidth)) {
	    maxWidth = x + menuPtr->entries[lastEntry]->width
		    + menuPtr->borderWidth;
	}
	x = menuPtr->borderWidth;
	for (j = lastRowBreak; j < menuPtr->numEntries; j++) {
	    if (j == helpMenuIndex) {
		continue;
	    }
	    menuPtr->entries[j]->y = y + currentRowHeight
		    - menuPtr->entries[j]->height;
	    menuPtr->entries[j]->x = x;
	    x += menuPtr->entries[j]->width;
	}
	

	if (helpMenuIndex != -1) {
	    mePtr = menuPtr->entries[helpMenuIndex];
	    if (x + mePtr->width + menuPtr->borderWidth > maxWindowWidth) {
		y += currentRowHeight;
		currentRowHeight = mePtr->height;
		x = menuPtr->borderWidth;
	    } else if (mePtr->height > currentRowHeight) {
		currentRowHeight = mePtr->height;
	    }
	    mePtr->x = maxWindowWidth - menuPtr->borderWidth - mePtr->width;
	    mePtr->y = y + currentRowHeight - mePtr->height;
	}
	height = y + currentRowHeight + menuPtr->borderWidth;
    }
    width = Tk_Width(menuPtr->tkwin);    

    /*
     * The X server doesn't like zero dimensions, so round up to at least
     * 1 (a zero-sized menu should never really occur, anyway).
     */







>
>
>





>
>
>
>




>
>





>
|
>











|
>
|




|
|
|
|

|
|

|












<
|
<
|

|
|
|




|



|
<








|













|













|
|
<

|













|


|



|


|







938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009

1010

1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024

1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062

1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
    int i, j;
    int x, y, currentRowHeight, currentRowWidth, maxWidth;
    int maxWindowWidth;
    int lastRowBreak;
    int helpMenuIndex = -1;
    TkMenuEntry *mePtr;
    int lastEntry;
    Tk_Font menuFont;
    int borderWidth;
    int activeBorderWidth;
    
    if (menuPtr->tkwin == NULL) {
	return;
    }

    Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
	    &borderWidth);
    Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
	    &activeBorderWidth);
    maxWidth = 0;
    if (menuPtr->numEntries == 0) {
	height = 0;
    } else {
	int borderWidth;
	
	maxWindowWidth = Tk_Width(menuPtr->tkwin);
	if (maxWindowWidth == 1) {
	    maxWindowWidth = 0x7ffffff;
	}
	currentRowHeight = 0;
	Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
		&borderWidth);
	x = y = borderWidth;
	lastRowBreak = 0;
	currentRowWidth = 0;
	
	/*
	 * On the Mac especially, getting font metrics can be quite slow,
	 * so we want to do it intelligently. We are going to precalculate
	 * them and pass them down to all of the measureing and drawing
	 * routines. We will measure the font metrics of the menu once,
	 * and if an entry has a font set, we will measure it as we come
	 * to it, and then we decide which set to give the geometry routines.
	 */

	menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
	Tk_GetFontMetrics(menuFont, &menuMetrics);
	
	for (i = 0; i < menuPtr->numEntries; i++) {
	    mePtr = menuPtr->entries[i];
	    mePtr->entryFlags &= ~ENTRY_LAST_COLUMN;
	    if (mePtr->fontPtr != NULL) {
		tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
		Tk_GetFontMetrics(tkfont, &entryMetrics);
		fmPtr = &entryMetrics;
	    } else {
		tkfont = menuFont;
		fmPtr = &menuMetrics;
	    }

	    /*
	     * For every entry, we need to check to see whether or not we
	     * wrap. If we do wrap, then we have to adjust all of the previous
	     * entries' height and y position, because when we see them
	     * the first time, we don't know how big its neighbor might
	     * be.
	     */
	    
	    if ((mePtr->type == SEPARATOR_ENTRY)
		    || (mePtr->type == TEAROFF_ENTRY)) {
		mePtr->height = mePtr->width = 0;
	    } else {

		GetMenuLabelGeometry(mePtr, tkfont, fmPtr, &width, &height);

		mePtr->height = height + 2 * activeBorderWidth + 10;
		mePtr->width = width;

		GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont, fmPtr,
			&width, &height);
		mePtr->indicatorSpace = width;
		if (width > 0) {
		    mePtr->width += width;
		}
		mePtr->width += 2 * activeBorderWidth + 10;
	    }
	    if (mePtr->entryFlags & ENTRY_HELP_MENU) {
		helpMenuIndex = i;
	    } else if (x + mePtr->width + borderWidth > maxWindowWidth) {


		if (i == lastRowBreak) {
		    mePtr->y = y;
		    mePtr->x = x;
		    lastRowBreak++;
		    y += mePtr->height;
		    currentRowHeight = 0;
		} else {
		    x = borderWidth;
		    for (j = lastRowBreak; j < i; j++) {
			menuPtr->entries[j]->y = y + currentRowHeight
			        - menuPtr->entries[j]->height;
			menuPtr->entries[j]->x = x;
			x += menuPtr->entries[j]->width;
		    }
		    lastRowBreak = i;
		    y += currentRowHeight;
		    currentRowHeight = mePtr->height;
		}
		if (x > maxWidth) {
		    maxWidth = x;
		}
		x = borderWidth;
	    } else {
		x += mePtr->width;
		if (mePtr->height > currentRowHeight) {
		    currentRowHeight = mePtr->height;
		}
	    } 
	}

	lastEntry = menuPtr->numEntries - 1;
	if (helpMenuIndex == lastEntry) {
	    lastEntry--;
	}
	if ((lastEntry >= 0) && (x + menuPtr->entries[lastEntry]->width
		+ borderWidth > maxWidth)) {
	    maxWidth = x + menuPtr->entries[lastEntry]->width + borderWidth;

	}
	x = borderWidth;
	for (j = lastRowBreak; j < menuPtr->numEntries; j++) {
	    if (j == helpMenuIndex) {
		continue;
	    }
	    menuPtr->entries[j]->y = y + currentRowHeight
		    - menuPtr->entries[j]->height;
	    menuPtr->entries[j]->x = x;
	    x += menuPtr->entries[j]->width;
	}
	

	if (helpMenuIndex != -1) {
	    mePtr = menuPtr->entries[helpMenuIndex];
	    if (x + mePtr->width + borderWidth > maxWindowWidth) {
		y += currentRowHeight;
		currentRowHeight = mePtr->height;
		x = borderWidth;
	    } else if (mePtr->height > currentRowHeight) {
		currentRowHeight = mePtr->height;
	    }
	    mePtr->x = maxWindowWidth - borderWidth - mePtr->width;
	    mePtr->y = y + currentRowHeight - mePtr->height;
	}
	height = y + currentRowHeight + borderWidth;
    }
    width = Tk_Width(menuPtr->tkwin);    

    /*
     * The X server doesn't like zero dimensions, so round up to at least
     * 1 (a zero-sized menu should never really occur, anyway).
     */
1085
1086
1087
1088
1089
1090
1091

1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102

1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
    int x;
    int y;
    int width;
    int height;
{
    XPoint points[2];
    int margin, segmentWidth, maxX;


    if (menuPtr->menuType != MASTER_MENU) {
	return;
    }
    
    margin = (fmPtr->ascent + fmPtr->descent)/2;
    points[0].x = x;
    points[0].y = y + height/2;
    points[1].y = points[0].y;
    segmentWidth = 6;
    maxX  = width - 1;


    while (points[0].x < maxX) {
	points[1].x = points[0].x + segmentWidth;
	if (points[1].x > maxX) {
	    points[1].x = maxX;
	}
	Tk_Draw3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 2, 1,
		TK_RELIEF_RAISED);
	points[0].x += 2*segmentWidth;
    }
}

/*
 *--------------------------------------------------------------
 *
 * TkpInitializeMenuBindings --







>











>






|

|







1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
    int x;
    int y;
    int width;
    int height;
{
    XPoint points[2];
    int margin, segmentWidth, maxX;
    Tk_3DBorder border;

    if (menuPtr->menuType != MASTER_MENU) {
	return;
    }
    
    margin = (fmPtr->ascent + fmPtr->descent)/2;
    points[0].x = x;
    points[0].y = y + height/2;
    points[1].y = points[0].y;
    segmentWidth = 6;
    maxX  = width - 1;
    border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);

    while (points[0].x < maxX) {
	points[1].x = points[0].x + segmentWidth;
	if (points[1].x > maxX) {
	    points[1].x = maxX;
	}
	Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
		TK_RELIEF_RAISED);
	points[0].x += 2 * segmentWidth;
    }
}

/*
 *--------------------------------------------------------------
 *
 * TkpInitializeMenuBindings --
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251



1252
1253
1254
1255
1256

1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
    int adjustedY = y + padY;
    int adjustedHeight = height - 2 * padY;

    /*
     * Choose the gc for drawing the foreground part of the entry.
     */

    if ((mePtr->state == tkActiveUid)
	    && !strictMotif) {
	gc = mePtr->activeGC;
	if (gc == NULL) {
	    gc = menuPtr->activeGC;
	}
    } else {
    	TkMenuEntry *cascadeEntryPtr;
    	int parentDisabled = 0;
    	
    	for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
    		cascadeEntryPtr != NULL;
    		cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
    	    if (strcmp(cascadeEntryPtr->name, 



    	    	    Tk_PathName(menuPtr->tkwin)) == 0) {
    	    	if (cascadeEntryPtr->state == tkDisabledUid) {
    	    	    parentDisabled = 1;
    	    	}
    	    	break;

    	    }
    	}

	if (((parentDisabled || (mePtr->state == tkDisabledUid)))
		&& (menuPtr->disabledFg != NULL)) {
	    gc = mePtr->disabledGC;
	    if (gc == NULL) {
		gc = menuPtr->disabledGC;
	    }
	} else {
	    gc = mePtr->textGC;
	    if (gc == NULL) {
		gc = menuPtr->textGC;
	    }
	}
    }
    indicatorGC = mePtr->indicatorGC;
    if (indicatorGC == NULL) {
	indicatorGC = menuPtr->indicatorGC;
    }
	    
    bgBorder = mePtr->border;
    if (bgBorder == NULL) {
	bgBorder = menuPtr->border;
    }
    if (strictMotif) {
	activeBorder = bgBorder;
    } else {
	activeBorder = mePtr->activeBorder;
	if (activeBorder == NULL) {
	    activeBorder = menuPtr->activeBorder;
	}
    }

    if (mePtr->tkfont == NULL) {
	fmPtr = menuMetricsPtr;
    } else {
	tkfont = mePtr->tkfont;
	Tk_GetFontMetrics(tkfont, &entryMetrics);
	fmPtr = &entryMetrics;
    }

    /*
     * Need to draw the entire background, including padding. On Unix,
     * for menubars, we have to draw the rest of the entry taking







|
<











|
>
>
>
|
|
|
|
|
>



|
|















|
|
|
|
<



|
|
|
|
|
<
|


|







1280
1281
1282
1283
1284
1285
1286
1287

1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332

1333
1334
1335
1336
1337
1338
1339
1340

1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
    int adjustedY = y + padY;
    int adjustedHeight = height - 2 * padY;

    /*
     * Choose the gc for drawing the foreground part of the entry.
     */

    if ((mePtr->state == ENTRY_ACTIVE) && !strictMotif) {

	gc = mePtr->activeGC;
	if (gc == NULL) {
	    gc = menuPtr->activeGC;
	}
    } else {
    	TkMenuEntry *cascadeEntryPtr;
    	int parentDisabled = 0;
    	
    	for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
    		cascadeEntryPtr != NULL;
    		cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
	    if (cascadeEntryPtr->namePtr != NULL) {
		char *name = Tcl_GetStringFromObj(cascadeEntryPtr->namePtr,
			NULL);

		if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) {
		    if (cascadeEntryPtr->state == ENTRY_DISABLED) {
			parentDisabled = 1;
		    }
		    break;
    	    	}
    	    }
    	}

	if (((parentDisabled || (mePtr->state == ENTRY_DISABLED)))
		&& (menuPtr->disabledFgPtr != NULL)) {
	    gc = mePtr->disabledGC;
	    if (gc == NULL) {
		gc = menuPtr->disabledGC;
	    }
	} else {
	    gc = mePtr->textGC;
	    if (gc == NULL) {
		gc = menuPtr->textGC;
	    }
	}
    }
    indicatorGC = mePtr->indicatorGC;
    if (indicatorGC == NULL) {
	indicatorGC = menuPtr->indicatorGC;
    }

    bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
	    (mePtr->borderPtr == NULL)
	    ? menuPtr->borderPtr : mePtr->borderPtr);

    if (strictMotif) {
	activeBorder = bgBorder;
    } else {
	activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
	    (mePtr->activeBorderPtr == NULL)
	    ? menuPtr->activeBorderPtr : mePtr->activeBorderPtr);
    }


    if (mePtr->fontPtr == NULL) {
	fmPtr = menuMetricsPtr;
    } else {
	tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
	Tk_GetFontMetrics(tkfont, &entryMetrics);
	fmPtr = &entryMetrics;
    }

    /*
     * Need to draw the entire background, including padding. On Unix,
     * for menubars, we have to draw the rest of the entry taking
1350
1351
1352
1353
1354
1355
1356
1357

1358
1359
1360
1361
1362


1363
1364
1365
1366
1367
1368
1369
1370
    int *heightPtr;			/* The resulting height of the label
					 * portion */
{
    TkMenu *menuPtr = mePtr->menuPtr;
 
    if (mePtr->image != NULL) {
    	Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr);
    } else if (mePtr->bitmap != (Pixmap) NULL) {

    	Tk_SizeOfBitmap(menuPtr->display, mePtr->bitmap, widthPtr, heightPtr);
    } else {
    	*heightPtr = fmPtr->linespace;
    	
    	if (mePtr->label != NULL) {


    	    *widthPtr = Tk_TextWidth(tkfont, mePtr->label, mePtr->labelLength);
    	} else {
    	    *widthPtr = 0;
    	}
    }
    *heightPtr += 1;
}








|
>
|



|
>
>
|







1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
    int *heightPtr;			/* The resulting height of the label
					 * portion */
{
    TkMenu *menuPtr = mePtr->menuPtr;
 
    if (mePtr->image != NULL) {
    	Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr);
    } else if (mePtr->bitmapPtr !=  NULL) {
	Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
    	Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr);
    } else {
    	*heightPtr = fmPtr->linespace;
    	
    	if (mePtr->labelPtr != NULL) {
	    char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
	    
    	    *widthPtr = Tk_TextWidth(tkfont, label, mePtr->labelLength);
    	} else {
    	    *widthPtr = 0;
    	}
    }
    *heightPtr += 1;
}

1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400

1401
1402
1403
1404
1405

1406



1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420

1421
1422
1423
1424
1425
1426
1427
1428
1429
1430

1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
 */

void
TkpComputeStandardMenuGeometry(
    menuPtr)		/* Structure describing menu. */
    TkMenu *menuPtr;
{
    Tk_Font tkfont;
    Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
    int x, y, height, width, indicatorSpace, labelWidth, accelWidth;
    int windowWidth, windowHeight, accelSpace;
    int i, j, lastColumnBreak = 0;
    TkMenuEntry *mePtr;

    
    if (menuPtr->tkwin == NULL) {
	return;
    }


    x = y = menuPtr->borderWidth;



    indicatorSpace = labelWidth = accelWidth = 0;
    windowHeight = windowWidth = 0;

    /*
     * On the Mac especially, getting font metrics can be quite slow,
     * so we want to do it intelligently. We are going to precalculate
     * them and pass them down to all of the measuring and drawing
     * routines. We will measure the font metrics of the menu once.
     * If an entry does not have its own font set, then we give
     * the geometry/drawing routines the menu's font and metrics.
     * If an entry has its own font, we will measure that font and
     * give all of the geometry/drawing the entry's font and metrics.
     */


    Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics);
    accelSpace = Tk_TextWidth(menuPtr->tkfont, "M", 1);

    for (i = 0; i < menuPtr->numEntries; i++) {
	mePtr = menuPtr->entries[i];
    	tkfont = mePtr->tkfont;
    	if (tkfont == NULL) {
    	    tkfont = menuPtr->tkfont;
    	    fmPtr = &menuMetrics;
    	} else {

    	    Tk_GetFontMetrics(tkfont, &entryMetrics);
    	    fmPtr = &entryMetrics;
    	}
    	
	if ((i > 0) && mePtr->columnBreak) {
	    if (accelWidth != 0) {
		labelWidth += accelSpace;
	    }
	    for (j = lastColumnBreak; j < i; j++) {
		menuPtr->entries[j]->indicatorSpace = indicatorSpace;
		menuPtr->entries[j]->labelWidth = labelWidth;
		menuPtr->entries[j]->width = indicatorSpace + labelWidth
			+ accelWidth + 2 * menuPtr->activeBorderWidth;
		menuPtr->entries[j]->x = x;
		menuPtr->entries[j]->entryFlags &= ~ENTRY_LAST_COLUMN;
	    }
	    x += indicatorSpace + labelWidth + accelWidth
		    + 2 * menuPtr->activeBorderWidth;
	    windowWidth = x;
	    indicatorSpace = labelWidth = accelWidth = 0;
	    lastColumnBreak = i;
	    y = menuPtr->borderWidth;
	}

	if (mePtr->type == SEPARATOR_ENTRY) {
	    GetMenuSeparatorGeometry(menuPtr, mePtr, tkfont,
	    	    fmPtr, &width, &height);
	    mePtr->height = height;
	} else if (mePtr->type == TEAROFF_ENTRY) {







|





>





>
|
>
>
>














>
|
|



<
|
|
|
|
>
|
|
|
|








|




|



|







1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484

1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
 */

void
TkpComputeStandardMenuGeometry(
    menuPtr)		/* Structure describing menu. */
    TkMenu *menuPtr;
{
    Tk_Font tkfont, menuFont;
    Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
    int x, y, height, width, indicatorSpace, labelWidth, accelWidth;
    int windowWidth, windowHeight, accelSpace;
    int i, j, lastColumnBreak = 0;
    TkMenuEntry *mePtr;
    int borderWidth, activeBorderWidth;
    
    if (menuPtr->tkwin == NULL) {
	return;
    }

    Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
	    &borderWidth);
    Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
	    &activeBorderWidth);
    x = y = borderWidth;
    indicatorSpace = labelWidth = accelWidth = 0;
    windowHeight = windowWidth = 0;

    /*
     * On the Mac especially, getting font metrics can be quite slow,
     * so we want to do it intelligently. We are going to precalculate
     * them and pass them down to all of the measuring and drawing
     * routines. We will measure the font metrics of the menu once.
     * If an entry does not have its own font set, then we give
     * the geometry/drawing routines the menu's font and metrics.
     * If an entry has its own font, we will measure that font and
     * give all of the geometry/drawing the entry's font and metrics.
     */

    menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
    Tk_GetFontMetrics(menuFont, &menuMetrics);
    accelSpace = Tk_TextWidth(menuFont, "M", 1);

    for (i = 0; i < menuPtr->numEntries; i++) {
	mePtr = menuPtr->entries[i];

	if (mePtr->fontPtr == NULL) {
	    tkfont = menuFont;
	    fmPtr = &menuMetrics;
	} else {
	    tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
	    Tk_GetFontMetrics(tkfont, &entryMetrics);
	    fmPtr = &entryMetrics;
	}

	if ((i > 0) && mePtr->columnBreak) {
	    if (accelWidth != 0) {
		labelWidth += accelSpace;
	    }
	    for (j = lastColumnBreak; j < i; j++) {
		menuPtr->entries[j]->indicatorSpace = indicatorSpace;
		menuPtr->entries[j]->labelWidth = labelWidth;
		menuPtr->entries[j]->width = indicatorSpace + labelWidth
			+ accelWidth + 2 * activeBorderWidth;
		menuPtr->entries[j]->x = x;
		menuPtr->entries[j]->entryFlags &= ~ENTRY_LAST_COLUMN;
	    }
	    x += indicatorSpace + labelWidth + accelWidth
		    + 2 * activeBorderWidth;
	    windowWidth = x;
	    indicatorSpace = labelWidth = accelWidth = 0;
	    lastColumnBreak = i;
	    y = borderWidth;
	}

	if (mePtr->type == SEPARATOR_ENTRY) {
	    GetMenuSeparatorGeometry(menuPtr, mePtr, tkfont,
	    	    fmPtr, &width, &height);
	    mePtr->height = height;
	} else if (mePtr->type == TEAROFF_ENTRY) {
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
	    if (!mePtr->hideMargin) {
		width += MENU_MARGIN_WIDTH;
	    }
	    if (width > indicatorSpace) {
	    	indicatorSpace = width;
	    }

	    mePtr->height += 2 * menuPtr->activeBorderWidth + 
	    	    MENU_DIVIDER_HEIGHT;
    	}
        mePtr->y = y;
	y += mePtr->height;
	if (y > windowHeight) {
	    windowHeight = y;
	}
    }

    if (accelWidth != 0) {
	labelWidth += accelSpace;
    }
    for (j = lastColumnBreak; j < menuPtr->numEntries; j++) {
	menuPtr->entries[j]->indicatorSpace = indicatorSpace;
	menuPtr->entries[j]->labelWidth = labelWidth;
	menuPtr->entries[j]->width = indicatorSpace + labelWidth
		+ accelWidth + 2 * menuPtr->activeBorderWidth;
	menuPtr->entries[j]->x = x;
	menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN;
    }
    windowWidth = x + indicatorSpace + labelWidth + accelWidth
	    + 2 * menuPtr->activeBorderWidth + 2 * menuPtr->borderWidth;


    windowHeight += menuPtr->borderWidth;
    
    /*
     * The X server doesn't like zero dimensions, so round up to at least
     * 1 (a zero-sized menu should never really occur, anyway).
     */

    if (windowWidth <= 0) {







<
|















|




|


|







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
	    if (!mePtr->hideMargin) {
		width += MENU_MARGIN_WIDTH;
	    }
	    if (width > indicatorSpace) {
	    	indicatorSpace = width;
	    }


	    mePtr->height += 2 * activeBorderWidth + MENU_DIVIDER_HEIGHT;
    	}
        mePtr->y = y;
	y += mePtr->height;
	if (y > windowHeight) {
	    windowHeight = y;
	}
    }

    if (accelWidth != 0) {
	labelWidth += accelSpace;
    }
    for (j = lastColumnBreak; j < menuPtr->numEntries; j++) {
	menuPtr->entries[j]->indicatorSpace = indicatorSpace;
	menuPtr->entries[j]->labelWidth = labelWidth;
	menuPtr->entries[j]->width = indicatorSpace + labelWidth
		+ accelWidth + 2 * activeBorderWidth;
	menuPtr->entries[j]->x = x;
	menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN;
    }
    windowWidth = x + indicatorSpace + labelWidth + accelWidth
	    + 2 * activeBorderWidth + 2 * borderWidth;


    windowHeight += borderWidth;
    
    /*
     * The X server doesn't like zero dimensions, so round up to at least
     * 1 (a zero-sized menu should never really occur, anyway).
     */

    if (windowWidth <= 0) {
1597
1598
1599
1600
1601
1602
1603



























void
TkpMenuInit()
{
    /*
     * Nothing to do.
     */
}


































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
void
TkpMenuInit()
{
    /*
     * Nothing to do.
     */
}


/*
 *----------------------------------------------------------------------
 *
 * TkpMenuThreadInit --
 *
 *	Does platform-specific initialization of thread-specific
 *      menu state.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TkpMenuThreadInit()
{
    /*
     * Nothing to do.
     */
}

Changes to unix/tkUnixMenubu.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkUnixMenubu.c --
 *
 *	This file implements the Unix specific portion of the
 *	menubutton widget.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixMenubu.c 1.9 97/05/23 16:25:01
 */

#include "tkMenubutton.h"

/*
 * The structure below defines menubutton class behavior by means of
 * procedures that can be invoked from generic window code.











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkUnixMenubu.c --
 *
 *	This file implements the Unix specific portion of the
 *	menubutton widget.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixMenubu.c,v 1.1.4.6 1999/04/06 00:35:28 lfb Exp $
 */

#include "tkMenubutton.h"

/*
 * The structure below defines menubutton class behavior by means of
 * procedures that can be invoked from generic window code.
80
81
82
83
84
85
86
87
88
89
90

91
92
93
94
95
96
97
    int width, height;

    mbPtr->flags &= ~REDRAW_PENDING;
    if ((mbPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
	return;
    }

    if ((mbPtr->state == tkDisabledUid) && (mbPtr->disabledFg != NULL)) {
	gc = mbPtr->disabledGC;
	border = mbPtr->normalBorder;
    } else if ((mbPtr->state == tkActiveUid) && !Tk_StrictMotif(mbPtr->tkwin)) {

	gc = mbPtr->activeTextGC;
	border = mbPtr->activeBorder;
    } else {
	gc = mbPtr->normalTextGC;
	border = mbPtr->normalBorder;
    }








|


|
>







80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
    int width, height;

    mbPtr->flags &= ~REDRAW_PENDING;
    if ((mbPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
	return;
    }

    if ((mbPtr->state == STATE_DISABLED) && (mbPtr->disabledFg != NULL)) {
	gc = mbPtr->disabledGC;
	border = mbPtr->normalBorder;
    } else if ((mbPtr->state == STATE_ACTIVE)
	       && !Tk_StrictMotif(mbPtr->tkwin)) {
	gc = mbPtr->activeTextGC;
	border = mbPtr->activeBorder;
    } else {
	gc = mbPtr->normalTextGC;
	border = mbPtr->normalBorder;
    }

138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
    }

    /*
     * If the menu button is disabled with a stipple rather than a special
     * foreground color, generate the stippled effect.
     */

    if ((mbPtr->state == tkDisabledUid)
	    && ((mbPtr->disabledFg == NULL) || (mbPtr->image != NULL))) {
	XFillRectangle(mbPtr->display, pixmap, mbPtr->disabledGC,
		mbPtr->inset, mbPtr->inset,
		(unsigned) (Tk_Width(tkwin) - 2*mbPtr->inset),
		(unsigned) (Tk_Height(tkwin) - 2*mbPtr->inset));
    }

    /*







|
|







139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
    }

    /*
     * If the menu button is disabled with a stipple rather than a special
     * foreground color, generate the stippled effect.
     */

    if (((mbPtr->state == STATE_DISABLED) 
            && (mbPtr->disabledFg == NULL)) || (mbPtr->image != NULL)) {
	XFillRectangle(mbPtr->display, pixmap, mbPtr->disabledGC,
		mbPtr->inset, mbPtr->inset,
		(unsigned) (Tk_Width(tkwin) - 2*mbPtr->inset),
		(unsigned) (Tk_Height(tkwin) - 2*mbPtr->inset));
    }

    /*
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
 *	The menu button's window may change size.
 *
 *----------------------------------------------------------------------
 */

void
TkpComputeMenuButtonGeometry(mbPtr)
    register TkMenuButton *mbPtr;	/* Widget record for menu button. */
{
    int width, height, mm, pixels;

    mbPtr->inset = mbPtr->highlightWidth + mbPtr->borderWidth;
    if (mbPtr->image != None) {
	Tk_SizeOfImage(mbPtr->image, &width, &height);
	if (mbPtr->width > 0) {







|







245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
 *	The menu button's window may change size.
 *
 *----------------------------------------------------------------------
 */

void
TkpComputeMenuButtonGeometry(mbPtr)
    TkMenuButton *mbPtr;	/* Widget record for menu button. */
{
    int width, height, mm, pixels;

    mbPtr->inset = mbPtr->highlightWidth + mbPtr->borderWidth;
    if (mbPtr->image != None) {
	Tk_SizeOfImage(mbPtr->image, &width, &height);
	if (mbPtr->width > 0) {

Changes to unix/tkUnixPort.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tkUnixPort.h --
 *
 *	This file is included by all of the Tk C files.  It contains
 *	information that may be configuration-dependent, such as
 *	#includes for system include files and a few other things.
 *
 * Copyright (c) 1991-1993 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixPort.h 1.38 97/05/17 16:48:19
 */

#ifndef _UNIXPORT
#define _UNIXPORT

#define __UNIX__ 1














|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tkUnixPort.h --
 *
 *	This file is included by all of the Tk C files.  It contains
 *	information that may be configuration-dependent, such as
 *	#includes for system include files and a few other things.
 *
 * Copyright (c) 1991-1993 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixPort.h,v 1.1.4.3 1999/03/10 07:13:51 stanton Exp $
 */

#ifndef _UNIXPORT
#define _UNIXPORT

#define __UNIX__ 1

153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
 * needed for X.
 */

#define TkPutImage(colors, ncolors, display, pixels, gc, image, destx, desty, srcx, srcy, width, height) \
	XPutImage(display, pixels, gc, image, destx, desty, srcx, \
	srcy, width, height);

/*
 * The following Tk functions are implemented as macros under Windows.
 */

#define TkGetNativeProlog(interp) TkGetProlog(interp)

/*
 * Supply macros for seek offsets, if they're not already provided by
 * an include file.
 */

#ifndef SEEK_SET
#   define SEEK_SET 0







<
<
<
<
<
<







153
154
155
156
157
158
159






160
161
162
163
164
165
166
 * needed for X.
 */

#define TkPutImage(colors, ncolors, display, pixels, gc, image, destx, desty, srcx, srcy, width, height) \
	XPutImage(display, pixels, gc, image, destx, desty, srcx, \
	srcy, width, height);







/*
 * Supply macros for seek offsets, if they're not already provided by
 * an include file.
 */

#ifndef SEEK_SET
#   define SEEK_SET 0
181
182
183
184
185
186
187
188
189
190
191
192
193

194
195
196
197
198
199
200
#endif

/*
 * Declarations for various library procedures that may not be declared
 * in any other header file.
 */

extern void		panic _ANSI_ARGS_(TCL_VARARGS(char *, string));

/*
 * These functions do nothing under Unix, so we just eliminate calls to them.
 */


#define TkpDestroyButton(butPtr) {}
#define TkSelUpdateClipboard(a,b) {}
#define TkSetPixmapColormap(p,c) {}

/*
 * These calls implement native bitmaps which are not supported under
 * UNIX.  The macros eliminate the calls.







<





>







175
176
177
178
179
180
181

182
183
184
185
186
187
188
189
190
191
192
193
194
#endif

/*
 * Declarations for various library procedures that may not be declared
 * in any other header file.
 */



/*
 * These functions do nothing under Unix, so we just eliminate calls to them.
 */

#define TkpButtonSetDefaults(specPtr) {}
#define TkpDestroyButton(butPtr) {}
#define TkSelUpdateClipboard(a,b) {}
#define TkSetPixmapColormap(p,c) {}

/*
 * These calls implement native bitmaps which are not supported under
 * UNIX.  The macros eliminate the calls.
226
227
228
229
230
231
232
233


234
235
#define ALWAYS_SHOW_SELECTION

/*
 * The following declaration is used to get access to a private Tcl interface
 * that is needed for portability reasons.
 */

EXTERN void		TclpGetTime _ANSI_ARGS_((Tcl_Time *time));



#endif /* _UNIXPORT */







|
>
>


220
221
222
223
224
225
226
227
228
229
230
231
#define ALWAYS_SHOW_SELECTION

/*
 * The following declaration is used to get access to a private Tcl interface
 * that is needed for portability reasons.
 */

#ifndef _TCLINT
#include <tclInt.h>
#endif

#endif /* _UNIXPORT */

Changes to unix/tkUnixScale.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkUnixScale.c --
 *
 *	This file implements the X specific portion of the scrollbar
 *	widget.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixScale.c 1.5 96/07/31 14:22:29
 */

#include "tkScale.h"
#include "tkInt.h"

/*
 * Forward declarations for procedures defined later in this file:











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkUnixScale.c --
 *
 *	This file implements the X specific portion of the scrollbar
 *	widget.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixScale.c,v 1.1.4.3 1999/02/13 05:09:37 lfb Exp $
 */

#include "tkScale.h"
#include "tkInt.h"

/*
 * Forward declarations for procedures defined later in this file:
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
	    TK_RELIEF_SUNKEN);
    XFillRectangle(scalePtr->display, drawable, scalePtr->troughGC,
	    scalePtr->vertTroughX + scalePtr->borderWidth,
	    scalePtr->inset + scalePtr->borderWidth,
	    (unsigned) scalePtr->width,
	    (unsigned) (Tk_Height(tkwin) - 2*scalePtr->inset
		- 2*scalePtr->borderWidth));
    if (scalePtr->state == tkActiveUid) {
	sliderBorder = scalePtr->activeBorder;
    } else {
	sliderBorder = scalePtr->bgBorder;
    }
    width = scalePtr->width;
    height = scalePtr->sliderLength/2;
    x = scalePtr->vertTroughX + scalePtr->borderWidth;







|







173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
	    TK_RELIEF_SUNKEN);
    XFillRectangle(scalePtr->display, drawable, scalePtr->troughGC,
	    scalePtr->vertTroughX + scalePtr->borderWidth,
	    scalePtr->inset + scalePtr->borderWidth,
	    (unsigned) scalePtr->width,
	    (unsigned) (Tk_Height(tkwin) - 2*scalePtr->inset
		- 2*scalePtr->borderWidth));
    if (scalePtr->state == STATE_ACTIVE) {
	sliderBorder = scalePtr->activeBorder;
    } else {
	sliderBorder = scalePtr->bgBorder;
    }
    width = scalePtr->width;
    height = scalePtr->sliderLength/2;
    x = scalePtr->vertTroughX + scalePtr->borderWidth;
206
207
208
209
210
211
212

213
214
215
216
217
218
219
220
221
     */

    if ((scalePtr->flags & REDRAW_OTHER) && (scalePtr->labelLength != 0)) {
	Tk_FontMetrics fm;

	Tk_GetFontMetrics(scalePtr->tkfont, &fm);
	Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC,

		scalePtr->tkfont, scalePtr->label, scalePtr->labelLength,
		scalePtr->vertLabelX, scalePtr->inset + (3*fm.ascent)/2);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DisplayVerticalValue --







>
|
|







206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
     */

    if ((scalePtr->flags & REDRAW_OTHER) && (scalePtr->labelLength != 0)) {
	Tk_FontMetrics fm;

	Tk_GetFontMetrics(scalePtr->tkfont, &fm);
	Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC,
		scalePtr->tkfont, Tcl_GetString(scalePtr->labelPtr), 
                scalePtr->labelLength, scalePtr->vertLabelX,
                scalePtr->inset + (3*fm.ascent)/2);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DisplayVerticalValue --
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
	    scalePtr->borderWidth, TK_RELIEF_SUNKEN);
    XFillRectangle(scalePtr->display, drawable, scalePtr->troughGC,
	    scalePtr->inset + scalePtr->borderWidth,
	    y + scalePtr->borderWidth,
	    (unsigned) (Tk_Width(tkwin) - 2*scalePtr->inset
		- 2*scalePtr->borderWidth),
	    (unsigned) scalePtr->width);
    if (scalePtr->state == tkActiveUid) {
	sliderBorder = scalePtr->activeBorder;
    } else {
	sliderBorder = scalePtr->bgBorder;
    }
    width = scalePtr->sliderLength/2;
    height = scalePtr->width;
    x = TkpValueToPixel(scalePtr, scalePtr->value) - width;







|







373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
	    scalePtr->borderWidth, TK_RELIEF_SUNKEN);
    XFillRectangle(scalePtr->display, drawable, scalePtr->troughGC,
	    scalePtr->inset + scalePtr->borderWidth,
	    y + scalePtr->borderWidth,
	    (unsigned) (Tk_Width(tkwin) - 2*scalePtr->inset
		- 2*scalePtr->borderWidth),
	    (unsigned) scalePtr->width);
    if (scalePtr->state == STATE_ACTIVE) {
	sliderBorder = scalePtr->activeBorder;
    } else {
	sliderBorder = scalePtr->bgBorder;
    }
    width = scalePtr->sliderLength/2;
    height = scalePtr->width;
    x = TkpValueToPixel(scalePtr, scalePtr->value) - width;
405
406
407
408
409
410
411

412
413
414
415
416
417
418
419
420
     */

    if ((scalePtr->flags & REDRAW_OTHER) && (scalePtr->labelLength != 0)) {
	Tk_FontMetrics fm;

	Tk_GetFontMetrics(scalePtr->tkfont, &fm);
	Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC,

		scalePtr->tkfont, scalePtr->label, scalePtr->labelLength,
		scalePtr->inset + fm.ascent/2, scalePtr->horizLabelY + fm.ascent);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DisplayHorizontalValue --







>
|
|







406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
     */

    if ((scalePtr->flags & REDRAW_OTHER) && (scalePtr->labelLength != 0)) {
	Tk_FontMetrics fm;

	Tk_GetFontMetrics(scalePtr->tkfont, &fm);
	Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC,
		scalePtr->tkfont, Tcl_GetString(scalePtr->labelPtr), 
                scalePtr->labelLength, scalePtr->inset + fm.ascent/2, 
                scalePtr->horizLabelY + fm.ascent);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DisplayHorizontalValue --
508
509
510
511
512
513
514
515

516

517
518
519
520
521
522
523
524
525

    /*
     * Invoke the scale's command if needed.
     */

    Tcl_Preserve((ClientData) scalePtr);
    Tcl_Preserve((ClientData) interp);
    if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) {

	sprintf(string, scalePtr->format, scalePtr->value);

	result = Tcl_VarEval(interp, scalePtr->command,	" ", string,
                             (char *) NULL);
	if (result != TCL_OK) {
	    Tcl_AddErrorInfo(interp, "\n    (command executed by scale)");
	    Tcl_BackgroundError(interp);
	}
    }
    Tcl_Release((ClientData) interp);
    scalePtr->flags &= ~INVOKE_COMMAND;







|
>

>
|
|







510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529

    /*
     * Invoke the scale's command if needed.
     */

    Tcl_Preserve((ClientData) scalePtr);
    Tcl_Preserve((ClientData) interp);
    if ((scalePtr->flags & INVOKE_COMMAND) 
            && (scalePtr->commandPtr != NULL)) {
	sprintf(string, scalePtr->format, scalePtr->value);

	result = Tcl_VarEval(interp, Tcl_GetString(scalePtr->commandPtr),
                " ", string, (char *) NULL);
	if (result != TCL_OK) {
	    Tcl_AddErrorInfo(interp, "\n    (command executed by scale)");
	    Tcl_BackgroundError(interp);
	}
    }
    Tcl_Release((ClientData) interp);
    scalePtr->flags &= ~INVOKE_COMMAND;
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559

    /*
     * Much of the redisplay is done totally differently for
     * horizontal and vertical scales.  Handle the part that's
     * different.
     */

    if (scalePtr->vertical) {
	DisplayVerticalScale(scalePtr, pixmap, &drawnArea);
    } else {
	DisplayHorizontalScale(scalePtr, pixmap, &drawnArea);
    }

    /*
     * Now handle the part of redisplay that is the same for







|







549
550
551
552
553
554
555
556
557
558
559
560
561
562
563

    /*
     * Much of the redisplay is done totally differently for
     * horizontal and vertical scales.  Handle the part that's
     * different.
     */

    if (scalePtr->orient == ORIENT_VERTICAL) {
	DisplayVerticalScale(scalePtr, pixmap, &drawnArea);
    } else {
	DisplayHorizontalScale(scalePtr, pixmap, &drawnArea);
    }

    /*
     * Now handle the part of redisplay that is the same for
571
572
573
574
575
576
577
578

579
580
581
582
583
584
585
	}
	if (scalePtr->highlightWidth != 0) {
	    GC gc;
    
	    if (scalePtr->flags & GOT_FOCUS) {
		gc = Tk_GCForColor(scalePtr->highlightColorPtr, pixmap);
	    } else {
		gc = Tk_GCForColor(scalePtr->highlightBgColorPtr, pixmap);

	    }
	    Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth, pixmap);
	}
    }

    /*
     * Copy the information from the off-screen pixmap onto the screen,







|
>







575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
	}
	if (scalePtr->highlightWidth != 0) {
	    GC gc;
    
	    if (scalePtr->flags & GOT_FOCUS) {
		gc = Tk_GCForColor(scalePtr->highlightColorPtr, pixmap);
	    } else {
		gc = Tk_GCForColor(
                        Tk_3DBorderColor(scalePtr->highlightBorder), pixmap);
	    }
	    Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth, pixmap);
	}
    }

    /*
     * Copy the information from the off-screen pixmap onto the screen,
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
int
TkpScaleElement(scalePtr, x, y)
    TkScale *scalePtr;		/* Widget record for scale. */
    int x, y;			/* Coordinates within scalePtr's window. */
{
    int sliderFirst;

    if (scalePtr->vertical) {
	if ((x < scalePtr->vertTroughX)
		|| (x >= (scalePtr->vertTroughX + 2*scalePtr->borderWidth +
		scalePtr->width))) {
	    return OTHER;
	}
	if ((y < scalePtr->inset)
		|| (y >= (Tk_Height(scalePtr->tkwin) - scalePtr->inset))) {







|







622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
int
TkpScaleElement(scalePtr, x, y)
    TkScale *scalePtr;		/* Widget record for scale. */
    int x, y;			/* Coordinates within scalePtr's window. */
{
    int sliderFirst;

    if (scalePtr->orient == ORIENT_VERTICAL) {
	if ((x < scalePtr->vertTroughX)
		|| (x >= (scalePtr->vertTroughX + 2*scalePtr->borderWidth +
		scalePtr->width))) {
	    return OTHER;
	}
	if ((y < scalePtr->inset)
		|| (y >= (Tk_Height(scalePtr->tkwin) - scalePtr->inset))) {
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
    }
    scalePtr->value = value;
    if (invokeCommand) {
	scalePtr->flags |= INVOKE_COMMAND;
    }
    TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);

    if (setVar && (scalePtr->varName != NULL)) {
	sprintf(string, scalePtr->format, scalePtr->value);
	scalePtr->flags |= SETTING_VAR;
	Tcl_SetVar(scalePtr->interp, scalePtr->varName, string,
	       TCL_GLOBAL_ONLY);
	scalePtr->flags &= ~SETTING_VAR;
    }
}

/*
 *----------------------------------------------------------------------
 *







|


|
|







713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
    }
    scalePtr->value = value;
    if (invokeCommand) {
	scalePtr->flags |= INVOKE_COMMAND;
    }
    TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);

    if (setVar && (scalePtr->varNamePtr != NULL)) {
	sprintf(string, scalePtr->format, scalePtr->value);
	scalePtr->flags |= SETTING_VAR;
	Tcl_SetVar(scalePtr->interp, Tcl_GetString(scalePtr->varNamePtr), 
	        string, TCL_GLOBAL_ONLY);
	scalePtr->flags &= ~SETTING_VAR;
    }
}

/*
 *----------------------------------------------------------------------
 *
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
TkpPixelToValue(scalePtr, x, y)
    register TkScale *scalePtr;		/* Information about widget. */
    int x, y;				/* Coordinates of point within
					 * window. */
{
    double value, pixelRange;

    if (scalePtr->vertical) {
	pixelRange = Tk_Height(scalePtr->tkwin) - scalePtr->sliderLength
		- 2*scalePtr->inset - 2*scalePtr->borderWidth;
	value = y;
    } else {
	pixelRange = Tk_Width(scalePtr->tkwin) - scalePtr->sliderLength
		- 2*scalePtr->inset - 2*scalePtr->borderWidth;
	value = x;







|







749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
TkpPixelToValue(scalePtr, x, y)
    register TkScale *scalePtr;		/* Information about widget. */
    int x, y;				/* Coordinates of point within
					 * window. */
{
    double value, pixelRange;

    if (scalePtr->orient == ORIENT_VERTICAL) {
	pixelRange = Tk_Height(scalePtr->tkwin) - scalePtr->sliderLength
		- 2*scalePtr->inset - 2*scalePtr->borderWidth;
	value = y;
    } else {
	pixelRange = Tk_Width(scalePtr->tkwin) - scalePtr->sliderLength
		- 2*scalePtr->inset - 2*scalePtr->borderWidth;
	value = x;
805
806
807
808
809
810
811

812
813
814
815
816
817
818
819
    register TkScale *scalePtr;		/* Information about widget. */
    double value;			/* Reading of the widget. */
{
    int y, pixelRange;
    double valueRange;

    valueRange = scalePtr->toValue - scalePtr->fromValue;

    pixelRange = (scalePtr->vertical ? Tk_Height(scalePtr->tkwin)
	    : Tk_Width(scalePtr->tkwin)) - scalePtr->sliderLength
	    - 2*scalePtr->inset - 2*scalePtr->borderWidth;
    if (valueRange == 0) {
	y = 0;
    } else {
	y = (int) ((value - scalePtr->fromValue) * pixelRange
		  / valueRange + 0.5);







>
|







810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
    register TkScale *scalePtr;		/* Information about widget. */
    double value;			/* Reading of the widget. */
{
    int y, pixelRange;
    double valueRange;

    valueRange = scalePtr->toValue - scalePtr->fromValue;
    pixelRange = (scalePtr->orient == ORIENT_VERTICAL 
            ? Tk_Height(scalePtr->tkwin)
	    : Tk_Width(scalePtr->tkwin)) - scalePtr->sliderLength
	    - 2*scalePtr->inset - 2*scalePtr->borderWidth;
    if (valueRange == 0) {
	y = 0;
    } else {
	y = (int) ((value - scalePtr->fromValue) * pixelRange
		  / valueRange + 0.5);

Changes to unix/tkUnixScrlbr.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkUnixScrollbar.c --
 *
 *	This file implements the Unix specific portion of the scrollbar
 *	widget.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixScrlbr.c 1.8 96/12/10 20:05:07
 */

#include "tkScrollbar.h"

/*
 * Minimum slider length, in pixels (designed to make sure that the slider
 * is always easy to grab with the mouse).











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkUnixScrollbar.c --
 *
 *	This file implements the Unix specific portion of the scrollbar
 *	widget.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixScrlbr.c,v 1.1.4.1 1998/09/30 02:19:21 stanton Exp $
 */

#include "tkScrollbar.h"

/*
 * Minimum slider length, in pixels (designed to make sure that the slider
 * is always easy to grab with the mouse).

Changes to unix/tkUnixSelect.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkUnixSelect.c --
 *
 *	This file contains X specific routines for manipulating 
 *	selections.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixSelect.c 1.5 96/03/29 14:14:31
 */

#include "tkInt.h"
#include "tkSelect.h"

/*
 * When handling INCR-style selection retrievals, the selection owner






|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkUnixSelect.c --
 *
 *	This file contains X specific routines for manipulating 
 *	selections.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixSelect.c,v 1.1.4.3 1998/12/13 08:14:40 lfb Exp $
 */

#include "tkInt.h"
#include "tkSelect.h"

/*
 * When handling INCR-style selection retrievals, the selection owner
53
54
55
56
57
58
59
60

61
62


63
64
65
66
67
68
69
				 * selection at beginning of request;
				 * used to abort transfer if selection
				 * changes. */
    struct IncrInfo *nextPtr;	/* Next in list of all INCR-style
				 * retrievals currently pending. */
} IncrInfo;

static IncrInfo *pendingIncrs = NULL;

				/* List of all incr structures
				 * currently active. */



/*
 * Largest property that we'll accept when sending or receiving the
 * selection:
 */

#define MAX_PROP_WORDS 100000







|
>
|

>
>







53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
				 * selection at beginning of request;
				 * used to abort transfer if selection
				 * changes. */
    struct IncrInfo *nextPtr;	/* Next in list of all INCR-style
				 * retrievals currently pending. */
} IncrInfo;


typedef struct ThreadSpecificData {
    IncrInfo *pendingIncrs;     /* List of all incr structures
				 * currently active. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Largest property that we'll accept when sending or receiving the
 * selection:
 */

#define MAX_PROP_WORDS 100000
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
 * TkSelGetSelection --
 *
 *	Retrieve the specified selection from another process.
 *
 * Results:
 *	The return value is a standard Tcl return value.
 *	If an error occurs (such as no selection exists)
 *	then an error message is left in interp->result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */








|







97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
 * TkSelGetSelection --
 *
 *	Retrieve the specified selection from another process.
 *
 * Results:
 *	The return value is a standard Tcl return value.
 *	If an error occurs (such as no selection exists)
 *	then an error message is left in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

226
227
228
229
230
231
232


233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
    int i, format;
    Atom target, formatType;
    register TkSelHandler *selPtr;
    long buffer[TK_SEL_WORDS_AT_ONCE];
    int numItems;
    char *propPtr;
    Tk_ErrorHandler errorHandler;



    /*
     * See if this event announces the deletion of a property being
     * used for an INCR transfer.  If so, then add the next chunk of
     * data to the property.
     */

    if (eventPtr->xproperty.state != PropertyDelete) {
	return;
    }
    for (incrPtr = pendingIncrs; incrPtr != NULL;
	    incrPtr = incrPtr->nextPtr) {
	if (incrPtr->reqWindow != eventPtr->xproperty.window) {
	    continue;
	}
	for (i = 0; i < incrPtr->numConversions; i++) {
	    if ((eventPtr->xproperty.atom != incrPtr->multAtoms[2*i + 1])
		    || (incrPtr->offsets[i] == -1)){







>
>










|







229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
    int i, format;
    Atom target, formatType;
    register TkSelHandler *selPtr;
    long buffer[TK_SEL_WORDS_AT_ONCE];
    int numItems;
    char *propPtr;
    Tk_ErrorHandler errorHandler;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * See if this event announces the deletion of a property being
     * used for an INCR transfer.  If so, then add the next chunk of
     * data to the property.
     */

    if (eventPtr->xproperty.state != PropertyDelete) {
	return;
    }
    for (incrPtr = tsdPtr->pendingIncrs; incrPtr != NULL;
	    incrPtr = incrPtr->nextPtr) {
	if (incrPtr->reqWindow != eventPtr->xproperty.window) {
	    continue;
	}
	for (i = 0; i < incrPtr->numConversions; i++) {
	    if ((eventPtr->xproperty.atom != incrPtr->multAtoms[2*i + 1])
		    || (incrPtr->offsets[i] == -1)){
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
		    formatType = selPtr->format;
		    if (incrPtr->offsets[i] == -2) {
			numItems = 0;
			((char *) buffer)[0] = 0;
		    } else {
			TkSelInProgress ip;
			ip.selPtr = selPtr;
			ip.nextPtr = pendingPtr;
			pendingPtr = &ip;
			numItems = (*selPtr->proc)(selPtr->clientData,
				incrPtr->offsets[i], (char *) buffer,
				TK_SEL_BYTES_AT_ONCE);
			pendingPtr = ip.nextPtr;
			if (ip.selPtr == NULL) {
			    /*
			     * The selection handler deleted itself.
			     */

			    return;
			}







|
|



|







270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
		    formatType = selPtr->format;
		    if (incrPtr->offsets[i] == -2) {
			numItems = 0;
			((char *) buffer)[0] = 0;
		    } else {
			TkSelInProgress ip;
			ip.selPtr = selPtr;
			ip.nextPtr = TkSelGetInProgress();
			TkSelSetInProgress(&ip);
			numItems = (*selPtr->proc)(selPtr->clientData,
				incrPtr->offsets[i], (char *) buffer,
				TK_SEL_BYTES_AT_ONCE);
			TkSelSetInProgress(ip.nextPtr);
			if (ip.selPtr == NULL) {
			    /*
			     * The selection handler deleted itself.
			     */

			    return;
			}
418
419
420
421
422
423
424


425
426
427

428
429
430
431
432
433
434
	    retrPtr->result = TCL_ERROR;
	    XFree(propInfo);
	    return;
	}
	if ((type == XA_STRING) || (type == dispPtr->textAtom)
		|| (type == dispPtr->compoundTextAtom)) {
	    if (format != 8) {


		sprintf(retrPtr->interp->result,
		    "bad format for string selection: wanted \"8\", got \"%d\"",
		    format);

		retrPtr->result = TCL_ERROR;
		return;
	    }
            interp = retrPtr->interp;
            Tcl_Preserve((ClientData) interp);
	    retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
		    interp, propInfo);







>
>
|
|
|
>







423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
	    retrPtr->result = TCL_ERROR;
	    XFree(propInfo);
	    return;
	}
	if ((type == XA_STRING) || (type == dispPtr->textAtom)
		|| (type == dispPtr->compoundTextAtom)) {
	    if (format != 8) {
		char buf[64 + TCL_INTEGER_SPACE];
		
		sprintf(buf, 
			"bad format for string selection: wanted \"8\", got \"%d\"",
			format);
		Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
		retrPtr->result = TCL_ERROR;
		return;
	    }
            interp = retrPtr->interp;
            Tcl_Preserve((ClientData) interp);
	    retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
		    interp, propInfo);
452
453
454
455
456
457
458


459
460
461

462
463
464
465
466
467
468
	    }
	    Tk_DeleteEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
		    (ClientData) retrPtr);
	} else {
	    char *string;

	    if (format != 32) {


		sprintf(retrPtr->interp->result,
		    "bad format for selection: wanted \"32\", got \"%d\"",
		    format);

		retrPtr->result = TCL_ERROR;
		return;
	    }
	    string = SelCvtFromX((long *) propInfo, (int) numItems, type,
		    (Tk_Window) winPtr);
            interp = retrPtr->interp;
            Tcl_Preserve((ClientData) interp);







>
>
|
|
|
>







460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
	    }
	    Tk_DeleteEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
		    (ClientData) retrPtr);
	} else {
	    char *string;

	    if (format != 32) {
		char buf[64 + TCL_INTEGER_SPACE];
		
		sprintf(buf, 
			"bad format for selection: wanted \"32\", got \"%d\"",
			format);
		Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
		retrPtr->result = TCL_ERROR;
		return;
	    }
	    string = SelCvtFromX((long *) propInfo, (int) numItems, type,
		    (Tk_Window) winPtr);
            interp = retrPtr->interp;
            Tcl_Preserve((ClientData) interp);
576
577
578
579
580
581
582


583
584
585
586
587
588
589
    IncrInfo incr;			/* State of selection conversion. */
    Atom singleInfo[2];			/* incr.multAtoms points here except
					 * for multiple conversions. */
    int i;
    Tk_ErrorHandler errorHandler;
    TkSelectionInfo *infoPtr;
    TkSelInProgress ip;



    errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1,
	    (int (*)()) NULL, (ClientData) NULL);

    /*
     * Initialize the reply event.
     */







>
>







587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
    IncrInfo incr;			/* State of selection conversion. */
    Atom singleInfo[2];			/* incr.multAtoms points here except
					 * for multiple conversions. */
    int i;
    Tk_ErrorHandler errorHandler;
    TkSelectionInfo *infoPtr;
    TkSelInProgress ip;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1,
	    (int (*)()) NULL, (ClientData) NULL);

    /*
     * Initialize the reply event.
     */
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
		    TK_SEL_BYTES_AT_ONCE, &type);
	    if (numItems < 0) {
		incr.multAtoms[2*i + 1] = None;
		continue;
	    }
	} else {
	    ip.selPtr = selPtr;
	    ip.nextPtr = pendingPtr;
	    pendingPtr = &ip;
	    type = selPtr->format;
	    numItems = (*selPtr->proc)(selPtr->clientData, 0,
		    (char *) buffer, TK_SEL_BYTES_AT_ONCE);
	    pendingPtr = ip.nextPtr;
	    if ((ip.selPtr == NULL) || (numItems < 0)) {
		incr.multAtoms[2*i + 1] = None;
		continue;
	    }
	    if (numItems > TK_SEL_BYTES_AT_ONCE) {
		panic("selection handler returned too many bytes");
	    }







|
|



|







703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
		    TK_SEL_BYTES_AT_ONCE, &type);
	    if (numItems < 0) {
		incr.multAtoms[2*i + 1] = None;
		continue;
	    }
	} else {
	    ip.selPtr = selPtr;
	    ip.nextPtr = TkSelGetInProgress();
	    TkSelSetInProgress(&ip);
	    type = selPtr->format;
	    numItems = (*selPtr->proc)(selPtr->clientData, 0,
		    (char *) buffer, TK_SEL_BYTES_AT_ONCE);
	    TkSelSetInProgress(ip.nextPtr);
	    if ((ip.selPtr == NULL) || (numItems < 0)) {
		incr.multAtoms[2*i + 1] = None;
		continue;
	    }
	    if (numItems > TK_SEL_BYTES_AT_ONCE) {
		panic("selection handler returned too many bytes");
	    }
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
    if (incr.numIncrs > 0) {
	XSelectInput(reply.display, reply.requestor, PropertyChangeMask);
	incr.timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc,
	    (ClientData) &incr);
	incr.idleTime = 0;
	incr.reqWindow = reply.requestor;
	incr.time = infoPtr->time;
	incr.nextPtr = pendingIncrs;
	pendingIncrs = &incr;
    }
    if (multiple) {
	XChangeProperty(reply.display, reply.requestor, reply.property,
		XA_ATOM, 32, PropModeReplace,
		(unsigned char *) incr.multAtoms,
		(int) incr.numConversions*2);
    } else {







|
|







770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
    if (incr.numIncrs > 0) {
	XSelectInput(reply.display, reply.requestor, PropertyChangeMask);
	incr.timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc,
	    (ClientData) &incr);
	incr.idleTime = 0;
	incr.reqWindow = reply.requestor;
	incr.time = infoPtr->time;
	incr.nextPtr = tsdPtr->pendingIncrs;
	tsdPtr->pendingIncrs = &incr;
    }
    if (multiple) {
	XChangeProperty(reply.display, reply.requestor, reply.property,
		XA_ATOM, 32, PropModeReplace,
		(unsigned char *) incr.multAtoms,
		(int) incr.numConversions*2);
    } else {
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
	    Tcl_DoOneEvent(0);
	}
	Tcl_DeleteTimerHandler(incr.timeout);
	errorHandler = Tk_CreateErrorHandler(winPtr->display,
		-1, -1,-1, (int (*)()) NULL, (ClientData) NULL);
	XSelectInput(reply.display, reply.requestor, 0L);
	Tk_DeleteErrorHandler(errorHandler);
	if (pendingIncrs == &incr) {
	    pendingIncrs = incr.nextPtr;
	} else {
	    for (incrPtr2 = pendingIncrs; incrPtr2 != NULL;
		    incrPtr2 = incrPtr2->nextPtr) {
		if (incrPtr2->nextPtr == &incr) {
		    incrPtr2->nextPtr = incr.nextPtr;
		    break;
		}
	    }
	}







|
|

|







807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
	    Tcl_DoOneEvent(0);
	}
	Tcl_DeleteTimerHandler(incr.timeout);
	errorHandler = Tk_CreateErrorHandler(winPtr->display,
		-1, -1,-1, (int (*)()) NULL, (ClientData) NULL);
	XSelectInput(reply.display, reply.requestor, 0L);
	Tk_DeleteErrorHandler(errorHandler);
	if (tsdPtr->pendingIncrs == &incr) {
	    tsdPtr->pendingIncrs = incr.nextPtr;
	} else {
	    for (incrPtr2 = tsdPtr->pendingIncrs; incrPtr2 != NULL;
		    incrPtr2 = incrPtr2->nextPtr) {
		if (incrPtr2->nextPtr == &incr) {
		    incrPtr2->nextPtr = incr.nextPtr;
		    break;
		}
	    }
	}
887
888
889
890
891
892
893

894
895
896
897

898
899
900
901
902
903
904
905
906
907
908
909
910
911

912
913
914
915

916
917
918
919
920
921
922
    }
    if (numItems == 0) {
	retrPtr->result = TCL_OK;
    } else if ((type == XA_STRING)
	    || (type == retrPtr->winPtr->dispPtr->textAtom)
	    || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) {
	if (format != 8) {

	    Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
	    sprintf(retrPtr->interp->result,
		"bad format for string selection: wanted \"8\", got \"%d\"",
		format);

	    retrPtr->result = TCL_ERROR;
	    goto done;
	}
        interp = retrPtr->interp;
        Tcl_Preserve((ClientData) interp);
	result = (*retrPtr->proc)(retrPtr->clientData, interp, propInfo);
        Tcl_Release((ClientData) interp);
	if (result != TCL_OK) {
	    retrPtr->result = result;
	}
    } else {
	char *string;

	if (format != 32) {

	    Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
	    sprintf(retrPtr->interp->result,
		"bad format for selection: wanted \"32\", got \"%d\"",
		format);

	    retrPtr->result = TCL_ERROR;
	    goto done;
	}
	string = SelCvtFromX((long *) propInfo, (int) numItems, type,
		(Tk_Window) retrPtr->winPtr);
        interp = retrPtr->interp;
        Tcl_Preserve((ClientData) interp);







>
|
|
|
|
>














>
|
|
|
|
>







900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
    }
    if (numItems == 0) {
	retrPtr->result = TCL_OK;
    } else if ((type == XA_STRING)
	    || (type == retrPtr->winPtr->dispPtr->textAtom)
	    || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) {
	if (format != 8) {
	    char buf[64 + TCL_INTEGER_SPACE];
	    
	    sprintf(buf, 
		    "bad format for string selection: wanted \"8\", got \"%d\"",
		    format);
	    Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
	    retrPtr->result = TCL_ERROR;
	    goto done;
	}
        interp = retrPtr->interp;
        Tcl_Preserve((ClientData) interp);
	result = (*retrPtr->proc)(retrPtr->clientData, interp, propInfo);
        Tcl_Release((ClientData) interp);
	if (result != TCL_OK) {
	    retrPtr->result = result;
	}
    } else {
	char *string;

	if (format != 32) {
	    char buf[64 + TCL_INTEGER_SPACE];

	    sprintf(buf,
		    "bad format for selection: wanted \"32\", got \"%d\"",
		    format);
	    Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
	    retrPtr->result = TCL_ERROR;
	    goto done;
	}
	string = SelCvtFromX((long *) propInfo, (int) numItems, type,
		(Tk_Window) retrPtr->winPtr);
        interp = retrPtr->interp;
        Tcl_Preserve((ClientData) interp);
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
{
    char buffer[TK_SEL_BYTES_AT_ONCE+1];
    int size, chunkSize;
    TkSelInProgress ip;

    size = TK_SEL_BYTES_AT_ONCE;
    ip.selPtr = selPtr;
    ip.nextPtr = pendingPtr;
    pendingPtr = &ip;
    do {
	chunkSize = (*selPtr->proc)(selPtr->clientData, size,
			(char *) buffer, TK_SEL_BYTES_AT_ONCE);
	if (ip.selPtr == NULL) {
	    size = 0;
	    break;
	}
	size += chunkSize;
    } while (chunkSize == TK_SEL_BYTES_AT_ONCE);
    pendingPtr = ip.nextPtr;
    return size;
}

/*
 *----------------------------------------------------------------------
 *
 * IncrTimeoutProc --







|
|









|







977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
{
    char buffer[TK_SEL_BYTES_AT_ONCE+1];
    int size, chunkSize;
    TkSelInProgress ip;

    size = TK_SEL_BYTES_AT_ONCE;
    ip.selPtr = selPtr;
    ip.nextPtr = TkSelGetInProgress();
    TkSelSetInProgress(&ip);
    do {
	chunkSize = (*selPtr->proc)(selPtr->clientData, size,
			(char *) buffer, TK_SEL_BYTES_AT_ONCE);
	if (ip.selPtr == NULL) {
	    size = 0;
	    break;
	}
	size += chunkSize;
    } while (chunkSize == TK_SEL_BYTES_AT_ONCE);
    TkSelSetInProgress(ip.nextPtr);
    return size;
}

/*
 *----------------------------------------------------------------------
 *
 * IncrTimeoutProc --

Changes to unix/tkUnixSend.c.

1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkUnixSend.c --
 *
 *	This file provides procedures that implement the "send"
 *	command, allowing commands to be passed from interpreter
 *	to interpreter.
 *
 * Copyright (c) 1989-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixSend.c 1.74 97/11/04 17:12:18
 */

#include "tkPort.h"
#include "tkInt.h"
#include "tkUnixInt.h"

/* 









>




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
/* 
 * tkUnixSend.c --
 *
 *	This file provides procedures that implement the "send"
 *	command, allowing commands to be passed from interpreter
 *	to interpreter.
 *
 * Copyright (c) 1989-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixSend.c,v 1.1.4.5 1999/02/12 01:09:02 stanton Exp $
 */

#include "tkPort.h"
#include "tkInt.h"
#include "tkUnixInt.h"

/* 
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
				 * been deleted. */
    struct RegisteredInterp *nextPtr;
				/* Next in list of names associated
				 * with interps in this process.
				 * NULL means end of list. */
} RegisteredInterp;

static RegisteredInterp *registry = NULL;
				/* List of all interpreters
				 * registered by this process. */

/*
 * A registry of all interpreters for a display is kept in a
 * property "InterpRegistry" on the root window of the display.
 * It is organized as a series of zero or more concatenated strings
 * (in no particular order), each of the form
 * 	window space name '\0'
 * where "window" is the hex id of the comm. window to use to talk







<
<
<
<







36
37
38
39
40
41
42




43
44
45
46
47
48
49
				 * been deleted. */
    struct RegisteredInterp *nextPtr;
				/* Next in list of names associated
				 * with interps in this process.
				 * NULL means end of list. */
} RegisteredInterp;





/*
 * A registry of all interpreters for a display is kept in a
 * property "InterpRegistry" on the root window of the display.
 * It is organized as a series of zero or more concatenated strings
 * (in no particular order), each of the form
 * 	window space name '\0'
 * where "window" is the hex id of the comm. window to use to talk
105
106
107
108
109
110
111

112
113
114





115
116
117
118
119
120
121
				 * 0 means the command is still outstanding. */
    struct PendingCommand *nextPtr;
				/* Next in list of all outstanding
				 * commands.  NULL means end of
				 * list. */
} PendingCommand;


static PendingCommand *pendingCommands = NULL;
				/* List of all commands currently
				 * being waited for. */






/*
 * The information below is used for communication between processes
 * during "send" commands.  Each process keeps a private window, never
 * even mapped, with one property, "Comm".  When a command is sent to
 * an interpreter, the command is appended to the comm property of the
 * communication window associated with the interp's process.  Similarly,







>
|
|

>
>
>
>
>







102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
				 * 0 means the command is still outstanding. */
    struct PendingCommand *nextPtr;
				/* Next in list of all outstanding
				 * commands.  NULL means end of
				 * list. */
} PendingCommand;

typedef struct ThreadSpecificData {
    PendingCommand *pendingCommands;				
                                /* List of all commands currently
				 * being waited for. */
    RegisteredInterp *interpListPtr;
                                /* List of all interpreters registered
				 * in the current process. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * The information below is used for communication between processes
 * during "send" commands.  Each process keeps a private window, never
 * even mapped, with one property, "Comm".  When a command is sent to
 * an interpreter, the command is appended to the comm property of the
 * communication window associated with the interp's process.  Similarly,
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
 * Results:
 *	The return value is a pointer to the loaded registry.
 *
 * Side effects:
 *	If "lock" is set then the server will be locked.  It is the
 *	caller's responsibility to call RegClose when finished with
 *	the registry, so that we can write back the registry if
 *	neeeded, unlock the server if needed, and free memory.
 *
 *----------------------------------------------------------------------
 */

static NameRegistry *
RegOpen(interp, dispPtr, lock)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting







|







254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
 * Results:
 *	The return value is a pointer to the loaded registry.
 *
 * Side effects:
 *	If "lock" is set then the server will be locked.  It is the
 *	caller's responsibility to call RegClose when finished with
 *	the registry, so that we can write back the registry if
 *	needed, unlock the server if needed, and free memory.
 *
 *----------------------------------------------------------------------
 */

static NameRegistry *
RegOpen(interp, dispPtr, lock)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting
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
				 * refer to the interpreter in later
				 * "send" commands.  Must be globally
				 * unique. */
{
    RegisteredInterp *riPtr, *riPtr2;
    Window w;
    TkWindow *winPtr = (TkWindow *) tkwin;
    TkDisplay *dispPtr;
    NameRegistry *regPtr;
    Tcl_Interp *interp;
    char *actualName;
    Tcl_DString dString;
    int offset, i;

#ifdef __WIN32__
    return name;
#endif /* __WIN32__ */
    
    dispPtr = winPtr->dispPtr;
    interp = winPtr->mainPtr->interp;
    if (dispPtr->commTkwin == NULL) {
	SendInit(interp, winPtr->dispPtr);
    }

    /*
     * See if the application is already registered;  if so, remove its
     * current name from the registry.
     */

    regPtr = RegOpen(interp, winPtr->dispPtr, 1);
    for (riPtr = registry; ; riPtr = riPtr->nextPtr) {
	if (riPtr == NULL) {

	    /*
	     * This interpreter isn't currently registered;  create
	     * the data structure that will be used to register it locally,
	     * plus add the "send" command to the interpreter.
	     */

	    riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
	    riPtr->interp = interp;
	    riPtr->dispPtr = winPtr->dispPtr;
	    riPtr->nextPtr = registry;
	    registry = riPtr;

	    Tcl_CreateCommand(interp, "send", Tk_SendCmd, (ClientData) riPtr,
		    DeleteProc);
            if (Tcl_IsSafe(interp)) {
                Tcl_HideCommand(interp, "send", "send");
            }
	    break;
	}
	if (riPtr->interp == interp) {
	    /*
	     * The interpreter is currently registered;  remove it from
	     * the name registry.
	     */


	    RegDeleteName(regPtr, riPtr->name);
	    ckfree(riPtr->name);

	    break;
	}
    }

    /*
     * Pick a name to use for the application.  Use "name" if it's not
     * already in use.  Otherwise add a suffix such as " #2", trying







|





|
|
<
<
|
<











|











|
|
>













>
|
|
>







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
				 * refer to the interpreter in later
				 * "send" commands.  Must be globally
				 * unique. */
{
    RegisteredInterp *riPtr, *riPtr2;
    Window w;
    TkWindow *winPtr = (TkWindow *) tkwin;
    TkDisplay *dispPtr = winPtr->dispPtr;
    NameRegistry *regPtr;
    Tcl_Interp *interp;
    char *actualName;
    Tcl_DString dString;
    int offset, i;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));




    interp = winPtr->mainPtr->interp;
    if (dispPtr->commTkwin == NULL) {
	SendInit(interp, winPtr->dispPtr);
    }

    /*
     * See if the application is already registered;  if so, remove its
     * current name from the registry.
     */

    regPtr = RegOpen(interp, winPtr->dispPtr, 1);
    for (riPtr = tsdPtr->interpListPtr; ; riPtr = riPtr->nextPtr) {
	if (riPtr == NULL) {

	    /*
	     * This interpreter isn't currently registered;  create
	     * the data structure that will be used to register it locally,
	     * plus add the "send" command to the interpreter.
	     */

	    riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
	    riPtr->interp = interp;
	    riPtr->dispPtr = winPtr->dispPtr;
	    riPtr->nextPtr = tsdPtr->interpListPtr;
	    tsdPtr->interpListPtr = riPtr;
	    riPtr->name = NULL;
	    Tcl_CreateCommand(interp, "send", Tk_SendCmd, (ClientData) riPtr,
		    DeleteProc);
            if (Tcl_IsSafe(interp)) {
                Tcl_HideCommand(interp, "send", "send");
            }
	    break;
	}
	if (riPtr->interp == interp) {
	    /*
	     * The interpreter is currently registered;  remove it from
	     * the name registry.
	     */

	    if (riPtr->name) {
		RegDeleteName(regPtr, riPtr->name);
		ckfree(riPtr->name);
	    }
	    break;
	}
    }

    /*
     * Pick a name to use for the application.  Use "name" if it's not
     * already in use.  Otherwise add a suffix such as " #2", trying
831
832
833
834
835
836
837

838
839
840
841
842
843
844
845
	/*
	 * The name appears to be in use already, but double-check to
	 * be sure (perhaps the application died without removing its
	 * name from the registry?).
	 */

	if (w == Tk_WindowId(dispPtr->commTkwin)) {

	    for (riPtr2 = registry; riPtr2 != NULL; riPtr2 = riPtr2->nextPtr) {
		if ((riPtr2->interp != interp) &&
			(strcmp(riPtr2->name, actualName) == 0)) {
		    goto nextSuffix;
		}
	    }
	    RegDeleteName(regPtr, actualName);
	    break;







>
|







834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
	/*
	 * The name appears to be in use already, but double-check to
	 * be sure (perhaps the application died without removing its
	 * name from the registry?).
	 */

	if (w == Tk_WindowId(dispPtr->commTkwin)) {
	    for (riPtr2 = tsdPtr->interpListPtr; riPtr2 != NULL; 
                    riPtr2 = riPtr2->nextPtr) {
		if ((riPtr2->interp != interp) &&
			(strcmp(riPtr2->name, actualName) == 0)) {
		    goto nextSuffix;
		}
	    }
	    RegDeleteName(regPtr, actualName);
	    break;
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909


910
911
912
913
914
915
916
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    TkWindow *winPtr;
    Window commWindow;
    PendingCommand pending;
    register RegisteredInterp *riPtr;
    char *destName, buffer[30];
    int result, c, async, i, firstArg;
    size_t length;
    Tk_RestrictProc *prevRestrictProc;
    ClientData prevArg;
    TkDisplay *dispPtr;
    Tcl_Time timeout;
    NameRegistry *regPtr;
    Tcl_DString request;


    Tcl_Interp *localInterp;		/* Used when the interpreter to
                                         * send the command to is within
                                         * the same process. */

    /*
     * Process options, if any.
     */







|








>
>







898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    TkWindow *winPtr;
    Window commWindow;
    PendingCommand pending;
    register RegisteredInterp *riPtr;
    char *destName;
    int result, c, async, i, firstArg;
    size_t length;
    Tk_RestrictProc *prevRestrictProc;
    ClientData prevArg;
    TkDisplay *dispPtr;
    Tcl_Time timeout;
    NameRegistry *regPtr;
    Tcl_DString request;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    Tcl_Interp *localInterp;		/* Used when the interpreter to
                                         * send the command to is within
                                         * the same process. */

    /*
     * Process options, if any.
     */
964
965
966
967
968
969
970

971
972
973
974
975
976
977
978
     * See if the target interpreter is local.  If so, execute
     * the command directly without going through the X server.
     * The only tricky thing is passing the result from the target
     * interpreter to the invoking interpreter.  Watch out:  they
     * could be the same!
     */


    for (riPtr = registry; riPtr != NULL; riPtr = riPtr->nextPtr) {
	if ((riPtr->dispPtr != dispPtr)
		|| (strcmp(riPtr->name, destName) != 0)) {
	    continue;
	}
	Tcl_Preserve((ClientData) riPtr);
        localInterp = riPtr->interp;
        Tcl_Preserve((ClientData) localInterp);







>
|







970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
     * See if the target interpreter is local.  If so, execute
     * the command directly without going through the X server.
     * The only tricky thing is passing the result from the target
     * interpreter to the invoking interpreter.  Watch out:  they
     * could be the same!
     */

    for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; 
            riPtr = riPtr->nextPtr) {
	if ((riPtr->dispPtr != dispPtr)
		|| (strcmp(riPtr->name, destName) != 0)) {
	    continue;
	}
	Tcl_Preserve((ClientData) riPtr);
        localInterp = riPtr->interp;
        Tcl_Preserve((ClientData) localInterp);
986
987
988
989
990
991
992

993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008

1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
		Tcl_DStringAppend(&request, argv[i], -1);
	    }
	    result = Tcl_GlobalEval(localInterp, Tcl_DStringValue(&request));
	    Tcl_DStringFree(&request);
	}
	if (interp != localInterp) {
	    if (result == TCL_ERROR) {


		/*
		 * An error occurred, so transfer error information from the
		 * destination interpreter back to our interpreter.  Must clear
		 * interp's result before calling Tcl_AddErrorInfo, since
		 * Tcl_AddErrorInfo will store the interp's result in errorInfo
		 * before appending riPtr's $errorInfo;  we've already got
		 * everything we need in riPtr's $errorInfo.
		 */

		Tcl_ResetResult(interp);
		Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp,
			"errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
		Tcl_SetVar2(interp, "errorCode", (char *) NULL,
			Tcl_GetVar2(localInterp, "errorCode", (char *) NULL,
			TCL_GLOBAL_ONLY), TCL_GLOBAL_ONLY);

	    }
            if (localInterp->freeProc != TCL_STATIC) {
                interp->result = localInterp->result;
                interp->freeProc = localInterp->freeProc;
                localInterp->freeProc = TCL_STATIC;
            } else {
                Tcl_SetResult(interp, localInterp->result, TCL_VOLATILE);
            }
            Tcl_ResetResult(localInterp);
	}
	Tcl_Release((ClientData) riPtr);
        Tcl_Release((ClientData) localInterp);
	return result;
    }








>













<
|
|
>

<
<
<
<
<
|
<







993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013

1014
1015
1016
1017





1018

1019
1020
1021
1022
1023
1024
1025
		Tcl_DStringAppend(&request, argv[i], -1);
	    }
	    result = Tcl_GlobalEval(localInterp, Tcl_DStringValue(&request));
	    Tcl_DStringFree(&request);
	}
	if (interp != localInterp) {
	    if (result == TCL_ERROR) {
		Tcl_Obj *errorObjPtr;

		/*
		 * An error occurred, so transfer error information from the
		 * destination interpreter back to our interpreter.  Must clear
		 * interp's result before calling Tcl_AddErrorInfo, since
		 * Tcl_AddErrorInfo will store the interp's result in errorInfo
		 * before appending riPtr's $errorInfo;  we've already got
		 * everything we need in riPtr's $errorInfo.
		 */

		Tcl_ResetResult(interp);
		Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp,
			"errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));

		errorObjPtr = Tcl_GetVar2Ex(localInterp, "errorCode", NULL,
			TCL_GLOBAL_ONLY);
		Tcl_SetObjErrorCode(interp, errorObjPtr);
	    }





	    Tcl_SetObjResult(interp, Tcl_GetObjResult(localInterp));

            Tcl_ResetResult(localInterp);
	}
	Tcl_Release((ClientData) riPtr);
        Tcl_Release((ClientData) localInterp);
	return result;
    }

1040
1041
1042
1043
1044
1045
1046


1047
1048
1049
1050
1051
1052
1053
     */

    tkSendSerial++;
    Tcl_DStringInit(&request);
    Tcl_DStringAppend(&request, "\0c\0-n ", 6);
    Tcl_DStringAppend(&request, destName, -1);
    if (!async) {


	sprintf(buffer, "%x %d",
		(unsigned int) Tk_WindowId(dispPtr->commTkwin),
		tkSendSerial);
	Tcl_DStringAppend(&request, "\0-r ", 4);
	Tcl_DStringAppend(&request, buffer, -1);
    }
    Tcl_DStringAppend(&request, "\0-s ", 4);







>
>







1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
     */

    tkSendSerial++;
    Tcl_DStringInit(&request);
    Tcl_DStringAppend(&request, "\0c\0-n ", 6);
    Tcl_DStringAppend(&request, destName, -1);
    if (!async) {
	char buffer[TCL_INTEGER_SPACE * 2];

	sprintf(buffer, "%x %d",
		(unsigned int) Tk_WindowId(dispPtr->commTkwin),
		tkSendSerial);
	Tcl_DStringAppend(&request, "\0-r ", 4);
	Tcl_DStringAppend(&request, buffer, -1);
    }
    Tcl_DStringAppend(&request, "\0-s ", 4);
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
    pending.target = destName;
    pending.commWindow = commWindow;
    pending.interp = interp;
    pending.result = NULL;
    pending.errorInfo = NULL;
    pending.errorCode = NULL;
    pending.gotResponse = 0;
    pending.nextPtr = pendingCommands;
    pendingCommands = &pending;

    /*
     * Enter a loop processing X events until the result comes
     * in or the target is declared to be dead.  While waiting
     * for a result, look only at send-related events so that
     * the send is synchronous with respect to other events in
     * the application.







|
|







1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
    pending.target = destName;
    pending.commWindow = commWindow;
    pending.interp = interp;
    pending.result = NULL;
    pending.errorInfo = NULL;
    pending.errorCode = NULL;
    pending.gotResponse = 0;
    pending.nextPtr = tsdPtr->pendingCommands;
    tsdPtr->pendingCommands = &pending;

    /*
     * Enter a loop processing X events until the result comes
     * in or the target is declared to be dead.  While waiting
     * for a result, look only at send-related events so that
     * the send is synchronous with respect to other events in
     * the application.
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155

1156
1157

1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
    (void) Tk_RestrictEvents(prevRestrictProc, prevArg, &prevArg);

    /*
     * Unregister the information about the pending command
     * and return the result.
     */

    if (pendingCommands != &pending) {
	panic("Tk_SendCmd: corrupted send stack");
    }
    pendingCommands = pending.nextPtr;
    if (pending.errorInfo != NULL) {
	/*
	 * Special trick: must clear the interp's result before calling
	 * Tcl_AddErrorInfo, since Tcl_AddErrorInfo will store the interp's
	 * result in errorInfo before appending pending.errorInfo;  we've
	 * already got everything we need in pending.errorInfo.
	 */

	Tcl_ResetResult(interp);
	Tcl_AddErrorInfo(interp, pending.errorInfo);
	ckfree(pending.errorInfo);
    }
    if (pending.errorCode != NULL) {

	Tcl_SetVar2(interp, "errorCode", (char *) NULL, pending.errorCode,
		TCL_GLOBAL_ONLY);

	ckfree(pending.errorCode);
    }
    Tcl_SetResult(interp, pending.result, TCL_DYNAMIC);
    return pending.code;
}

/*
 *----------------------------------------------------------------------
 *
 * TkGetInterpNames --
 *
 *	This procedure is invoked to fetch a list of all the
 *	interpreter names currently registered for the display
 *	of a particular window.
 *
 * Results:
 *	A standard Tcl return value.  Interp->result will be set
 *	to hold a list of all the interpreter names defined for
 *	tkwin's display.  If an error occurs, then TCL_ERROR
 *	is returned and interp->result will hold an error message.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */








|


|













>
|
<
>
















|


|







1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161

1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
    (void) Tk_RestrictEvents(prevRestrictProc, prevArg, &prevArg);

    /*
     * Unregister the information about the pending command
     * and return the result.
     */

    if (tsdPtr->pendingCommands != &pending) {
	panic("Tk_SendCmd: corrupted send stack");
    }
    tsdPtr->pendingCommands = pending.nextPtr;
    if (pending.errorInfo != NULL) {
	/*
	 * Special trick: must clear the interp's result before calling
	 * Tcl_AddErrorInfo, since Tcl_AddErrorInfo will store the interp's
	 * result in errorInfo before appending pending.errorInfo;  we've
	 * already got everything we need in pending.errorInfo.
	 */

	Tcl_ResetResult(interp);
	Tcl_AddErrorInfo(interp, pending.errorInfo);
	ckfree(pending.errorInfo);
    }
    if (pending.errorCode != NULL) {
	Tcl_Obj *errorObjPtr;
	errorObjPtr = Tcl_NewStringObj(pending.errorCode, -1);

	Tcl_SetObjErrorCode(interp, errorObjPtr);
	ckfree(pending.errorCode);
    }
    Tcl_SetResult(interp, pending.result, TCL_DYNAMIC);
    return pending.code;
}

/*
 *----------------------------------------------------------------------
 *
 * TkGetInterpNames --
 *
 *	This procedure is invoked to fetch a list of all the
 *	interpreter names currently registered for the display
 *	of a particular window.
 *
 * Results:
 *	A standard Tcl return value.  The interp's result will be set
 *	to hold a list of all the interpreter names defined for
 *	tkwin's display.  If an error occurs, then TCL_ERROR
 *	is returned and the interp's result will hold an error message.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

1335
1336
1337
1338
1339
1340
1341


1342
1343
1344
1345
1346
1347
1348
    TkDisplay *dispPtr = (TkDisplay *) clientData;
    char *propInfo;
    register char *p;
    int result, actualFormat;
    unsigned long numItems, bytesAfter;
    Atom actualType;
    Tcl_Interp *remoteInterp;	/* Interp in which to execute the command. */



    if ((eventPtr->xproperty.atom != dispPtr->commProperty)
	    || (eventPtr->xproperty.state != PropertyNewValue)) {
	return;
    }

    /*







>
>







1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
    TkDisplay *dispPtr = (TkDisplay *) clientData;
    char *propInfo;
    register char *p;
    int result, actualFormat;
    unsigned long numItems, bytesAfter;
    Atom actualType;
    Tcl_Interp *remoteInterp;	/* Interp in which to execute the command. */
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if ((eventPtr->xproperty.atom != dispPtr->commProperty)
	    || (eventPtr->xproperty.state != PropertyNewValue)) {
	return;
    }

    /*
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
		goto returnResult;
	    }

	    /*
	     * Locate the application, then execute the script.
	     */

	    for (riPtr = registry; ; riPtr = riPtr->nextPtr) {
		if (riPtr == NULL) {
		    if (commWindow != None) {
			Tcl_DStringAppend(&reply,
				"receiver never heard of interpreter \"", -1);
			Tcl_DStringAppend(&reply, interpName, -1);
			Tcl_DStringAppend(&reply, "\"", 1);
		    }







|







1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
		goto returnResult;
	    }

	    /*
	     * Locate the application, then execute the script.
	     */

	    for (riPtr = tsdPtr->interpListPtr; ; riPtr = riPtr->nextPtr) {
		if (riPtr == NULL) {
		    if (commWindow != None) {
			Tcl_DStringAppend(&reply,
				"receiver never heard of interpreter \"", -1);
			Tcl_DStringAppend(&reply, interpName, -1);
			Tcl_DStringAppend(&reply, "\"", 1);
		    }
1494
1495
1496
1497
1498
1499
1500
1501

1502
1503
1504
1505
1506
1507
1508
             * The call to Tcl_Release may have released the interpreter
             * which will cause the "send" command for that interpreter
             * to be deleted. The command deletion callback will set the
             * riPtr->interp field to NULL, hence the check below for NULL.
             */

	    if (commWindow != None) {
		Tcl_DStringAppend(&reply, remoteInterp->result, -1);

		if (result == TCL_ERROR) {
		    char *varValue;
    
		    varValue = Tcl_GetVar2(remoteInterp, "errorInfo",
			    (char *) NULL, TCL_GLOBAL_ONLY);
		    if (varValue != NULL) {
			Tcl_DStringAppend(&reply, "\0-i ", 4);







|
>







1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
             * The call to Tcl_Release may have released the interpreter
             * which will cause the "send" command for that interpreter
             * to be deleted. The command deletion callback will set the
             * riPtr->interp field to NULL, hence the check below for NULL.
             */

	    if (commWindow != None) {
		Tcl_DStringAppend(&reply, Tcl_GetStringResult(remoteInterp),
			-1);
		if (result == TCL_ERROR) {
		    char *varValue;
    
		    varValue = Tcl_GetVar2(remoteInterp, "errorInfo",
			    (char *) NULL, TCL_GLOBAL_ONLY);
		    if (varValue != NULL) {
			Tcl_DStringAppend(&reply, "\0-i ", 4);
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
	     * call).  Right now reply has everything but the completion
	     * code, but it needs the NULL to terminate the current option.
	     */

	    returnResult:
	    if (commWindow != None) {
		if (result != TCL_OK) {
		    char buffer[20];
    
		    sprintf(buffer, "%d", result);
		    Tcl_DStringAppend(&reply, "\0-c ", 4);
		    Tcl_DStringAppend(&reply, buffer, -1);
		}
		(void) AppendPropCarefully(dispPtr->display, commWindow,
			dispPtr->commProperty, Tcl_DStringValue(&reply),







|







1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
	     * call).  Right now reply has everything but the completion
	     * code, but it needs the NULL to terminate the current option.
	     */

	    returnResult:
	    if (commWindow != None) {
		if (result != TCL_OK) {
		    char buffer[TCL_INTEGER_SPACE];
    
		    sprintf(buffer, "%d", result);
		    Tcl_DStringAppend(&reply, "\0-c ", 4);
		    Tcl_DStringAppend(&reply, buffer, -1);
		}
		(void) AppendPropCarefully(dispPtr->display, commWindow,
			dispPtr->commProperty, Tcl_DStringValue(&reply),
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
	    }

	    /*
	     * Give the result information to anyone who's
	     * waiting for it.
	     */

	    for (pcPtr = pendingCommands; pcPtr != NULL;
		    pcPtr = pcPtr->nextPtr) {
		if ((serial != pcPtr->serial) || (pcPtr->result != NULL)) {
		    continue;
		}
		pcPtr->code = code;
		if (resultString != NULL) {
		    pcPtr->result = (char *) ckalloc((unsigned)







|







1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
	    }

	    /*
	     * Give the result information to anyone who's
	     * waiting for it.
	     */

	    for (pcPtr = tsdPtr->pendingCommands; pcPtr != NULL;
		    pcPtr = pcPtr->nextPtr) {
		if ((serial != pcPtr->serial) || (pcPtr->result != NULL)) {
		    continue;
		}
		pcPtr->code = code;
		if (resultString != NULL) {
		    pcPtr->result = (char *) ckalloc((unsigned)
1698
1699
1700
1701
1702
1703
1704


1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
static int
AppendErrorProc(clientData, errorPtr)
    ClientData clientData;	/* Command to mark complete, or NULL. */
    XErrorEvent *errorPtr;	/* Information about error. */
{
    PendingCommand *pendingPtr = (PendingCommand *) clientData;
    register PendingCommand *pcPtr;



    if (pendingPtr == NULL) {
	return 0;
    }

    /*
     * Make sure this command is still pending.
     */

    for (pcPtr = pendingCommands; pcPtr != NULL;
	    pcPtr = pcPtr->nextPtr) {
	if ((pcPtr == pendingPtr) && (pcPtr->result == NULL)) {
	    pcPtr->result = (char *) ckalloc((unsigned)
		    (strlen(pcPtr->target) + 50));
	    sprintf(pcPtr->result, "no application named \"%s\"",
		    pcPtr->target);
	    pcPtr->code = TCL_ERROR;







>
>









|







1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
static int
AppendErrorProc(clientData, errorPtr)
    ClientData clientData;	/* Command to mark complete, or NULL. */
    XErrorEvent *errorPtr;	/* Information about error. */
{
    PendingCommand *pendingPtr = (PendingCommand *) clientData;
    register PendingCommand *pcPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (pendingPtr == NULL) {
	return 0;
    }

    /*
     * Make sure this command is still pending.
     */

    for (pcPtr = tsdPtr->pendingCommands; pcPtr != NULL;
	    pcPtr = pcPtr->nextPtr) {
	if ((pcPtr == pendingPtr) && (pcPtr->result == NULL)) {
	    pcPtr->result = (char *) ckalloc((unsigned)
		    (strlen(pcPtr->target) + 50));
	    sprintf(pcPtr->result, "no application named \"%s\"",
		    pcPtr->target);
	    pcPtr->code = TCL_ERROR;
1747
1748
1749
1750
1751
1752
1753


1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
DeleteProc(clientData)
    ClientData clientData;	/* Info about registration, passed
				 * as ClientData. */
{
    RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
    register RegisteredInterp *riPtr2;
    NameRegistry *regPtr;



    regPtr = RegOpen(riPtr->interp, riPtr->dispPtr, 1);
    RegDeleteName(regPtr, riPtr->name);
    RegClose(regPtr);

    if (registry == riPtr) {
	registry = riPtr->nextPtr;
    } else {
	for (riPtr2 = registry; riPtr2 != NULL;
		riPtr2 = riPtr2->nextPtr) {
	    if (riPtr2->nextPtr == riPtr) {
		riPtr2->nextPtr = riPtr->nextPtr;
		break;
	    }
	}
    }







>
>





|
|

|







1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
DeleteProc(clientData)
    ClientData clientData;	/* Info about registration, passed
				 * as ClientData. */
{
    RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
    register RegisteredInterp *riPtr2;
    NameRegistry *regPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    regPtr = RegOpen(riPtr->interp, riPtr->dispPtr, 1);
    RegDeleteName(regPtr, riPtr->name);
    RegClose(regPtr);

    if (tsdPtr->interpListPtr == riPtr) {
	tsdPtr->interpListPtr = riPtr->nextPtr;
    } else {
	for (riPtr2 = tsdPtr->interpListPtr; riPtr2 != NULL;
		riPtr2 = riPtr2->nextPtr) {
	    if (riPtr2->nextPtr == riPtr) {
		riPtr2->nextPtr = riPtr->nextPtr;
		break;
	    }
	}
    }
1799
1800
1801
1802
1803
1804
1805

1806
1807
1808
1809
1810
1811
1812
1813
    register XEvent *eventPtr;		/* Event that just arrived. */
{
    TkDisplay *dispPtr;

    if (eventPtr->type != PropertyNotify) {
	return TK_DEFER_EVENT;
    }

    for (dispPtr = tkDisplayList; dispPtr != NULL; dispPtr = dispPtr->nextPtr) {
	if ((eventPtr->xany.display == dispPtr->display)
		&& (eventPtr->xproperty.window
		== Tk_WindowId(dispPtr->commTkwin))) {
	    return TK_PROCESS_EVENT;
	}
    }
    return TK_DEFER_EVENT;







>
|







1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
    register XEvent *eventPtr;		/* Event that just arrived. */
{
    TkDisplay *dispPtr;

    if (eventPtr->type != PropertyNotify) {
	return TK_DEFER_EVENT;
    }
    for (dispPtr = TkGetDisplayList(); dispPtr != NULL; 
            dispPtr = dispPtr->nextPtr) {
	if ((eventPtr->xany.display == dispPtr->display)
		&& (eventPtr->xproperty.window
		== Tk_WindowId(dispPtr->commTkwin))) {
	    return TK_PROCESS_EVENT;
	}
    }
    return TK_DEFER_EVENT;
1834
1835
1836
1837
1838
1839
1840


1841
1842

1843
1844
1845
1846
1847
1848
1849
1850
1851
static void
UpdateCommWindow(dispPtr)
    TkDisplay *dispPtr;		/* Display whose commWindow is to be
				 * updated. */
{
    Tcl_DString names;
    RegisteredInterp *riPtr;



    Tcl_DStringInit(&names);

    for (riPtr = registry; riPtr != NULL; riPtr = riPtr->nextPtr) {
	Tcl_DStringAppendElement(&names, riPtr->name);
    }
    XChangeProperty(dispPtr->display, Tk_WindowId(dispPtr->commTkwin),
	    dispPtr->appNameProperty, XA_STRING, 8, PropModeReplace,
	    (unsigned char *) Tcl_DStringValue(&names),
	    Tcl_DStringLength(&names));
    Tcl_DStringFree(&names);
}







>
>


>
|








1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
static void
UpdateCommWindow(dispPtr)
    TkDisplay *dispPtr;		/* Display whose commWindow is to be
				 * updated. */
{
    Tcl_DString names;
    RegisteredInterp *riPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    Tcl_DStringInit(&names);
    for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; 
            riPtr = riPtr->nextPtr) {
	Tcl_DStringAppendElement(&names, riPtr->name);
    }
    XChangeProperty(dispPtr->display, Tk_WindowId(dispPtr->commTkwin),
	    dispPtr->appNameProperty, XA_STRING, 8, PropModeReplace,
	    (unsigned char *) Tcl_DStringValue(&names),
	    Tcl_DStringLength(&names));
    Tcl_DStringFree(&names);
}

Changes to unix/tkUnixWm.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixWm.c 1.155 97/10/28 08:35:19
 */

#include "tkPort.h"
#include "tkInt.h"
#include "tkUnixInt.h"
#include <errno.h>








|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixWm.c,v 1.1.4.4 1999/04/06 23:22:23 redman Exp $
 */

#include "tkPort.h"
#include "tkInt.h"
#include "tkUnixInt.h"
#include <errno.h>

262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
#define WM_COLORMAPS_EXPLICIT		0x400
#define WM_ADDED_TOPLEVEL_COLORMAP	0x800
#define WM_WIDTH_NOT_RESIZABLE		0x1000
#define WM_HEIGHT_NOT_RESIZABLE		0x2000

/*
 * This module keeps a list of all top-level windows, primarily to
 * simplify the job of Tk_CoordsToWindow.
 */

static WmInfo *firstWmPtr = NULL;	/* Points to first top-level window. */


/*
 * The variable below is used to enable or disable tracing in this
 * module.  If tracing is enabled, then information is printed on
 * standard output about interesting interactions with the window
 * manager.
 */

static int wmTracing = 0;

/*
 * The following structures are the official type records for geometry
 * management of top-level and menubar windows.
 */

static void		TopLevelReqProc _ANSI_ARGS_((ClientData dummy,







|
<
|
<
<
<
<
<
<
<
<

<
<







262
263
264
265
266
267
268
269

270








271


272
273
274
275
276
277
278
#define WM_COLORMAPS_EXPLICIT		0x400
#define WM_ADDED_TOPLEVEL_COLORMAP	0x800
#define WM_WIDTH_NOT_RESIZABLE		0x1000
#define WM_HEIGHT_NOT_RESIZABLE		0x2000

/*
 * This module keeps a list of all top-level windows, primarily to
 * simplify the job of Tk_CoordsToWindow.  The list is called 

 * firstWmPtr and is stored in the TkDisplay structure.








 */



/*
 * The following structures are the official type records for geometry
 * management of top-level and menubar windows.
 */

static void		TopLevelReqProc _ANSI_ARGS_((ClientData dummy,
332
333
334
335
336
337
338

339
340
341
342
343
344
345
			    XEvent *eventPtr));
static int		ParseGeometry _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, TkWindow *winPtr));
static void		ReparentEvent _ANSI_ARGS_((WmInfo *wmPtr,
			    XReparentEvent *eventPtr));
static void		TopLevelReqProc _ANSI_ARGS_((ClientData dummy,
			    Tk_Window tkwin));

static void		UpdateGeometryInfo _ANSI_ARGS_((
			    ClientData clientData));
static void		UpdateHints _ANSI_ARGS_((TkWindow *winPtr));
static void		UpdateSizeHints _ANSI_ARGS_((TkWindow *winPtr));
static void		UpdateVRootGeometry _ANSI_ARGS_((WmInfo *wmPtr));
static void		UpdateWmProtocols _ANSI_ARGS_((WmInfo *wmPtr));
static void		WaitForConfigureNotify _ANSI_ARGS_((TkWindow *winPtr,







>







321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
			    XEvent *eventPtr));
static int		ParseGeometry _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, TkWindow *winPtr));
static void		ReparentEvent _ANSI_ARGS_((WmInfo *wmPtr,
			    XReparentEvent *eventPtr));
static void		TopLevelReqProc _ANSI_ARGS_((ClientData dummy,
			    Tk_Window tkwin));
static void		UpdateCommand _ANSI_ARGS_((TkWindow *winPtr));
static void		UpdateGeometryInfo _ANSI_ARGS_((
			    ClientData clientData));
static void		UpdateHints _ANSI_ARGS_((TkWindow *winPtr));
static void		UpdateSizeHints _ANSI_ARGS_((TkWindow *winPtr));
static void		UpdateVRootGeometry _ANSI_ARGS_((WmInfo *wmPtr));
static void		UpdateWmProtocols _ANSI_ARGS_((WmInfo *wmPtr));
static void		WaitForConfigureNotify _ANSI_ARGS_((TkWindow *winPtr,
373
374
375
376
377
378
379

380
381
382
383
384
385
386
 */

void
TkWmNewWindow(winPtr)
    TkWindow *winPtr;		/* Newly-created top-level window. */
{
    register WmInfo *wmPtr;


    wmPtr = (WmInfo *) ckalloc(sizeof(WmInfo));
    wmPtr->winPtr = winPtr;
    wmPtr->reparent = None;
    wmPtr->title = NULL;
    wmPtr->iconName = NULL;
    wmPtr->master = None;







>







363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
 */

void
TkWmNewWindow(winPtr)
    TkWindow *winPtr;		/* Newly-created top-level window. */
{
    register WmInfo *wmPtr;
    TkDisplay *dispPtr = winPtr->dispPtr;

    wmPtr = (WmInfo *) ckalloc(sizeof(WmInfo));
    wmPtr->winPtr = winPtr;
    wmPtr->reparent = None;
    wmPtr->title = NULL;
    wmPtr->iconName = NULL;
    wmPtr->master = None;
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
    wmPtr->configWidth = -1;
    wmPtr->configHeight = -1;
    wmPtr->vRoot = None;
    wmPtr->protPtr = NULL;
    wmPtr->cmdArgv = NULL;
    wmPtr->clientMachine = NULL;
    wmPtr->flags = WM_NEVER_MAPPED;
    wmPtr->nextPtr = firstWmPtr;
    firstWmPtr = wmPtr;
    winPtr->wmInfoPtr = wmPtr;

    UpdateVRootGeometry(wmPtr);

    /*
     * Arrange for geometry requests to be reflected from the window
     * to the window manager.







|
|







419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
    wmPtr->configWidth = -1;
    wmPtr->configHeight = -1;
    wmPtr->vRoot = None;
    wmPtr->protPtr = NULL;
    wmPtr->cmdArgv = NULL;
    wmPtr->clientMachine = NULL;
    wmPtr->flags = WM_NEVER_MAPPED;
    wmPtr->nextPtr = (WmInfo *) dispPtr->firstWmPtr;
    dispPtr->firstWmPtr = wmPtr;
    winPtr->wmInfoPtr = wmPtr;

    UpdateVRootGeometry(wmPtr);

    /*
     * Arrange for geometry requests to be reflected from the window
     * to the window manager.
475
476
477
478
479
480
481


482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499


500

501
502
503

504
505
506
507

508
509

510
511
512
513
514
515
516
517
518
519
520
521
522
523
524

525
526
527
528
529
530

531
532
533
534
535
536
537
				 * be mapped. */
{
    register WmInfo *wmPtr = winPtr->wmInfoPtr;
    XTextProperty textProp;
    char *string;

    if (wmPtr->flags & WM_NEVER_MAPPED) {


	wmPtr->flags &= ~WM_NEVER_MAPPED;

	/*
	 * This is the first time this window has ever been mapped.
	 * First create the wrapper window that provides space for a
	 * menubar.
	 */

	if (wmPtr->wrapperPtr == NULL) {
	    CreateWrapper(wmPtr);
	}

	/*
	 * Store all the window-manager-related information for the
	 * window.
	 */

	string = (wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid;


	if (XStringListToTextProperty(&string, 1, &textProp)  != 0) {

	    XSetWMName(winPtr->display, wmPtr->wrapperPtr->window, &textProp);
	    XFree((char *) textProp.value);
	}

    
	TkWmSetClass(winPtr);

	if (wmPtr->iconName != NULL) {

	    XSetIconName(winPtr->display, wmPtr->wrapperPtr->window,
		    wmPtr->iconName);

	}
    
	if (wmPtr->master != None) {
	    XSetTransientForHint(winPtr->display, wmPtr->wrapperPtr->window,
		    wmPtr->master);
	}
    
	wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
	UpdateHints(winPtr);
	UpdateWmProtocols(wmPtr);
	if (wmPtr->cmdArgv != NULL) {
	    XSetCommand(winPtr->display, wmPtr->wrapperPtr->window,
		    wmPtr->cmdArgv, wmPtr->cmdArgc);
	}
	if (wmPtr->clientMachine != NULL) {

	    if (XStringListToTextProperty(&wmPtr->clientMachine, 1, &textProp)
		    != 0) {
		XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window,
			&textProp);
		XFree((char *) textProp.value);
	    }

	}
    }
    if (wmPtr->hints.initial_state == WithdrawnState) {
	return;
    }
    if (wmPtr->iconFor != NULL) {
	/*







>
>


















>
>
|
>



>
|



>

|
>











|
<


>
|
|




>







466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520

521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
				 * be mapped. */
{
    register WmInfo *wmPtr = winPtr->wmInfoPtr;
    XTextProperty textProp;
    char *string;

    if (wmPtr->flags & WM_NEVER_MAPPED) {
	Tcl_DString ds;

	wmPtr->flags &= ~WM_NEVER_MAPPED;

	/*
	 * This is the first time this window has ever been mapped.
	 * First create the wrapper window that provides space for a
	 * menubar.
	 */

	if (wmPtr->wrapperPtr == NULL) {
	    CreateWrapper(wmPtr);
	}

	/*
	 * Store all the window-manager-related information for the
	 * window.
	 */

	string = (wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid;
	Tcl_UtfToExternalDString(NULL, string, -1, &ds);
	string = Tcl_DStringValue(&ds);
	if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1,
		&textProp)  != 0) {
	    XSetWMName(winPtr->display, wmPtr->wrapperPtr->window, &textProp);
	    XFree((char *) textProp.value);
	}
	Tcl_DStringFree(&ds);

	TkWmSetClass(winPtr);

	if (wmPtr->iconName != NULL) {
	    Tcl_UtfToExternalDString(NULL, wmPtr->iconName, -1, &ds);
	    XSetIconName(winPtr->display, wmPtr->wrapperPtr->window,
		    Tcl_DStringValue(&ds));
	    Tcl_DStringFree(&ds);
	}
    
	if (wmPtr->master != None) {
	    XSetTransientForHint(winPtr->display, wmPtr->wrapperPtr->window,
		    wmPtr->master);
	}
    
	wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
	UpdateHints(winPtr);
	UpdateWmProtocols(wmPtr);
	if (wmPtr->cmdArgv != NULL) {
	    UpdateCommand(winPtr);

	}
	if (wmPtr->clientMachine != NULL) {
	    Tcl_UtfToExternalDString(NULL, wmPtr->clientMachine, -1, &ds);
	    if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1,
		    &textProp) != 0) {
		XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window,
			&textProp);
		XFree((char *) textProp.value);
	    }
	    Tcl_DStringFree(&ds);
	}
    }
    if (wmPtr->hints.initial_state == WithdrawnState) {
	return;
    }
    if (wmPtr->iconFor != NULL) {
	/*
625
626
627
628
629
630
631
632
633
634
635
636

637
638
639
640
641
642
643
644
{
    register WmInfo *wmPtr = winPtr->wmInfoPtr;
    WmInfo *wmPtr2;

    if (wmPtr == NULL) {
	return;
    }
    if (firstWmPtr == wmPtr) {
	firstWmPtr = wmPtr->nextPtr;
    } else {
	register WmInfo *prevPtr;


	for (prevPtr = firstWmPtr; ; prevPtr = prevPtr->nextPtr) {
	    if (prevPtr == NULL) {
		panic("couldn't unlink window in TkWmDeadWindow");
	    }
	    if (prevPtr->nextPtr == wmPtr) {
		prevPtr->nextPtr = wmPtr->nextPtr;
		break;
	    }







|
|



>
|







625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
{
    register WmInfo *wmPtr = winPtr->wmInfoPtr;
    WmInfo *wmPtr2;

    if (wmPtr == NULL) {
	return;
    }
    if ((WmInfo *) winPtr->dispPtr->firstWmPtr == wmPtr) {
	winPtr->dispPtr->firstWmPtr = wmPtr->nextPtr;
    } else {
	register WmInfo *prevPtr;

	for (prevPtr = (WmInfo *) winPtr->dispPtr->firstWmPtr; ; 
                prevPtr = prevPtr->nextPtr) {
	    if (prevPtr == NULL) {
		panic("couldn't unlink window in TkWmDeadWindow");
	    }
	    if (prevPtr->nextPtr == wmPtr) {
		prevPtr->nextPtr = wmPtr->nextPtr;
		break;
	    }
735
736
737
738
739
740
741

742


743
744
745
746
747
748


749
750
751
752
753
754
755
{
    if (winPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) {
	return;
    }

    if (winPtr->classUid != NULL) {
	XClassHint *classPtr;




	classPtr = XAllocClassHint();
	classPtr->res_name = winPtr->nameUid;
	classPtr->res_class = winPtr->classUid;
	XSetClassHint(winPtr->display, winPtr->wmInfoPtr->wrapperPtr->window,
		classPtr);
	XFree((char *) classPtr);


    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_WmCmd --







>

>
>

|
|



>
>







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
{
    if (winPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) {
	return;
    }

    if (winPtr->classUid != NULL) {
	XClassHint *classPtr;
	Tcl_DString name, class;

	Tcl_UtfToExternalDString(NULL, winPtr->nameUid, -1, &name);
	Tcl_UtfToExternalDString(NULL, winPtr->classUid, -1, &class);
	classPtr = XAllocClassHint();
	classPtr->res_name = Tcl_DStringValue(&name);
	classPtr->res_class = Tcl_DStringValue(&class);
	XSetClassHint(winPtr->display, winPtr->wmInfoPtr->wrapperPtr->window,
		classPtr);
	XFree((char *) classPtr);
	Tcl_DStringFree(&name);
	Tcl_DStringFree(&class);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_WmCmd --
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
    char **argv;		/* Argument strings. */
{
    Tk_Window tkwin = (Tk_Window) clientData;
    TkWindow *winPtr;
    register WmInfo *wmPtr;
    int c;
    size_t length;


    if (argc < 2) {
	wrongNumArgs:
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option window ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 't') && (strncmp(argv[1], "tracing", length) == 0)
	    && (length >= 3)) {
	if ((argc != 2) && (argc != 3)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " tracing ?boolean?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 2) {
	    interp->result = (wmTracing) ? "on" : "off";

	    return TCL_OK;
	}
	return Tcl_GetBoolean(interp, argv[2], &wmTracing);
    }

    if (argc < 3) {
	goto wrongNumArgs;
    }
    winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
    if (winPtr == NULL) {







>

















|
>


|







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
    char **argv;		/* Argument strings. */
{
    Tk_Window tkwin = (Tk_Window) clientData;
    TkWindow *winPtr;
    register WmInfo *wmPtr;
    int c;
    size_t length;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    if (argc < 2) {
	wrongNumArgs:
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option window ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 't') && (strncmp(argv[1], "tracing", length) == 0)
	    && (length >= 3)) {
	if ((argc != 2) && (argc != 3)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " tracing ?boolean?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 2) {
	    Tcl_SetResult(interp, ((dispPtr->wmTracing) ? "on" : "off"), 
                    TCL_STATIC);
	    return TCL_OK;
	}
	return Tcl_GetBoolean(interp, argv[2], &dispPtr->wmTracing);
    }

    if (argc < 3) {
	goto wrongNumArgs;
    }
    winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
    if (winPtr == NULL) {
823
824
825
826
827
828
829


830
831
832

833
834
835
836
837
838
839
840
841
842
843
844
845
846
847

848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " aspect window ?minNumer minDenom ",
		    "maxNumer maxDenom?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & PAspect) {


		sprintf(interp->result, "%d %d %d %d", wmPtr->minAspect.x,
			wmPtr->minAspect.y, wmPtr->maxAspect.x,
			wmPtr->maxAspect.y);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~PAspect;
	} else {
	    if ((Tcl_GetInt(interp, argv[3], &numer1) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[4], &denom1) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[5], &numer2) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[6], &denom2) != TCL_OK)) {
		return TCL_ERROR;
	    }
	    if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
		    (denom2 <= 0)) {
		interp->result = "aspect number can't be <= 0";

		return TCL_ERROR;
	    }
	    wmPtr->minAspect.x = numer1;
	    wmPtr->minAspect.y = denom1;
	    wmPtr->maxAspect.x = numer2;
	    wmPtr->maxAspect.y = denom2;
	    wmPtr->sizeHintsFlags |= PAspect;
	}
	wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
	goto updateGeom;
    } else if ((c == 'c') && (strncmp(argv[1], "client", length) == 0)
	    && (length >= 2)) {
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " client window ?name?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->clientMachine != NULL) {
		interp->result = wmPtr->clientMachine;
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == 0) {
	    if (wmPtr->clientMachine != NULL) {
		ckfree((char *) wmPtr->clientMachine);
		wmPtr->clientMachine = NULL;







>
>
|


>














|
>




















|







831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " aspect window ?minNumer minDenom ",
		    "maxNumer maxDenom?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & PAspect) {
		char buf[TCL_INTEGER_SPACE * 4];
		
		sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x,
			wmPtr->minAspect.y, wmPtr->maxAspect.x,
			wmPtr->maxAspect.y);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~PAspect;
	} else {
	    if ((Tcl_GetInt(interp, argv[3], &numer1) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[4], &denom1) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[5], &numer2) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[6], &denom2) != TCL_OK)) {
		return TCL_ERROR;
	    }
	    if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
		    (denom2 <= 0)) {
		Tcl_SetResult(interp, "aspect number can't be <= 0",
			TCL_STATIC);
		return TCL_ERROR;
	    }
	    wmPtr->minAspect.x = numer1;
	    wmPtr->minAspect.y = denom1;
	    wmPtr->maxAspect.x = numer2;
	    wmPtr->maxAspect.y = denom2;
	    wmPtr->sizeHintsFlags |= PAspect;
	}
	wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
	goto updateGeom;
    } else if ((c == 'c') && (strncmp(argv[1], "client", length) == 0)
	    && (length >= 2)) {
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " client window ?name?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->clientMachine != NULL) {
		Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == 0) {
	    if (wmPtr->clientMachine != NULL) {
		ckfree((char *) wmPtr->clientMachine);
		wmPtr->clientMachine = NULL;
885
886
887
888
889
890
891



892
893
894
895
896
897

898
899
900
901
902
903
904
	    ckfree((char *) wmPtr->clientMachine);
	}
	wmPtr->clientMachine = (char *)
		ckalloc((unsigned) (strlen(argv[3]) + 1));
	strcpy(wmPtr->clientMachine, argv[3]);
	if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
	    XTextProperty textProp;



	    if (XStringListToTextProperty(&wmPtr->clientMachine, 1, &textProp)
		    != 0) {
		XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window,
			&textProp);
		XFree((char *) textProp.value);
	    }

	}
    } else if ((c == 'c') && (strncmp(argv[1], "colormapwindows", length) == 0)
	    && (length >= 3)) {
	Window *cmapList;
	TkWindow *winPtr2;
	int count, i, windowArgc, gotToplevel;
	char buffer[20], **windowArgv;







>
>
>
|
|




>







897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
	    ckfree((char *) wmPtr->clientMachine);
	}
	wmPtr->clientMachine = (char *)
		ckalloc((unsigned) (strlen(argv[3]) + 1));
	strcpy(wmPtr->clientMachine, argv[3]);
	if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
	    XTextProperty textProp;
	    Tcl_DString ds;

	    Tcl_UtfToExternalDString(NULL, wmPtr->clientMachine, -1, &ds);
	    if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1,
		    &textProp) != 0) {
		XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window,
			&textProp);
		XFree((char *) textProp.value);
	    }
	    Tcl_DStringFree(&ds);
	}
    } else if ((c == 'c') && (strncmp(argv[1], "colormapwindows", length) == 0)
	    && (length >= 3)) {
	Window *cmapList;
	TkWindow *winPtr2;
	int count, i, windowArgc, gotToplevel;
	char buffer[20], **windowArgv;
980
981
982
983
984
985
986

987
988
989
990
991
992
993
994
995
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " command window ?value?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->cmdArgv != NULL) {

		interp->result = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
		interp->freeProc = TCL_DYNAMIC;
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == 0) {
	    if (wmPtr->cmdArgv != NULL) {
		ckfree((char *) wmPtr->cmdArgv);
		wmPtr->cmdArgv = NULL;







>
|
|







996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " command window ?value?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->cmdArgv != NULL) {
		Tcl_SetResult(interp,
			Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv),
			TCL_DYNAMIC);
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == 0) {
	    if (wmPtr->cmdArgv != NULL) {
		ckfree((char *) wmPtr->cmdArgv);
		wmPtr->cmdArgv = NULL;
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
	}
	if (wmPtr->cmdArgv != NULL) {
	    ckfree((char *) wmPtr->cmdArgv);
	}
	wmPtr->cmdArgc = cmdArgc;
	wmPtr->cmdArgv = cmdArgv;
	if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
	    XSetCommand(winPtr->display, wmPtr->wrapperPtr->window,
		    cmdArgv, cmdArgc);
	}
    } else if ((c == 'd') && (strncmp(argv[1], "deiconify", length) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " deiconify window\"", (char *) NULL);
	    return TCL_ERROR;
	}







|
<







1022
1023
1024
1025
1026
1027
1028
1029

1030
1031
1032
1033
1034
1035
1036
	}
	if (wmPtr->cmdArgv != NULL) {
	    ckfree((char *) wmPtr->cmdArgv);
	}
	wmPtr->cmdArgc = cmdArgc;
	wmPtr->cmdArgv = cmdArgv;
	if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
	    UpdateCommand(winPtr);

	}
    } else if ((c == 'd') && (strncmp(argv[1], "deiconify", length) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " deiconify window\"", (char *) NULL);
	    return TCL_ERROR;
	}
1036
1037
1038
1039
1040
1041
1042
1043

1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060

1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071

1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083


1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096

1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116


1117
1118
1119

1120
1121
1122
1123
1124
1125
1126
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " focusmodel window ?active|passive?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    interp->result = wmPtr->hints.input ? "passive" : "active";

	    return TCL_OK;
	}
	c = argv[3][0];
	length = strlen(argv[3]);
	if ((c == 'a') && (strncmp(argv[3], "active", length) == 0)) {
	    wmPtr->hints.input = False;
	} else if ((c == 'p') && (strncmp(argv[3], "passive", length) == 0)) {
	    wmPtr->hints.input = True;
	} else {
	    Tcl_AppendResult(interp, "bad argument \"", argv[3],
		    "\": must be active or passive", (char *) NULL);
	    return TCL_ERROR;
	}
	UpdateHints(winPtr);
    } else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0)
	    && (length >= 2)) {
	Window window;


	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " frame window\"", (char *) NULL);
	    return TCL_ERROR;
	}
	window = wmPtr->reparent;
	if (window == None) {
	    window = Tk_WindowId((Tk_Window) winPtr);
	}
	sprintf(interp->result, "0x%x", (unsigned int) window);

    } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)
	    && (length >= 2)) {
	char xSign, ySign;
	int width, height;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " geometry window ?newGeometry?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {


	    xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
	    ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
	    if (wmPtr->gridWin != NULL) {
		width = wmPtr->reqGridWidth + (winPtr->changes.width
			- winPtr->reqWidth)/wmPtr->widthInc;
		height = wmPtr->reqGridHeight + (winPtr->changes.height
			- winPtr->reqHeight)/wmPtr->heightInc;
	    } else {
		width = winPtr->changes.width;
		height = winPtr->changes.height;
	    }
	    sprintf(interp->result, "%dx%d%c%d%c%d", width, height,
		    xSign, wmPtr->x, ySign, wmPtr->y);

	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->width = -1;
	    wmPtr->height = -1;
	    goto updateGeom;
	}
	return ParseGeometry(interp, argv[3], winPtr);
    } else if ((c == 'g') && (strncmp(argv[1], "grid", length) == 0)
	    && (length >= 3)) {
	int reqWidth, reqHeight, widthInc, heightInc;

	if ((argc != 3) && (argc != 7)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " grid window ?baseWidth baseHeight ",
		    "widthInc heightInc?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & PBaseSize) {


		sprintf(interp->result, "%d %d %d %d", wmPtr->reqGridWidth,
			wmPtr->reqGridHeight, wmPtr->widthInc,
			wmPtr->heightInc);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    /*
	     * Turn off gridding and reset the width and height
	     * to make sense as ungridded numbers.







|
>

















>










|
>












>
>











|
|
>




















>
>
|


>







1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " focusmodel window ?active|passive?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
		    TCL_STATIC);
	    return TCL_OK;
	}
	c = argv[3][0];
	length = strlen(argv[3]);
	if ((c == 'a') && (strncmp(argv[3], "active", length) == 0)) {
	    wmPtr->hints.input = False;
	} else if ((c == 'p') && (strncmp(argv[3], "passive", length) == 0)) {
	    wmPtr->hints.input = True;
	} else {
	    Tcl_AppendResult(interp, "bad argument \"", argv[3],
		    "\": must be active or passive", (char *) NULL);
	    return TCL_ERROR;
	}
	UpdateHints(winPtr);
    } else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0)
	    && (length >= 2)) {
	Window window;
	char buf[TCL_INTEGER_SPACE];

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " frame window\"", (char *) NULL);
	    return TCL_ERROR;
	}
	window = wmPtr->reparent;
	if (window == None) {
	    window = Tk_WindowId((Tk_Window) winPtr);
	}
	sprintf(buf, "0x%x", (unsigned int) window);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)
	    && (length >= 2)) {
	char xSign, ySign;
	int width, height;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " geometry window ?newGeometry?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    char buf[16 + TCL_INTEGER_SPACE * 4];
	    
	    xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
	    ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
	    if (wmPtr->gridWin != NULL) {
		width = wmPtr->reqGridWidth + (winPtr->changes.width
			- winPtr->reqWidth)/wmPtr->widthInc;
		height = wmPtr->reqGridHeight + (winPtr->changes.height
			- winPtr->reqHeight)/wmPtr->heightInc;
	    } else {
		width = winPtr->changes.width;
		height = winPtr->changes.height;
	    }
	    sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x,
		    ySign, wmPtr->y);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->width = -1;
	    wmPtr->height = -1;
	    goto updateGeom;
	}
	return ParseGeometry(interp, argv[3], winPtr);
    } else if ((c == 'g') && (strncmp(argv[1], "grid", length) == 0)
	    && (length >= 3)) {
	int reqWidth, reqHeight, widthInc, heightInc;

	if ((argc != 3) && (argc != 7)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " grid window ?baseWidth baseHeight ",
		    "widthInc heightInc?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & PBaseSize) {
		char buf[TCL_INTEGER_SPACE * 4];

		sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth,
			wmPtr->reqGridHeight, wmPtr->widthInc,
			wmPtr->heightInc);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    /*
	     * Turn off gridding and reset the width and height
	     * to make sense as ungridded numbers.
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
	    if ((Tcl_GetInt(interp, argv[3], &reqWidth) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[4], &reqHeight) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[5], &widthInc) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[6], &heightInc) != TCL_OK)) {
		return TCL_ERROR;
	    }
	    if (reqWidth < 0) {
		interp->result = "baseWidth can't be < 0";
		return TCL_ERROR;
	    }
	    if (reqHeight < 0) {
		interp->result = "baseHeight can't be < 0";
		return TCL_ERROR;
	    }
	    if (widthInc < 0) {
		interp->result = "widthInc can't be < 0";
		return TCL_ERROR;
	    }
	    if (heightInc < 0) {
		interp->result = "heightInc can't be < 0";
		return TCL_ERROR;
	    }
	    Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
		    heightInc);
	}
	wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
	goto updateGeom;
    } else if ((c == 'g') && (strncmp(argv[1], "group", length) == 0)
	    && (length >= 3)) {
	Tk_Window tkwin2;
	WmInfo *wmPtr2;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " group window ?pathName?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & WindowGroupHint) {
		interp->result = wmPtr->leaderName;
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~WindowGroupHint;
	    if (wmPtr->leaderName != NULL) {
		ckfree(wmPtr->leaderName);







|



|



|



|




















|







1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
	    if ((Tcl_GetInt(interp, argv[3], &reqWidth) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[4], &reqHeight) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[5], &widthInc) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[6], &heightInc) != TCL_OK)) {
		return TCL_ERROR;
	    }
	    if (reqWidth < 0) {
		Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC);
		return TCL_ERROR;
	    }
	    if (reqHeight < 0) {
		Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC);
		return TCL_ERROR;
	    }
	    if (widthInc < 0) {
		Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC);
		return TCL_ERROR;
	    }
	    if (heightInc < 0) {
		Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC);
		return TCL_ERROR;
	    }
	    Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
		    heightInc);
	}
	wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
	goto updateGeom;
    } else if ((c == 'g') && (strncmp(argv[1], "group", length) == 0)
	    && (length >= 3)) {
	Tk_Window tkwin2;
	WmInfo *wmPtr2;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " group window ?pathName?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & WindowGroupHint) {
		Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~WindowGroupHint;
	    if (wmPtr->leaderName != NULL) {
		ckfree(wmPtr->leaderName);
1217
1218
1219
1220
1221
1222
1223
1224
1225

1226
1227
1228
1229
1230
1231
1232
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconbitmap window ?bitmap?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconPixmapHint) {
		interp->result = Tk_NameOfBitmap(winPtr->display,
			wmPtr->hints.icon_pixmap);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    if (wmPtr->hints.icon_pixmap != None) {
		Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap);
		wmPtr->hints.icon_pixmap = None;







|
|
>







1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconbitmap window ?bitmap?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconPixmapHint) {
		Tcl_SetResult(interp,
			Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap),
			TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    if (wmPtr->hints.icon_pixmap != None) {
		Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap);
		wmPtr->hints.icon_pixmap = None;
1272
1273
1274
1275
1276
1277
1278
1279
1280

1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298

1299
1300
1301
1302
1303
1304
1305
	if (wmPtr->withdrawn) {
	    UpdateHints(winPtr);
	    Tk_MapWindow((Tk_Window) winPtr);
	    wmPtr->withdrawn = 0;
	} else {
	    if (XIconifyWindow(winPtr->display, wmPtr->wrapperPtr->window,
		    winPtr->screenNum) == 0) {
		interp->result =
			"couldn't send iconify message to window manager";

		return TCL_ERROR;
	    }
	    WaitForMapNotify(winPtr, 0);
	}
    } else if ((c == 'i') && (strncmp(argv[1], "iconmask", length) == 0)
	    && (length >= 5)) {
	Pixmap pixmap;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconmask window ?bitmap?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconMaskHint) {
		interp->result = Tk_NameOfBitmap(winPtr->display,
			wmPtr->hints.icon_mask);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    if (wmPtr->hints.icon_mask != None) {
		Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask);
	    }







|
|
>
















|
|
>







1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
	if (wmPtr->withdrawn) {
	    UpdateHints(winPtr);
	    Tk_MapWindow((Tk_Window) winPtr);
	    wmPtr->withdrawn = 0;
	} else {
	    if (XIconifyWindow(winPtr->display, wmPtr->wrapperPtr->window,
		    winPtr->screenNum) == 0) {
		Tcl_SetResult(interp,
			"couldn't send iconify message to window manager",
			TCL_STATIC);
		return TCL_ERROR;
	    }
	    WaitForMapNotify(winPtr, 0);
	}
    } else if ((c == 'i') && (strncmp(argv[1], "iconmask", length) == 0)
	    && (length >= 5)) {
	Pixmap pixmap;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconmask window ?bitmap?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconMaskHint) {
		Tcl_SetResult(interp,
			Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
			TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    if (wmPtr->hints.icon_mask != None) {
		Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask);
	    }
1317
1318
1319
1320
1321
1322
1323

1324

1325
1326
1327
1328
1329



1330
1331

1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345


1346
1347

1348
1349
1350
1351
1352
1353
1354
	    && (length >= 5)) {
	if (argc > 4) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconname window ?newName?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {

	    interp->result = (wmPtr->iconName != NULL) ? wmPtr->iconName : "";

	    return TCL_OK;
	} else {
	    wmPtr->iconName = ckalloc((unsigned) (strlen(argv[3]) + 1));
	    strcpy(wmPtr->iconName, argv[3]);
	    if (!(wmPtr->flags & WM_NEVER_MAPPED)) {



		XSetIconName(winPtr->display, wmPtr->wrapperPtr->window,
			wmPtr->iconName);

	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "iconposition", length) == 0)
	    && (length >= 5)) {
	int x, y;

	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconposition window ?x y?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconPositionHint) {


		sprintf(interp->result, "%d %d", wmPtr->hints.icon_x,
			wmPtr->hints.icon_y);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~IconPositionHint;
	} else {
	    if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK)







>
|
>





>
>
>

|
>














>
>
|

>







1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
	    && (length >= 5)) {
	if (argc > 4) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconname window ?newName?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    Tcl_SetResult(interp,
		    ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""),
		    TCL_STATIC);
	    return TCL_OK;
	} else {
	    wmPtr->iconName = ckalloc((unsigned) (strlen(argv[3]) + 1));
	    strcpy(wmPtr->iconName, argv[3]);
	    if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
		Tcl_DString ds;

		Tcl_UtfToExternalDString(NULL, wmPtr->iconName, -1, &ds);
		XSetIconName(winPtr->display, wmPtr->wrapperPtr->window,
			Tcl_DStringValue(&ds));
		Tcl_DStringFree(&ds);
	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "iconposition", length) == 0)
	    && (length >= 5)) {
	int x, y;

	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconposition window ?x y?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconPositionHint) {
		char buf[TCL_INTEGER_SPACE * 2];

		sprintf(buf, "%d %d", wmPtr->hints.icon_x,
			wmPtr->hints.icon_y);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~IconPositionHint;
	} else {
	    if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK)
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconwindow window ?pathName?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->icon != NULL) {
		interp->result = Tk_PathName(wmPtr->icon);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~IconWindowHint;
	    if (wmPtr->icon != NULL) {
		/*







|







1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconwindow window ?pathName?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->icon != NULL) {
		Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~IconWindowHint;
	    if (wmPtr->icon != NULL) {
		/*
1439
1440
1441
1442
1443
1444
1445
1446
1447

1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462


1463
1464

1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483

1484
1485

1486
1487
1488
1489
1490
1491
1492
	    wmPtr->icon = tkwin2;
	    wmPtr2->iconFor = (Tk_Window) winPtr;
	    if (!wmPtr2->withdrawn && !(wmPtr2->flags & WM_NEVER_MAPPED)) {
		wmPtr2->withdrawn = 0;
		if (XWithdrawWindow(Tk_Display(tkwin2),
			Tk_WindowId(wmPtr2->wrapperPtr),
			Tk_ScreenNumber(tkwin2)) == 0) {
		    interp->result =
			    "couldn't send withdraw message to window manager";

		    return TCL_ERROR;
		}
		WaitForMapNotify((TkWindow *) tkwin2, 0);
	    }
	}
	UpdateHints(winPtr);
    } else if ((c == 'm') && (strncmp(argv[1], "maxsize", length) == 0)
	    && (length >= 2)) {
	int width, height;
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " maxsize window ?width height?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {


	    GetMaxSize(wmPtr, &width, &height);
	    sprintf(interp->result, "%d %d", width, height);

	    return TCL_OK;
	}
	if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	wmPtr->maxWidth = width;
	wmPtr->maxHeight = height;
	wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
	goto updateGeom;
    } else if ((c == 'm') && (strncmp(argv[1], "minsize", length) == 0)
	    && (length >= 2)) {
	int width, height;
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " minsize window ?width height?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {

	    sprintf(interp->result, "%d %d", wmPtr->minWidth,
		    wmPtr->minHeight);

	    return TCL_OK;
	}
	if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	wmPtr->minWidth = width;







|
|
>















>
>

|
>



















>
|
|
>







1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
	    wmPtr->icon = tkwin2;
	    wmPtr2->iconFor = (Tk_Window) winPtr;
	    if (!wmPtr2->withdrawn && !(wmPtr2->flags & WM_NEVER_MAPPED)) {
		wmPtr2->withdrawn = 0;
		if (XWithdrawWindow(Tk_Display(tkwin2),
			Tk_WindowId(wmPtr2->wrapperPtr),
			Tk_ScreenNumber(tkwin2)) == 0) {
		    Tcl_SetResult(interp,
			    "couldn't send withdraw message to window manager",
			    TCL_STATIC);
		    return TCL_ERROR;
		}
		WaitForMapNotify((TkWindow *) tkwin2, 0);
	    }
	}
	UpdateHints(winPtr);
    } else if ((c == 'm') && (strncmp(argv[1], "maxsize", length) == 0)
	    && (length >= 2)) {
	int width, height;
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " maxsize window ?width height?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    char buf[TCL_INTEGER_SPACE * 2];
	    
	    GetMaxSize(wmPtr, &width, &height);
	    sprintf(buf, "%d %d", width, height);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    return TCL_OK;
	}
	if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	wmPtr->maxWidth = width;
	wmPtr->maxHeight = height;
	wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
	goto updateGeom;
    } else if ((c == 'm') && (strncmp(argv[1], "minsize", length) == 0)
	    && (length >= 2)) {
	int width, height;
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " minsize window ?width height?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    char buf[TCL_INTEGER_SPACE * 2];

	    sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    return TCL_OK;
	}
	if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	wmPtr->minWidth = width;
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " overrideredirect window ?boolean?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
		interp->result = "1";
	    } else {
		interp->result = "0";
	    }
	    return TCL_OK;
	}
	if (Tcl_GetBoolean(interp, argv[3], &boolean) != TCL_OK) {
	    return TCL_ERROR;
	}
	atts.override_redirect = (boolean) ? True : False;







|

|







1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " overrideredirect window ?boolean?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
		Tcl_SetResult(interp, "1", TCL_STATIC);
	    } else {
		Tcl_SetResult(interp, "0", TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (Tcl_GetBoolean(interp, argv[3], &boolean) != TCL_OK) {
	    return TCL_ERROR;
	}
	atts.override_redirect = (boolean) ? True : False;
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " positionfrom window ?user/program?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & USPosition) {
		interp->result = "user";
	    } else if (wmPtr->sizeHintsFlags & PPosition) {
		interp->result = "program";
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~(USPosition|PPosition);
	} else {
	    c = argv[3][0];







|

|







1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " positionfrom window ?user/program?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & USPosition) {
		Tcl_SetResult(interp, "user", TCL_STATIC);
	    } else if (wmPtr->sizeHintsFlags & PPosition) {
		Tcl_SetResult(interp, "program", TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~(USPosition|PPosition);
	} else {
	    c = argv[3][0];
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
	if (argc == 4) {
	    /*
	     * Return the command to handle a given protocol.
	     */
	    for (protPtr = wmPtr->protPtr; protPtr != NULL;
		    protPtr = protPtr->nextPtr) {
		if (protPtr->protocol == protocol) {
		    interp->result = protPtr->command;
		    return TCL_OK;
		}
	    }
	    return TCL_OK;
	}

	/*







|







1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
	if (argc == 4) {
	    /*
	     * Return the command to handle a given protocol.
	     */
	    for (protPtr = wmPtr->protPtr; protPtr != NULL;
		    protPtr = protPtr->nextPtr) {
		if (protPtr->protocol == protocol) {
		    Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
		    return TCL_OK;
		}
	    }
	    return TCL_OK;
	}

	/*
1632
1633
1634
1635
1636
1637
1638


1639
1640
1641

1642
1643
1644
1645
1646
1647
1648
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " resizable window ?width height?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {


	    sprintf(interp->result, "%d %d",
		    (wmPtr->flags  & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
		    (wmPtr->flags  & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);

	    return TCL_OK;
	}
	if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetBoolean(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	if (width) {







>
>
|


>







1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " resizable window ?width height?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    char buf[TCL_INTEGER_SPACE * 2];

	    sprintf(buf, "%d %d",
		    (wmPtr->flags  & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
		    (wmPtr->flags  & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    return TCL_OK;
	}
	if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetBoolean(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	if (width) {
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " sizefrom window ?user|program?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & USSize) {
		interp->result = "user";
	    } else if (wmPtr->sizeHintsFlags & PSize) {
		interp->result = "program";
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~(USSize|PSize);
	} else {
	    c = argv[3][0];







|

|







1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " sizefrom window ?user|program?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & USSize) {
		Tcl_SetResult(interp, "user", TCL_STATIC);
	    } else if (wmPtr->sizeHintsFlags & PSize) {
		Tcl_SetResult(interp, "program", TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~(USSize|PSize);
	} else {
	    c = argv[3][0];
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721

1722
1723

1724
1725
1726
1727
1728
1729

1730

1731
1732
1733
1734
1735
1736

1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " state window\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (wmPtr->iconFor != NULL) {
	    interp->result = "icon";
	} else if (wmPtr->withdrawn) {
	    interp->result = "withdrawn";
	} else if (Tk_IsMapped((Tk_Window) winPtr)
		|| ((wmPtr->flags & WM_NEVER_MAPPED)
		&& (wmPtr->hints.initial_state == NormalState))) {
	    interp->result = "normal";
	} else {
	    interp->result = "iconic";
	}
    } else if ((c == 't') && (strncmp(argv[1], "title", length) == 0)
	    && (length >= 2)) {
	if (argc > 4) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " title window ?newTitle?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {

	    interp->result = (wmPtr->title != NULL) ? wmPtr->title
		    : winPtr->nameUid;

	    return TCL_OK;
	} else {
	    wmPtr->title = ckalloc((unsigned) (strlen(argv[3]) + 1));
	    strcpy(wmPtr->title, argv[3]);
	    if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
		XTextProperty textProp;



		if (XStringListToTextProperty(&wmPtr->title, 1,
			&textProp)  != 0) {
		    XSetWMName(winPtr->display, wmPtr->wrapperPtr->window,
			    &textProp);
		    XFree((char *) textProp.value);
		}

	    }
	}
    } else if ((c == 't') && (strncmp(argv[1], "transient", length) == 0)
	    && (length >= 3)) {
	Tk_Window master;
	WmInfo *wmPtr2;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " transient window ?master?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->master != None) {
		interp->result = wmPtr->masterWindowName;
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == '\0') {
	    wmPtr->master = None;
	    if (wmPtr->masterWindowName != NULL) {
		ckfree(wmPtr->masterWindowName);







|

|



|

|









>
|
<
>






>

>
|





>














|







1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769

1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " state window\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (wmPtr->iconFor != NULL) {
	    Tcl_SetResult(interp, "icon", TCL_STATIC);
	} else if (wmPtr->withdrawn) {
	    Tcl_SetResult(interp, "withdrawn", TCL_STATIC);
	} else if (Tk_IsMapped((Tk_Window) winPtr)
		|| ((wmPtr->flags & WM_NEVER_MAPPED)
		&& (wmPtr->hints.initial_state == NormalState))) {
	    Tcl_SetResult(interp, "normal", TCL_STATIC);
	} else {
	    Tcl_SetResult(interp, "iconic", TCL_STATIC);
	}
    } else if ((c == 't') && (strncmp(argv[1], "title", length) == 0)
	    && (length >= 2)) {
	if (argc > 4) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " title window ?newTitle?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    Tcl_SetResult(interp,
		    ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid),

		    TCL_STATIC);
	    return TCL_OK;
	} else {
	    wmPtr->title = ckalloc((unsigned) (strlen(argv[3]) + 1));
	    strcpy(wmPtr->title, argv[3]);
	    if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
		XTextProperty textProp;
		Tcl_DString ds;

		Tcl_UtfToExternalDString(NULL, wmPtr->title, -1, &ds);
		if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1,
			&textProp)  != 0) {
		    XSetWMName(winPtr->display, wmPtr->wrapperPtr->window,
			    &textProp);
		    XFree((char *) textProp.value);
		}
		Tcl_DStringFree(&ds);
	    }
	}
    } else if ((c == 't') && (strncmp(argv[1], "transient", length) == 0)
	    && (length >= 3)) {
	Tk_Window master;
	WmInfo *wmPtr2;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " transient window ?master?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->master != None) {
		Tcl_SetResult(interp, wmPtr->masterWindowName, TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == '\0') {
	    wmPtr->master = None;
	    if (wmPtr->masterWindowName != NULL) {
		ckfree(wmPtr->masterWindowName);
1799
1800
1801
1802
1803
1804
1805
1806
1807

1808
1809
1810
1811
1812
1813
1814
	wmPtr->hints.initial_state = WithdrawnState;
	wmPtr->withdrawn = 1;
	if (wmPtr->flags & WM_NEVER_MAPPED) {
	    return TCL_OK;
	}
	if (XWithdrawWindow(winPtr->display, wmPtr->wrapperPtr->window,
		winPtr->screenNum) == 0) {
	    interp->result =
		    "couldn't send withdraw message to window manager";

	    return TCL_ERROR;
	}
	WaitForMapNotify(winPtr, 0);
    } else {
	Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1],
		"\": must be aspect, client, command, deiconify, ",
		"focusmodel, frame, geometry, grid, group, iconbitmap, ",







|
|
>







1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
	wmPtr->hints.initial_state = WithdrawnState;
	wmPtr->withdrawn = 1;
	if (wmPtr->flags & WM_NEVER_MAPPED) {
	    return TCL_OK;
	}
	if (XWithdrawWindow(winPtr->display, wmPtr->wrapperPtr->window,
		winPtr->screenNum) == 0) {
	    Tcl_SetResult(interp,
		    "couldn't send withdraw message to window manager",
		    TCL_STATIC);
	    return TCL_ERROR;
	}
	WaitForMapNotify(winPtr, 0);
    } else {
	Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1],
		"\": must be aspect, client, command, deiconify, ",
		"focusmodel, frame, geometry, grid, group, iconbitmap, ",
2018
2019
2020
2021
2022
2023
2024

2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
ConfigureEvent(wmPtr, configEventPtr)
    WmInfo *wmPtr;			/* Information about toplevel window. */
    XConfigureEvent *configEventPtr;	/* Event that just occurred for
					 * wmPtr->wrapperPtr. */
{
    TkWindow *wrapperPtr = wmPtr->wrapperPtr;
    TkWindow *winPtr = wmPtr->winPtr;


    /* 
     * Update size information from the event.  There are a couple of
     * tricky points here:
     *
     * 1. If the user changed the size externally then set wmPtr->width
     *    and wmPtr->height just as if a "wm geometry" command had been
     *    invoked with the same information.
     * 2. However, if the size is changing in response to a request
     *    coming from us (WM_SYNC_PENDING is set), then don't set wmPtr->width
     *    or wmPtr->height if they were previously -1 (otherwise the
     *    window will stop tracking geometry manager requests).
     */

    if (((wrapperPtr->changes.width != configEventPtr->width)
	    || (wrapperPtr->changes.height != configEventPtr->height))
	    && !(wmPtr->flags & WM_SYNC_PENDING)){
	if (wmTracing) {
	    printf("TopLevelEventProc: user changed %s size to %dx%d\n",
		    winPtr->pathName, configEventPtr->width,
		    configEventPtr->height);
	}
	if ((wmPtr->width == -1)
		&& (configEventPtr->width == winPtr->reqWidth)) {
	    /*







>

















|







2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
ConfigureEvent(wmPtr, configEventPtr)
    WmInfo *wmPtr;			/* Information about toplevel window. */
    XConfigureEvent *configEventPtr;	/* Event that just occurred for
					 * wmPtr->wrapperPtr. */
{
    TkWindow *wrapperPtr = wmPtr->wrapperPtr;
    TkWindow *winPtr = wmPtr->winPtr;
    TkDisplay *dispPtr = wmPtr->winPtr->dispPtr;

    /* 
     * Update size information from the event.  There are a couple of
     * tricky points here:
     *
     * 1. If the user changed the size externally then set wmPtr->width
     *    and wmPtr->height just as if a "wm geometry" command had been
     *    invoked with the same information.
     * 2. However, if the size is changing in response to a request
     *    coming from us (WM_SYNC_PENDING is set), then don't set wmPtr->width
     *    or wmPtr->height if they were previously -1 (otherwise the
     *    window will stop tracking geometry manager requests).
     */

    if (((wrapperPtr->changes.width != configEventPtr->width)
	    || (wrapperPtr->changes.height != configEventPtr->height))
	    && !(wmPtr->flags & WM_SYNC_PENDING)){
	if (dispPtr->wmTracing) {
	    printf("TopLevelEventProc: user changed %s size to %dx%d\n",
		    winPtr->pathName, configEventPtr->width,
		    configEventPtr->height);
	}
	if ((wmPtr->width == -1)
		&& (configEventPtr->width == winPtr->reqWidth)) {
	    /*
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
		}
            }
	}
	wmPtr->configWidth = configEventPtr->width;
	wmPtr->configHeight = configEventPtr->height;
    }

    if (wmTracing) {
	printf("ConfigureEvent: %s x = %d y = %d, width = %d, height = %d",
		winPtr->pathName, configEventPtr->x, configEventPtr->y,
		configEventPtr->width, configEventPtr->height);
	printf(" send_event = %d, serial = %ld\n", configEventPtr->send_event,
		configEventPtr->serial);
    }
    wrapperPtr->changes.width = configEventPtr->width;







|







2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
		}
            }
	}
	wmPtr->configWidth = configEventPtr->width;
	wmPtr->configHeight = configEventPtr->height;
    }

    if (dispPtr->wmTracing) {
	printf("ConfigureEvent: %s x = %d y = %d, width = %d, height = %d",
		winPtr->pathName, configEventPtr->x, configEventPtr->y,
		configEventPtr->width, configEventPtr->height);
	printf(" send_event = %d, serial = %ld\n", configEventPtr->send_event,
		configEventPtr->serial);
    }
    wrapperPtr->changes.width = configEventPtr->width;
2202
2203
2204
2205
2206
2207
2208

2209
2210
2211
2212
2213
2214
2215
    TkWindow *wrapperPtr = wmPtr->wrapperPtr;
    Window vRoot, ancestor, *children, dummy2, *virtualRootPtr;
    Atom actualType;
    int actualFormat;
    unsigned long numItems, bytesAfter;
    unsigned int dummy;
    Tk_ErrorHandler handler;


    /*
     * Identify the root window for wrapperPtr.  This is tricky because of
     * virtual root window managers like tvtwm.  If the window has a
     * property named __SWM_ROOT or __WM_ROOT then this property gives
     * the id for a virtual root window that should be used instead of
     * the root window of the screen.







>







2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
    TkWindow *wrapperPtr = wmPtr->wrapperPtr;
    Window vRoot, ancestor, *children, dummy2, *virtualRootPtr;
    Atom actualType;
    int actualFormat;
    unsigned long numItems, bytesAfter;
    unsigned int dummy;
    Tk_ErrorHandler handler;
    TkDisplay *dispPtr = wmPtr->winPtr->dispPtr;

    /*
     * Identify the root window for wrapperPtr.  This is tricky because of
     * virtual root window managers like tvtwm.  If the window has a
     * property named __SWM_ROOT or __WM_ROOT then this property gives
     * the id for a virtual root window that should be used instead of
     * the root window of the screen.
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
	    || ((XGetWindowProperty(wrapperPtr->display, wrapperPtr->window,
	    Tk_InternAtom((Tk_Window) wrapperPtr, "__SWM_ROOT"), 0, (long) 1,
	    False, XA_WINDOW, &actualType, &actualFormat, &numItems,
	    &bytesAfter, (unsigned char **) &virtualRootPtr) == Success)
	    && (actualType == XA_WINDOW))) {
	if ((actualFormat == 32) && (numItems == 1)) {
	    vRoot = wmPtr->vRoot = *virtualRootPtr;
	} else if (wmTracing) {
	    printf("%s format %d numItems %ld\n",
		    "ReparentEvent got bogus VROOT property:", actualFormat,
		    numItems);
	}
	XFree((char *) virtualRootPtr);
    }
    Tk_DeleteErrorHandler(handler);

    if (wmTracing) {
	printf("ReparentEvent: %s reparented to 0x%x, vRoot = 0x%x\n",
		wmPtr->winPtr->pathName,
		(unsigned int) reparentEventPtr->parent, (unsigned int) vRoot);
    }

    /*
     * Fetch correct geometry information for the new virtual root.







|








|







2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
	    || ((XGetWindowProperty(wrapperPtr->display, wrapperPtr->window,
	    Tk_InternAtom((Tk_Window) wrapperPtr, "__SWM_ROOT"), 0, (long) 1,
	    False, XA_WINDOW, &actualType, &actualFormat, &numItems,
	    &bytesAfter, (unsigned char **) &virtualRootPtr) == Success)
	    && (actualType == XA_WINDOW))) {
	if ((actualFormat == 32) && (numItems == 1)) {
	    vRoot = wmPtr->vRoot = *virtualRootPtr;
	} else if (dispPtr->wmTracing) {
	    printf("%s format %d numItems %ld\n",
		    "ReparentEvent got bogus VROOT property:", actualFormat,
		    numItems);
	}
	XFree((char *) virtualRootPtr);
    }
    Tk_DeleteErrorHandler(handler);

    if (dispPtr->wmTracing) {
	printf("ReparentEvent: %s reparented to 0x%x, vRoot = 0x%x\n",
		wmPtr->winPtr->pathName,
		(unsigned int) reparentEventPtr->parent, (unsigned int) vRoot);
    }

    /*
     * Fetch correct geometry information for the new virtual root.
2333
2334
2335
2336
2337
2338
2339

2340
2341
2342
2343
2344
2345
2346
    TkWindow *wrapperPtr = wmPtr->wrapperPtr;
    int width, height, bd;
    unsigned int dummy;
    int xOffset, yOffset, x, y;
    Window dummy2;
    Status status;
    Tk_ErrorHandler handler;


    handler = Tk_CreateErrorHandler(wrapperPtr->display, -1, -1, -1,
	    (Tk_ErrorProc *) NULL, (ClientData) NULL);
    (void) XTranslateCoordinates(wrapperPtr->display, wrapperPtr->window,
	    wmPtr->reparent, 0, 0, &xOffset, &yOffset, &dummy2);
    status = XGetGeometry(wrapperPtr->display, wmPtr->reparent,
	    &dummy2, &x, &y, (unsigned int *) &width,







>







2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
    TkWindow *wrapperPtr = wmPtr->wrapperPtr;
    int width, height, bd;
    unsigned int dummy;
    int xOffset, yOffset, x, y;
    Window dummy2;
    Status status;
    Tk_ErrorHandler handler;
    TkDisplay *dispPtr = wmPtr->winPtr->dispPtr;

    handler = Tk_CreateErrorHandler(wrapperPtr->display, -1, -1, -1,
	    (Tk_ErrorProc *) NULL, (ClientData) NULL);
    (void) XTranslateCoordinates(wrapperPtr->display, wrapperPtr->window,
	    wmPtr->reparent, 0, 0, &xOffset, &yOffset, &dummy2);
    status = XGetGeometry(wrapperPtr->display, wmPtr->reparent,
	    &dummy2, &x, &y, (unsigned int *) &width,
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
	if (wmPtr->flags & WM_NEGATIVE_Y) {
	    wmPtr->y = wmPtr->vRootHeight - (wmPtr->y + wmPtr->parentHeight);
	}
    }

    wmPtr->wrapperPtr->changes.x = x + wmPtr->xInParent;
    wmPtr->wrapperPtr->changes.y = y + wmPtr->yInParent;
    if (wmTracing) {
	printf("wrapperPtr coords %d,%d, wmPtr coords %d,%d, offsets %d %d\n",
		wrapperPtr->changes.x, wrapperPtr->changes.y,
		wmPtr->x, wmPtr->y, wmPtr->xInParent, wmPtr->yInParent);
    }
    return 1;
}








|







2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
	if (wmPtr->flags & WM_NEGATIVE_Y) {
	    wmPtr->y = wmPtr->vRootHeight - (wmPtr->y + wmPtr->parentHeight);
	}
    }

    wmPtr->wrapperPtr->changes.x = x + wmPtr->xInParent;
    wmPtr->wrapperPtr->changes.y = y + wmPtr->yInParent;
    if (dispPtr->wmTracing) {
	printf("wrapperPtr coords %d,%d, wmPtr coords %d,%d, offsets %d %d\n",
		wrapperPtr->changes.x, wrapperPtr->changes.y,
		wmPtr->x, wmPtr->y, wmPtr->xInParent, wmPtr->yInParent);
    }
    return 1;
}

2432
2433
2434
2435
2436
2437
2438

2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
static void
WrapperEventProc(clientData, eventPtr)
    ClientData clientData;		/* Information about toplevel window. */
    XEvent *eventPtr;			/* Event that just happened. */
{
    WmInfo *wmPtr = (WmInfo *) clientData;
    XEvent mapEvent;


    wmPtr->flags |= WM_VROOT_OFFSET_STALE;
    if (eventPtr->type == DestroyNotify) {
	Tk_ErrorHandler handler;

	if (!(wmPtr->wrapperPtr->flags & TK_ALREADY_DEAD)) {
	    /*
	     * A top-level window was deleted externally (e.g., by the window
	     * manager).  This is probably not a good thing, but cleanup as
	     * best we can.  The error handler is needed because
	     * Tk_DestroyWindow will try to destroy the window, but of course
	     * it's already gone.
	     */
    
	    handler = Tk_CreateErrorHandler(wmPtr->winPtr->display, -1, -1, -1,
		    (Tk_ErrorProc *) NULL, (ClientData) NULL);
	    Tk_DestroyWindow((Tk_Window) wmPtr->winPtr);
	    Tk_DeleteErrorHandler(handler);
	}
	if (wmTracing) {
	    printf("TopLevelEventProc: %s deleted\n", wmPtr->winPtr->pathName);
	}
    } else if (eventPtr->type == ConfigureNotify) {
	/*
	 * Ignore the event if the window has never been mapped yet.
	 * Such an event occurs only in weird cases like changing the
	 * internal border width of a top-level window, which results







>



















|







2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
static void
WrapperEventProc(clientData, eventPtr)
    ClientData clientData;		/* Information about toplevel window. */
    XEvent *eventPtr;			/* Event that just happened. */
{
    WmInfo *wmPtr = (WmInfo *) clientData;
    XEvent mapEvent;
    TkDisplay *dispPtr = wmPtr->winPtr->dispPtr;

    wmPtr->flags |= WM_VROOT_OFFSET_STALE;
    if (eventPtr->type == DestroyNotify) {
	Tk_ErrorHandler handler;

	if (!(wmPtr->wrapperPtr->flags & TK_ALREADY_DEAD)) {
	    /*
	     * A top-level window was deleted externally (e.g., by the window
	     * manager).  This is probably not a good thing, but cleanup as
	     * best we can.  The error handler is needed because
	     * Tk_DestroyWindow will try to destroy the window, but of course
	     * it's already gone.
	     */
    
	    handler = Tk_CreateErrorHandler(wmPtr->winPtr->display, -1, -1, -1,
		    (Tk_ErrorProc *) NULL, (ClientData) NULL);
	    Tk_DestroyWindow((Tk_Window) wmPtr->winPtr);
	    Tk_DeleteErrorHandler(handler);
	}
	if (dispPtr->wmTracing) {
	    printf("TopLevelEventProc: %s deleted\n", wmPtr->winPtr->pathName);
	}
    } else if (eventPtr->type == ConfigureNotify) {
	/*
	 * Ignore the event if the window has never been mapped yet.
	 * Such an event occurs only in weird cases like changing the
	 * internal border width of a top-level window, which results
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
	     */

	    wmPtr->flags &= ~WM_MOVE_PENDING;
	    return;
	}
	wmPtr->configWidth = width;
	wmPtr->configHeight = height;
	if (wmTracing) {
	   printf("UpdateGeometryInfo moving to %d %d, resizing to %d x %d,\n",
                   x, y, width, height);
	}
	XMoveResizeWindow(winPtr->display, wmPtr->wrapperPtr->window, x, y,
		(unsigned) width, (unsigned) height);
    } else if ((width != wmPtr->configWidth)
	    || (height != wmPtr->configHeight)) {
	if ((width == wmPtr->wrapperPtr->changes.width)
		&& (height == wmPtr->wrapperPtr->changes.height)) {
	    /*
	     * The window is already just the size we want, so don't bother
	     * to configure it;  the X server appears to ignore these
	     * requests, so we won't get back a ConfigureNotify and the
	     * WaitForConfigureNotify call below will hang for a while.
	     */

	    return;
	}
	wmPtr->configWidth = width;
	wmPtr->configHeight = height;
	if (wmTracing) {
	    printf("UpdateGeometryInfo resizing to %d x %d\n", width, height);
	}
	XResizeWindow(winPtr->display, wmPtr->wrapperPtr->window,
		(unsigned) width, (unsigned) height);
    } else if ((wmPtr->menubar != NULL)
	    && ((Tk_Width(wmPtr->menubar) != wmPtr->wrapperPtr->changes.width)
	    || (Tk_Height(wmPtr->menubar) != wmPtr->menuHeight))) {







|




















|







2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
	     */

	    wmPtr->flags &= ~WM_MOVE_PENDING;
	    return;
	}
	wmPtr->configWidth = width;
	wmPtr->configHeight = height;
	if (winPtr->dispPtr->wmTracing) {
	   printf("UpdateGeometryInfo moving to %d %d, resizing to %d x %d,\n",
                   x, y, width, height);
	}
	XMoveResizeWindow(winPtr->display, wmPtr->wrapperPtr->window, x, y,
		(unsigned) width, (unsigned) height);
    } else if ((width != wmPtr->configWidth)
	    || (height != wmPtr->configHeight)) {
	if ((width == wmPtr->wrapperPtr->changes.width)
		&& (height == wmPtr->wrapperPtr->changes.height)) {
	    /*
	     * The window is already just the size we want, so don't bother
	     * to configure it;  the X server appears to ignore these
	     * requests, so we won't get back a ConfigureNotify and the
	     * WaitForConfigureNotify call below will hang for a while.
	     */

	    return;
	}
	wmPtr->configWidth = width;
	wmPtr->configHeight = height;
	if (winPtr->dispPtr->wmTracing) {
	    printf("UpdateGeometryInfo resizing to %d x %d\n", width, height);
	}
	XResizeWindow(winPtr->display, wmPtr->wrapperPtr->window,
		(unsigned) width, (unsigned) height);
    } else if ((wmPtr->menubar != NULL)
	    && ((Tk_Width(wmPtr->menubar) != wmPtr->wrapperPtr->changes.width)
	    || (Tk_Height(wmPtr->menubar) != wmPtr->menuHeight))) {
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962

    while (!gotConfig) {
	wmPtr->flags |= WM_SYNC_PENDING;
	code = WaitForEvent(winPtr->display, wmPtr->wrapperPtr->window,
		ConfigureNotify, &event);
	wmPtr->flags &= ~WM_SYNC_PENDING;
	if (code != TCL_OK) {
	    if (wmTracing) {
		printf("WaitForConfigureNotify giving up on %s\n",
			winPtr->pathName);
	    }
	    break;
	}
	diff = event.xconfigure.serial - serial;
	if (diff >= 0) {
	    gotConfig = 1;
	}
    }
    wmPtr->flags &= ~WM_MOVE_PENDING;
    if (wmTracing) {
	printf("WaitForConfigureNotify finished with %s, serial %ld\n",
		winPtr->pathName, serial);
    }
}

/*
 *----------------------------------------------------------------------







|











|







2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017

    while (!gotConfig) {
	wmPtr->flags |= WM_SYNC_PENDING;
	code = WaitForEvent(winPtr->display, wmPtr->wrapperPtr->window,
		ConfigureNotify, &event);
	wmPtr->flags &= ~WM_SYNC_PENDING;
	if (code != TCL_OK) {
	    if (winPtr->dispPtr->wmTracing) {
		printf("WaitForConfigureNotify giving up on %s\n",
			winPtr->pathName);
	    }
	    break;
	}
	diff = event.xconfigure.serial - serial;
	if (diff >= 0) {
	    gotConfig = 1;
	}
    }
    wmPtr->flags &= ~WM_MOVE_PENDING;
    if (winPtr->dispPtr->wmTracing) {
	printf("WaitForConfigureNotify finished with %s, serial %ld\n",
		winPtr->pathName, serial);
    }
}

/*
 *----------------------------------------------------------------------
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
	    /*
	     * There are some bizarre situations in which the window
	     * manager can't respond or chooses not to (e.g. if we've
	     * got a grab set it can't respond).  If this happens then
	     * just quit.
	     */

	    if (wmTracing) {
		printf("WaitForMapNotify giving up on %s\n", winPtr->pathName);
	    }
	    break;
	}
    }
    wmPtr->flags &= ~WM_MOVE_PENDING;
    if (wmTracing) {
	printf("WaitForMapNotify finished with %s\n", winPtr->pathName);
    }
}

/*
 *--------------------------------------------------------------
 *







|






|







3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
	    /*
	     * There are some bizarre situations in which the window
	     * manager can't respond or chooses not to (e.g. if we've
	     * got a grab set it can't respond).  If this happens then
	     * just quit.
	     */

	    if (winPtr->dispPtr->wmTracing) {
		printf("WaitForMapNotify giving up on %s\n", winPtr->pathName);
	    }
	    break;
	}
    }
    wmPtr->flags &= ~WM_MOVE_PENDING;
    if (winPtr->dispPtr->wmTracing) {
	printf("WaitForMapNotify finished with %s\n", winPtr->pathName);
    }
}

/*
 *--------------------------------------------------------------
 *
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
 *
 *	This procedure parses a geometry string and updates
 *	information used to control the geometry of a top-level
 *	window.
 *
 * Results:
 *	A standard Tcl return value, plus an error message in
 *	interp->result if an error occurs.
 *
 * Side effects:
 *	The size and/or location of winPtr may change.
 *
 *--------------------------------------------------------------
 */








|







3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
 *
 *	This procedure parses a geometry string and updates
 *	information used to control the geometry of a top-level
 *	window.
 *
 * Results:
 *	A standard Tcl return value, plus an error message in
 *	the interp's result if an error occurs.
 *
 * Side effects:
 *	The size and/or location of winPtr may change.
 *
 *--------------------------------------------------------------
 */

3430
3431
3432
3433
3434
3435
3436

3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
    Tk_Window tkwin;		/* Token for any window in application;
				 * used to identify the display. */
{
    Window window, parent, child;
    int x, y, childX, childY, tmpx, tmpy, bd;
    WmInfo *wmPtr;
    TkWindow *winPtr, *childPtr, *nextPtr;


    /*
     * Step 1: scan the list of toplevel windows to see if there is a
     * virtual root for the screen we're interested in.  If so, we have
     * to translate the coordinates from virtual root to root
     * coordinates.
     */

    parent = window = RootWindowOfScreen(Tk_Screen(tkwin));
    x = rootX;
    y = rootY;
    for (wmPtr = firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) {
	if (Tk_Screen(wmPtr->winPtr) != Tk_Screen(tkwin)) {
	    continue;
	}
	if (wmPtr->vRoot == None) {
	    continue;
	}
	UpdateVRootGeometry(wmPtr);







>











|







3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
    Tk_Window tkwin;		/* Token for any window in application;
				 * used to identify the display. */
{
    Window window, parent, child;
    int x, y, childX, childY, tmpx, tmpy, bd;
    WmInfo *wmPtr;
    TkWindow *winPtr, *childPtr, *nextPtr;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    /*
     * Step 1: scan the list of toplevel windows to see if there is a
     * virtual root for the screen we're interested in.  If so, we have
     * to translate the coordinates from virtual root to root
     * coordinates.
     */

    parent = window = RootWindowOfScreen(Tk_Screen(tkwin));
    x = rootX;
    y = rootY;
    for (wmPtr = (WmInfo *) dispPtr->firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) {
	if (Tk_Screen(wmPtr->winPtr) != Tk_Screen(tkwin)) {
	    continue;
	}
	if (wmPtr->vRoot == None) {
	    continue;
	}
	UpdateVRootGeometry(wmPtr);
3476
3477
3478
3479
3480
3481
3482

3483
3484
3485
3486
3487
3488
3489
3490
	if (XTranslateCoordinates(Tk_Display(tkwin), parent, window,
		x, y, &childX, &childY, &child) == False) {
	    panic("Tk_CoordsToWindow got False return from XTranslateCoordinates");
	}
	if (child == None) {
	    return NULL;
	}

	for (wmPtr = firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) {
	    if (wmPtr->reparent == child) {
		goto gotToplevel;
	    }
	    if (wmPtr->wrapperPtr != NULL) {
		if (child == wmPtr->wrapperPtr->window) {
		    goto gotToplevel;
		}







>
|







3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
	if (XTranslateCoordinates(Tk_Display(tkwin), parent, window,
		x, y, &childX, &childY, &child) == False) {
	    panic("Tk_CoordsToWindow got False return from XTranslateCoordinates");
	}
	if (child == None) {
	    return NULL;
	}
	for (wmPtr = (WmInfo *) dispPtr->firstWmPtr; wmPtr != NULL; 
                wmPtr = wmPtr->nextPtr) {
	    if (wmPtr->reparent == child) {
		goto gotToplevel;
	    }
	    if (wmPtr->wrapperPtr != NULL) {
		if (child == wmPtr->wrapperPtr->window) {
		    goto gotToplevel;
		}
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
    handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1,
	    (Tk_ErrorProc *) NULL, (ClientData) NULL);
    status = XGetGeometry(winPtr->display, wmPtr->vRoot,
	    &dummy2, &wmPtr->vRootX, &wmPtr->vRootY,
	    (unsigned int *) &wmPtr->vRootWidth,
	    (unsigned int *) &wmPtr->vRootHeight, (unsigned int *) &bd,
	    &dummy);
    if (wmTracing) {
	printf("UpdateVRootGeometry: x = %d, y = %d, width = %d, ",
		wmPtr->vRootX, wmPtr->vRootY, wmPtr->vRootWidth);
	printf("height = %d, status = %d\n", wmPtr->vRootHeight, status);
    }
    Tk_DeleteErrorHandler(handler);
    if (status == 0) {
	/*







|







3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
    handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1,
	    (Tk_ErrorProc *) NULL, (ClientData) NULL);
    status = XGetGeometry(winPtr->display, wmPtr->vRoot,
	    &dummy2, &wmPtr->vRootX, &wmPtr->vRootY,
	    (unsigned int *) &wmPtr->vRootWidth,
	    (unsigned int *) &wmPtr->vRootHeight, (unsigned int *) &bd,
	    &dummy);
    if (winPtr->dispPtr->wmTracing) {
	printf("UpdateVRootGeometry: x = %d, y = %d, width = %d, ",
		wmPtr->vRootX, wmPtr->vRootY, wmPtr->vRootWidth);
	printf("height = %d, status = %d\n", wmPtr->vRootHeight, status);
    }
    Tk_DeleteErrorHandler(handler);
    if (status == 0) {
	/*
4807
4808
4809
4810
4811
4812
4813





























































    if ((winPtr == NULL) || (wmPtr == NULL)) {
	return NULL;
    }

    return wmPtr->wrapperPtr;
}



































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930

    if ((winPtr == NULL) || (wmPtr == NULL)) {
	return NULL;
    }

    return wmPtr->wrapperPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateCommand --
 *
 *	Update the WM_COMMAND property, taking care to translate
 *	the command strings into the external encoding.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateCommand(winPtr)
    TkWindow  *winPtr;
{
    register WmInfo *wmPtr = winPtr->wmInfoPtr;
    Tcl_DString cmds, ds;
    int i, *offsets;
    char **cmdArgv;

    /*
     * Translate the argv strings into the external encoding.  To avoid
     * allocating lots of memory, the strings are appended to a buffer
     * with nulls between each string.
     *
     * This code is tricky because we need to pass and array of pointers
     * to XSetCommand.  However, we can't compute the pointers as we go
     * because the DString buffer space could get reallocated.  So, store
     * offsets for each element as we go, then compute pointers from the
     * offsets once the entire DString is done.
     */

    cmdArgv = (char **) ckalloc(sizeof(char *) * wmPtr->cmdArgc);
    offsets = (int *) ckalloc( sizeof(int) * wmPtr->cmdArgc);
    Tcl_DStringInit(&cmds);
    for (i = 0; i < wmPtr->cmdArgc; i++) {
	Tcl_UtfToExternalDString(NULL, wmPtr->cmdArgv[i], -1, &ds);
	offsets[i] = Tcl_DStringLength(&cmds);
	Tcl_DStringAppend(&cmds, Tcl_DStringValue(&ds),
		Tcl_DStringLength(&ds)+1);
	Tcl_DStringFree(&ds);
    }
    cmdArgv[0] = Tcl_DStringValue(&cmds);
    for (i = 1; i < wmPtr->cmdArgc; i++) {
	cmdArgv[i] = cmdArgv[0] + offsets[i];
    }

    XSetCommand(winPtr->display, wmPtr->wrapperPtr->window,
	    cmdArgv, wmPtr->cmdArgc);
    Tcl_DStringFree(&cmds);
    ckfree((char *) cmdArgv);
    ckfree((char *) offsets);
}

Changes to unix/tkUnixXId.c.

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
 *	The replacement functions in this file re-use old identifiers
 *	to prevent this problem.
 *
 *	The code in this file is based on similar implementations by
 *	George C. Kaplan and Michael Hoegeman.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994-1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkUnixXId.c 1.22 97/06/25 13:16:47
 */

/*
 * The definition below is needed on some systems so that we can access
 * the resource_alloc field of Display structures in order to replace
 * the resource allocator.
 */

#define XLIB_ILLEGAL_ACCESS 1

#include "tkInt.h"
#include "tkPort.h"
#include "tkUnixInt.h"

/*
 * A structure of the following type is used to hold one or more
 * available resource identifiers.  There is a list of these structures
 * for each display.
 */








|




|










|

<







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
 *	The replacement functions in this file re-use old identifiers
 *	to prevent this problem.
 *
 *	The code in this file is based on similar implementations by
 *	George C. Kaplan and Michael Hoegeman.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixXId.c,v 1.1.4.2 1998/09/30 02:19:24 stanton Exp $
 */

/*
 * The definition below is needed on some systems so that we can access
 * the resource_alloc field of Display structures in order to replace
 * the resource allocator.
 */

#define XLIB_ILLEGAL_ACCESS 1

#include "tkUnixInt.h"
#include "tkPort.h"


/*
 * A structure of the following type is used to hold one or more
 * available resource identifiers.  There is a list of these structures
 * for each display.
 */

Changes to win/README.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
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
Tk 8.0p2 for Windows

by Scott Stanton
Sun Microsystems Laboratories
scott.stanton@eng.sun.com

SCCS: @(#) README 1.20 97/11/21 15:17:54

1. Introduction
---------------

This is the directory where you configure and compile the Windows
version of Tk.  This directory also contains source files for Tk
that are specific to Microsoft Windows.  The rest of this file
contains information specific to the Windows version of Tk.

2. Distribution notes
---------------------

Tk 8.0 for Windows is distributed in binary form in addition to the
common source release.  The binary distribution is a self-extracting
archive with a built-in installation script.

Look for the binary release in the same location as the source release
(ftp.smli.com:/pub/tcl or any of the mirror sites).  For most users,
the binary release will be much easier to install and use.  You only
need the source release if you plan to modify the core of Tcl, or if
you need to compile with a different compiler.  With the addition of
the dynamic loading interface, it is no longer necessary to have the
source distribution in order to build and use extensions.

3. Compiling Tk
----------------

In order to compile Tk for Windows, you need the following items:

	Tcl 8.0 Source Distribution (plus any patches)
	Tk 8.0 Source Distribution (plus any patches)

	The latest Win32 SDK header files

	Borland C++ 4.5 or later (32-bit compiler)
	  or
	Visual C++ 2.x or later
	


In the "win" subdirectory of the source release, you will find two
files called "makefile.bc" and "makefile.vc".  These are the makefiles
for the Borland and Visual C++ compilers respectively.  You should
copy the appropriate one to "makefile" and update the paths at the top
of the file to reflect your system configuration.  Now you can use
"make" (or "nmake" for VC++) to build the tk libraries and the wish
executable.

In order to use the binaries generated by these makefiles, you will
need to place the Tk script library files someplace where Tk can
find them.  Tk looks in one of two places for the library files:

	1) The environment variable "TK_LIBRARY".

	2) In the lib\tk8.0 directory under the Tcl installation directory
	   as specified in the registry:

		For Windows NT & 95:
		    HKEY_LOCAL_MACHINE\SOFTWARE\Sun\Tcl\8.0
			Value Name is "Root"

		For Win32s:
		    HKEY_CLASSES_ROOT\SOFTWARE\Sun\Tcl\8.0\

	2) Relative to the directory containing the current .exe.
	    Tk will look for a directory "..\lib\tk8.0" relative to the
	    directory containing the currently running .exe.

Note that in order to run wish80.exe, you must ensure that tcl80.dll,
tclpip80.dll (plus tcl1680.dll under Win32s), and tk80.dll are on your
path, in the system directory, or in the directory containing
wish80.exe.


4. Test suite
-------------

The Windows version of Tk does not pass many of the tests in the test
suite.  This is primarily due to dependencies in the test suite on the
size of particular X fonts, and other X related features as well as
|


|
|

|












|




|











|
|






|
>















|


<
|
<

<
<
<

|


|
|
|
|
>







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
Tk 8.1 for Windows

by Scott Stanton
Scriptics Corporation
scott.stanton@scriptics.com

RCS: @(#) $Id: README,v 1.1.4.7 1999/03/25 00:33:26 rjohnson Exp $

1. Introduction
---------------

This is the directory where you configure and compile the Windows
version of Tk.  This directory also contains source files for Tk
that are specific to Microsoft Windows.  The rest of this file
contains information specific to the Windows version of Tk.

2. Distribution notes
---------------------

Tk 8.1 for Windows is distributed in binary form in addition to the
common source release.  The binary distribution is a self-extracting
archive with a built-in installation script.

Look for the binary release in the same location as the source release
(ftp.scriptics.com:/pub/tcl/tcl8_1 or any of the mirror sites).  For most users,
the binary release will be much easier to install and use.  You only
need the source release if you plan to modify the core of Tcl, or if
you need to compile with a different compiler.  With the addition of
the dynamic loading interface, it is no longer necessary to have the
source distribution in order to build and use extensions.

3. Compiling Tk
----------------

In order to compile Tk for Windows, you need the following items:

	Tcl 8.1 Source Distribution (plus any patches)
	Tk 8.1 Source Distribution (plus any patches)

	The latest Win32 SDK header files

	Borland C++ 4.5 or later (32-bit compiler)
	  or
	Visual C++ 2.x or later

In practice, 8.1 was built with Visual C++ 5.0

In the "win" subdirectory of the source release, you will find two
files called "makefile.bc" and "makefile.vc".  These are the makefiles
for the Borland and Visual C++ compilers respectively.  You should
copy the appropriate one to "makefile" and update the paths at the top
of the file to reflect your system configuration.  Now you can use
"make" (or "nmake" for VC++) to build the tk libraries and the wish
executable.

In order to use the binaries generated by these makefiles, you will
need to place the Tk script library files someplace where Tk can
find them.  Tk looks in one of two places for the library files:

	1) The environment variable "TK_LIBRARY".

	2) In the lib\tk8.1 directory under the Tcl installation directory
	   as specified in the registry:


		    HKEY_LOCAL_MACHINE\SOFTWARE\Scriptics\Tcl\8.1\





	2) Relative to the directory containing the current .exe.
	    Tk will look for a directory "..\lib\tk8.1" relative to the
	    directory containing the currently running .exe.

Note that in order to run wish81.exe, you must ensure that tcl81.dll,
tclpip81.dll, and tk81.dll are on your path, in the system directory, 
or in the directory containing wish81.exe.

Note that Tk no longer supports Win32s.

4. Test suite
-------------

The Windows version of Tk does not pass many of the tests in the test
suite.  This is primarily due to dependencies in the test suite on the
size of particular X fonts, and other X related features as well as
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

- There is no support for custom cursors/application icons.  The core
  set of X cursors is supported, although you cannot change their color.
- Stippling of arcs isn't implemented yet.
- Some "wm" functions don't map to Windows and aren't implemented;
  others should map, but just aren't implemented.  The worst offenders
  are the icon manipulation routines.
- Under Win32s, you can only start one instance of Wish at a time.
- Color management on some displays doesn't work properly resulting in
  Tk switching to monochrome mode.
- Tk seems to fail to draw anything on some Matrox Millenium cards.
- Send and winfo interps are not currently supported
- Printing does not work for images (e.g. GIF) on a canvas.
- Tk_dialog appears in the upper left corner.  This is a symptom of a
  larger problem with "wm geometry" when applied to unmapped or
  iconified windows.
- Some keys don't work on international keyboards.
- Grabs do not affect native menus or the title bar.
- PPM images are using the wrong translation mode for writing to
  files, resulting in CR/LF terminated PPM files.
- Tk crashes if the display depth changes while it is running.  Tk
  also doesn't consistently track changes in the system colors.

If you have comments or bug reports for the Windows version of Tk,
please direct them to:

Scott Stanton
[email protected]

or post them to the newsgroup comp.lang.tcl.







<



<




<
<






|

|
<


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

- There is no support for custom cursors/application icons.  The core
  set of X cursors is supported, although you cannot change their color.
- Stippling of arcs isn't implemented yet.
- Some "wm" functions don't map to Windows and aren't implemented;
  others should map, but just aren't implemented.  The worst offenders
  are the icon manipulation routines.

- Color management on some displays doesn't work properly resulting in
  Tk switching to monochrome mode.
- Tk seems to fail to draw anything on some Matrox Millenium cards.

- Printing does not work for images (e.g. GIF) on a canvas.
- Tk_dialog appears in the upper left corner.  This is a symptom of a
  larger problem with "wm geometry" when applied to unmapped or
  iconified windows.


- PPM images are using the wrong translation mode for writing to
  files, resulting in CR/LF terminated PPM files.
- Tk crashes if the display depth changes while it is running.  Tk
  also doesn't consistently track changes in the system colors.

If you have comments or bug reports for the Windows version of Tk,
please use our on-line bug form at:

http://www.scriptics.com/support/bugForm.html


or post them to the newsgroup comp.lang.tcl.

Changes to win/makefile.bc.

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
# Borland C++ 4.5 makefile for Tk
#
# Copyright (c) 1995-1996 by Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) makefile.bc 1.73 97/11/05 16:12:27


#
# Project directories
#
# ROOT = top of source tree
# TMPDIR = location where .obj files should be stored during build
# TCLDIR = location of top of Tcl source heirarchy
#

ROOT	= ..
TMPDIR	= .
TOOLS	= c:\bc45
TCLDIR	= ..\..\tcl8.0

# uncomment the following line to compile with symbols
#DEBUG=1

# uncomment the following line to compile with TCL_MEM_DEBUG
#DEBUGDEFINES	=TCL_MEM_DEBUG



|




|













|







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
# Borland C++ 4.5 makefile for Tk
#
# Copyright (c) 1995-1997 by Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: makefile.bc,v 1.1.4.6 1999/03/17 22:06:29 stanton Exp $


#
# Project directories
#
# ROOT = top of source tree
# TMPDIR = location where .obj files should be stored during build
# TCLDIR = location of top of Tcl source heirarchy
#

ROOT	= ..
TMPDIR	= .
TOOLS	= c:\bc45
TCLDIR	= ..\..\tcl8.1b3

# uncomment the following line to compile with symbols
#DEBUG=1

# uncomment the following line to compile with TCL_MEM_DEBUG
#DEBUGDEFINES	=TCL_MEM_DEBUG

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

.suffixes: .c .dll .lib .obj .exe

.path.c=$(ROOT)\win;$(ROOT)\generic;$(ROOT)\xlib;$(ROOT)\unix
.path.obj=$(TMPDIR)

WISHOBJS = \
	$(TMPDIR)\tkConsole.obj \
	$(TMPDIR)\winMain.obj

TKTESTOBJS = \
	$(TMPDIR)\tkConsole.obj \
	$(TMPDIR)\tkTest.obj \
	$(TMPDIR)\tkSquare.obj \
	$(TMPDIR)\testMain.obj

XLIBOBJS = \
	$(TMPDIR)\xcolors.obj \
	$(TMPDIR)\xdraw.obj \
	$(TMPDIR)\xgc.obj \
	$(TMPDIR)\ximage.obj \
	$(TMPDIR)\xutil.obj

TKOBJS = \

	$(TMPDIR)\tkUnixMenubu.obj \
	$(TMPDIR)\tkUnixScale.obj \
	$(XLIBOBJS) \
	$(TMPDIR)\tkWin3d.obj \
	$(TMPDIR)\tkWin32Dll.obj \
	$(TMPDIR)\tkWinButton.obj \
	$(TMPDIR)\tkWinClipboard.obj \
	$(TMPDIR)\tkWinColor.obj \

	$(TMPDIR)\tkWinCursor.obj \
	$(TMPDIR)\tkWinDialog.obj \
	$(TMPDIR)\tkWinDraw.obj \
	$(TMPDIR)\tkWinEmbed.obj \
	$(TMPDIR)\tkWinFont.obj \
	$(TMPDIR)\tkWinImage.obj \
	$(TMPDIR)\tkWinInit.obj \
	$(TMPDIR)\tkWinKey.obj \
	$(TMPDIR)\tkWinMenu.obj \
	$(TMPDIR)\tkWinPixmap.obj \
	$(TMPDIR)\tkWinPointer.obj \
	$(TMPDIR)\tkWinRegion.obj \
	$(TMPDIR)\tkWinScrlbr.obj \
	$(TMPDIR)\tkWinSend.obj \

	$(TMPDIR)\tkWinWindow.obj \
	$(TMPDIR)\tkWinWm.obj \
	$(TMPDIR)\tkWinX.obj \
	$(TMPDIR)\stubs.obj \
	$(TMPDIR)\tk3d.obj \
	$(TMPDIR)\tkArgv.obj \
	$(TMPDIR)\tkAtom.obj \







<



<












>








>














>







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

.suffixes: .c .dll .lib .obj .exe

.path.c=$(ROOT)\win;$(ROOT)\generic;$(ROOT)\xlib;$(ROOT)\unix
.path.obj=$(TMPDIR)

WISHOBJS = \

	$(TMPDIR)\winMain.obj

TKTESTOBJS = \

	$(TMPDIR)\tkTest.obj \
	$(TMPDIR)\tkSquare.obj \
	$(TMPDIR)\testMain.obj

XLIBOBJS = \
	$(TMPDIR)\xcolors.obj \
	$(TMPDIR)\xdraw.obj \
	$(TMPDIR)\xgc.obj \
	$(TMPDIR)\ximage.obj \
	$(TMPDIR)\xutil.obj

TKOBJS = \
	$(TMPDIR)\tkConsole.obj \
	$(TMPDIR)\tkUnixMenubu.obj \
	$(TMPDIR)\tkUnixScale.obj \
	$(XLIBOBJS) \
	$(TMPDIR)\tkWin3d.obj \
	$(TMPDIR)\tkWin32Dll.obj \
	$(TMPDIR)\tkWinButton.obj \
	$(TMPDIR)\tkWinClipboard.obj \
	$(TMPDIR)\tkWinColor.obj \
	$(TMPDIR)\tkWinConfig.obj \
	$(TMPDIR)\tkWinCursor.obj \
	$(TMPDIR)\tkWinDialog.obj \
	$(TMPDIR)\tkWinDraw.obj \
	$(TMPDIR)\tkWinEmbed.obj \
	$(TMPDIR)\tkWinFont.obj \
	$(TMPDIR)\tkWinImage.obj \
	$(TMPDIR)\tkWinInit.obj \
	$(TMPDIR)\tkWinKey.obj \
	$(TMPDIR)\tkWinMenu.obj \
	$(TMPDIR)\tkWinPixmap.obj \
	$(TMPDIR)\tkWinPointer.obj \
	$(TMPDIR)\tkWinRegion.obj \
	$(TMPDIR)\tkWinScrlbr.obj \
	$(TMPDIR)\tkWinSend.obj \
	$(TMPDIR)\tkWinTest.obj \
	$(TMPDIR)\tkWinWindow.obj \
	$(TMPDIR)\tkWinWm.obj \
	$(TMPDIR)\tkWinX.obj \
	$(TMPDIR)\stubs.obj \
	$(TMPDIR)\tk3d.obj \
	$(TMPDIR)\tkArgv.obj \
	$(TMPDIR)\tkAtom.obj \
165
166
167
168
169
170
171


172
173
174
175
176
177
178
	$(TMPDIR)\tkListbox.obj \
	$(TMPDIR)\tkMacWinMenu.obj \
	$(TMPDIR)\tkMain.obj \
	$(TMPDIR)\tkMenu.obj \
	$(TMPDIR)\tkMenubutton.obj \
	$(TMPDIR)\tkMenuDraw.obj \
	$(TMPDIR)\tkMessage.obj \


	$(TMPDIR)\tkOption.obj \
	$(TMPDIR)\tkPack.obj \
	$(TMPDIR)\tkPlace.obj \
	$(TMPDIR)\tkPointer.obj \
	$(TMPDIR)\tkRectOval.obj \
	$(TMPDIR)\tkScale.obj \
	$(TMPDIR)\tkScrollbar.obj \







>
>







166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
	$(TMPDIR)\tkListbox.obj \
	$(TMPDIR)\tkMacWinMenu.obj \
	$(TMPDIR)\tkMain.obj \
	$(TMPDIR)\tkMenu.obj \
	$(TMPDIR)\tkMenubutton.obj \
	$(TMPDIR)\tkMenuDraw.obj \
	$(TMPDIR)\tkMessage.obj \
	$(TMPDIR)\tkObj.obj \
	$(TMPDIR)\tkOldConfig.obj \
	$(TMPDIR)\tkOption.obj \
	$(TMPDIR)\tkPack.obj \
	$(TMPDIR)\tkPlace.obj \
	$(TMPDIR)\tkPointer.obj \
	$(TMPDIR)\tkRectOval.obj \
	$(TMPDIR)\tkScale.obj \
	$(TMPDIR)\tkScrollbar.obj \
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
	$(TMPDIR)\tkTextTag.obj \
	$(TMPDIR)\tkTextWind.obj \
	$(TMPDIR)\tkTrig.obj \
	$(TMPDIR)\tkUtil.obj \
	$(TMPDIR)\tkVisual.obj \
	$(TMPDIR)\tkWindow.obj

TCLDLL = tcl80.dll
TCLLIB = tcl80.lib
TKDLL = tk80.dll
TKLIB = tk80.lib
WISH = wish80.exe
TKTEST = tktest.exe

#
# Targets
#

all: cfgdll $(TKDLL) cfgexe $(WISH) cfgcln







|
|
|
|
|







189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
	$(TMPDIR)\tkTextTag.obj \
	$(TMPDIR)\tkTextWind.obj \
	$(TMPDIR)\tkTrig.obj \
	$(TMPDIR)\tkUtil.obj \
	$(TMPDIR)\tkVisual.obj \
	$(TMPDIR)\tkWindow.obj

TCLDLL = tcl81.dll
TCLLIB = tcl81.lib
TKDLL = tk81.dll
TKLIB = tk81.lib
WISH = wish81.exe
TKTEST = tktest.exe

#
# Targets
#

all: cfgdll $(TKDLL) cfgexe $(WISH) cfgcln

Changes to win/makefile.vc.

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
# Visual C++ 2.x and 4.0 makefile
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# SCCS: @(#) makefile.vc 1.64 97/10/27 17:27:20

# Does not depend on the presence of any environment variables in
# order to compile tcl; all needed information is derived from 
# location of the compiler directories.

#
# Project directories
#
# ROOT    = top of source tree
#
# TMPDIR  = location where .obj files should be stored during build
#
# TOOLS32 = location of VC++ 32-bit development tools. Note that the
#	    VC++ 2.0 header files are broken, so you need to use the
#	    ones that come with the developer network CD's, or later
#	    versions of VC++.
#
# TCLDIR = location of top of Tcl source heirarchy
#

ROOT	= ..
TMPDIR	= .
TOOLS32	= c:\msdev
TCLDIR	= ..\..\tcl8.0


# Set this to the appropriate value of /MACHINE: for your platform
MACHINE	= IX86

# Comment the following line to compile with symbols



NODEBUG=1

# uncomment the following two lines to compile with TCL_MEM_DEBUG
#DEBUGDEFINES	=-DTCL_MEM_DEBUG

######################################################################
# Do not modify below this line
######################################################################




VERSION = 80




TCLDLL = tcl$(VERSION).dll
TCLLIB = tcl$(VERSION).lib











TCLPLUGINDLL = tcl$(VERSION)p.dll

TCLPLUGINLIB = tcl$(VERSION)p.lib
TKDLL = tk$(VERSION).dll
TKLIB = tk$(VERSION).lib





TKPLUGINDLL = tk$(VERSION)p.dll
TKPLUGINLIB = tk$(VERSION)p.lib

WISH = wish$(VERSION).exe

WISHP = wishp$(VERSION).exe
TKTEST = tktest.exe
DUMPEXTS = $(TMPDIR)\dumpexts.exe







WISHOBJS = \
	$(TMPDIR)\tkConsole.obj \
	$(TMPDIR)\winMain.obj

TKTESTOBJS = \
	$(TMPDIR)\tkConsole.obj \
	$(TMPDIR)\tkTest.obj \
	$(TMPDIR)\tkSquare.obj \
	$(TMPDIR)\testMain.obj



XLIBOBJS = \
	$(TMPDIR)\xcolors.obj \
	$(TMPDIR)\xdraw.obj \
	$(TMPDIR)\xgc.obj \
	$(TMPDIR)\ximage.obj \
	$(TMPDIR)\xutil.obj

TKOBJS = \

	$(TMPDIR)\tkUnixMenubu.obj \
	$(TMPDIR)\tkUnixScale.obj \
	$(XLIBOBJS) \
	$(TMPDIR)\tkWin3d.obj \
	$(TMPDIR)\tkWin32Dll.obj \
	$(TMPDIR)\tkWinButton.obj \
	$(TMPDIR)\tkWinClipboard.obj \
	$(TMPDIR)\tkWinColor.obj \

	$(TMPDIR)\tkWinCursor.obj \
	$(TMPDIR)\tkWinDialog.obj \
	$(TMPDIR)\tkWinDraw.obj \
	$(TMPDIR)\tkWinEmbed.obj \
	$(TMPDIR)\tkWinFont.obj \
	$(TMPDIR)\tkWinImage.obj \
	$(TMPDIR)\tkWinInit.obj \
	$(TMPDIR)\tkWinKey.obj \
	$(TMPDIR)\tkWinMenu.obj \
	$(TMPDIR)\tkWinPixmap.obj \
	$(TMPDIR)\tkWinPointer.obj \
	$(TMPDIR)\tkWinRegion.obj \
	$(TMPDIR)\tkWinScrlbr.obj \
	$(TMPDIR)\tkWinSend.obj \

	$(TMPDIR)\tkWinWindow.obj \
	$(TMPDIR)\tkWinWm.obj \
	$(TMPDIR)\tkWinX.obj \
	$(TMPDIR)\stubs.obj \
	$(TMPDIR)\tk3d.obj \
	$(TMPDIR)\tkArgv.obj \
	$(TMPDIR)\tkAtom.obj \





|
|




















|
|
|
|
>




|
>
>
>
|








>
>
>
|
>

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

|
>
|
|
|
>

>
>
>
>
>

<



<


|
>
>









>








>














>







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
# Visual C++ 2.x and 4.0 makefile
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# RCS: @(#) $Id: makefile.vc,v 1.1.4.21 1999/04/01 21:58:52 redman Exp $

# Does not depend on the presence of any environment variables in
# order to compile tcl; all needed information is derived from 
# location of the compiler directories.

#
# Project directories
#
# ROOT    = top of source tree
#
# TMPDIR  = location where .obj files should be stored during build
#
# TOOLS32 = location of VC++ 32-bit development tools. Note that the
#	    VC++ 2.0 header files are broken, so you need to use the
#	    ones that come with the developer network CD's, or later
#	    versions of VC++.
#
# TCLDIR = location of top of Tcl source heirarchy
#

ROOT		= ..
TOOLS32		= c:\program files\devstudio\vc
TOOLS32_rc	= c:\program files\devstudio\sharedide
TCLDIR		= ..\..\tcl8.1b3
INSTALLDIR      = c:\program files\tcl

# Set this to the appropriate value of /MACHINE: for your platform
MACHINE	= IX86

# Uncomment the following line to compile with thread support
#THREADDEFINES = -DTCL_THREADS=1

# Set NODEBUG to 0 to compile with symbols
NODEBUG = 1

# uncomment the following two lines to compile with TCL_MEM_DEBUG
#DEBUGDEFINES	=-DTCL_MEM_DEBUG

######################################################################
# Do not modify below this line
######################################################################

TCLNAMEPREFIX = tcl
TKNAMEPREFIX = tk
WISHNAMEPREFIX = wish
VERSION = 81
DOTVERSION = 8.1

TCLSTUBPREFIX = $(TCLNAMEPREFIX)stub
TKSTUBPREFIX  = $(TKNAMEPREFIX)stub


BINROOT		= .
!IF "$(NODEBUG)" == "1"
TMPDIRNAME	= Release
DBGX		=
!ELSE
TMPDIRNAME	= Debug
DBGX		= d
!ENDIF
TMPDIR		= $(BINROOT)\$(TMPDIRNAME)
OUTDIRNAME	= $(TMPDIRNAME)
OUTDIR		= $(TMPDIR)

TCLLIB 		= $(TCLNAMEPREFIX)$(VERSION)$(DBGX).lib
TCLPLUGINLIB 	= $(TCLNAMEPREFIX)$(VERSION)p.lib
TCLSTUBLIB	= $(TCLSTUBPREFIX)$(VERSION)$(DBGX).lib
TKDLLNAME	= $(TKNAMEPREFIX)$(VERSION)$(DBGX).dll
TKDLL 		= $(OUTDIR)\$(TKDLLNAME)
TKLIB 		= $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)$(DBGX).lib
TKSTUBLIBNAME	= $(TKSTUBPREFIX)$(VERSION)$(DBGX).lib
TKSTUBLIB	= $(OUTDIR)\$(TKSTUBLIBNAME)
TKPLUGINDLLNAME	= $(TKNAMEPREFIX)$(VERSION)p$(DBG).dll
TKPLUGINDLL 	= $(OUTDIR)\$(TKPLUGINDLLNAME)
TKPLUGINLIB 	= $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)p$(DBGX).lib

WISH 		= $(OUTDIR)\$(WISHNAMEPREFIX)$(VERSION)$(DBGX).exe
WISHC 		= $(OUTDIR)\$(WISHNAMEPREFIX)c$(VERSION)$(DBGX).exe
WISHP 		= $(OUTDIR)\$(WISHNAMEPREFIX)p$(VERSION)$(DBGX).exe
TKTEST 		= $(OUTDIR)\$(TKNAMEPREFIX)test.exe
DUMPEXTS 	= $(TMPDIR)\dumpexts.exe
CAT32           = $(TMPDIR)\cat32.exe

BIN_INSTALL_DIR = $(INSTALLDIR)\bin
INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include
LIB_INSTALL_DIR = $(INSTALLDIR)\lib
SCRIPT_INSTALL_DIR = $(LIB_INSTALL_DIR)\tk$(DOTVERSION)

WISHOBJS = \

	$(TMPDIR)\winMain.obj

TKTESTOBJS = \

	$(TMPDIR)\tkTest.obj \
	$(TMPDIR)\tkSquare.obj \
	$(TMPDIR)\testMain.obj \
# the tkThreadTest.c file has not been checked it yet.
#	$(TMPDIR)\tkThreadTest.obj

XLIBOBJS = \
	$(TMPDIR)\xcolors.obj \
	$(TMPDIR)\xdraw.obj \
	$(TMPDIR)\xgc.obj \
	$(TMPDIR)\ximage.obj \
	$(TMPDIR)\xutil.obj

TKOBJS = \
	$(TMPDIR)\tkConsole.obj \
	$(TMPDIR)\tkUnixMenubu.obj \
	$(TMPDIR)\tkUnixScale.obj \
	$(XLIBOBJS) \
	$(TMPDIR)\tkWin3d.obj \
	$(TMPDIR)\tkWin32Dll.obj \
	$(TMPDIR)\tkWinButton.obj \
	$(TMPDIR)\tkWinClipboard.obj \
	$(TMPDIR)\tkWinColor.obj \
	$(TMPDIR)\tkWinConfig.obj \
	$(TMPDIR)\tkWinCursor.obj \
	$(TMPDIR)\tkWinDialog.obj \
	$(TMPDIR)\tkWinDraw.obj \
	$(TMPDIR)\tkWinEmbed.obj \
	$(TMPDIR)\tkWinFont.obj \
	$(TMPDIR)\tkWinImage.obj \
	$(TMPDIR)\tkWinInit.obj \
	$(TMPDIR)\tkWinKey.obj \
	$(TMPDIR)\tkWinMenu.obj \
	$(TMPDIR)\tkWinPixmap.obj \
	$(TMPDIR)\tkWinPointer.obj \
	$(TMPDIR)\tkWinRegion.obj \
	$(TMPDIR)\tkWinScrlbr.obj \
	$(TMPDIR)\tkWinSend.obj \
	$(TMPDIR)\tkWinTest.obj \
	$(TMPDIR)\tkWinWindow.obj \
	$(TMPDIR)\tkWinWm.obj \
	$(TMPDIR)\tkWinX.obj \
	$(TMPDIR)\stubs.obj \
	$(TMPDIR)\tk3d.obj \
	$(TMPDIR)\tkArgv.obj \
	$(TMPDIR)\tkAtom.obj \
145
146
147
148
149
150
151


152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170


171
172



173
174
175

176
177
178
179
180
181
182
183
184
185
186
187
188
189



190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235





236

237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262






263
264
265
266
267
268
269
270
271
272





273


































274



275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298





299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325













326
327
328
329
330
331









332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350

351
352
353
354
355
356


357
358
359



360
361
362
363
364
365
366
	$(TMPDIR)\tkListbox.obj \
	$(TMPDIR)\tkMacWinMenu.obj \
	$(TMPDIR)\tkMain.obj \
	$(TMPDIR)\tkMenu.obj \
	$(TMPDIR)\tkMenubutton.obj \
	$(TMPDIR)\tkMenuDraw.obj \
	$(TMPDIR)\tkMessage.obj \


	$(TMPDIR)\tkOption.obj \
	$(TMPDIR)\tkPack.obj \
	$(TMPDIR)\tkPlace.obj \
	$(TMPDIR)\tkPointer.obj \
	$(TMPDIR)\tkRectOval.obj \
	$(TMPDIR)\tkScale.obj \
	$(TMPDIR)\tkScrollbar.obj \
	$(TMPDIR)\tkSelect.obj \
	$(TMPDIR)\tkText.obj \
	$(TMPDIR)\tkTextBTree.obj \
	$(TMPDIR)\tkTextDisp.obj \
	$(TMPDIR)\tkTextImage.obj \
	$(TMPDIR)\tkTextIndex.obj \
	$(TMPDIR)\tkTextMark.obj \
	$(TMPDIR)\tkTextTag.obj \
	$(TMPDIR)\tkTextWind.obj \
	$(TMPDIR)\tkTrig.obj \
	$(TMPDIR)\tkUtil.obj \
	$(TMPDIR)\tkVisual.obj \


	$(TMPDIR)\tkWindow.obj




cc32		= $(TOOLS32)\bin\cl.exe
link32		= $(TOOLS32)\bin\link.exe
rc32		= $(TOOLS32)\bin\rc.exe

include32	= -I$(TOOLS32)\include

WINDIR          = $(ROOT)\win
GENERICDIR	= $(ROOT)\generic
XLIBDIR		= $(ROOT)\xlib
BITMAPDIR	= $(ROOT)\bitmaps
TCLLIBDIR       = $(TCLDIR)\win
RCDIR		= $(WINDIR)\rc

TK_INCLUDES	= -I$(WINDIR) -I$(GENERICDIR) -I$(BITMAPDIR) -I$(XLIBDIR) \
			-I$(TCLDIR)\generic
TK_DEFINES	= $(DEBUGDEFINES)

TK_CFLAGS	= $(cdebug) $(cflags) $(cvarsdll) $(include32) \



			$(TK_INCLUDES) $(TK_DEFINES) 

######################################################################
# Link flags
######################################################################

!IFDEF NODEBUG
ldebug = /RELEASE
!ELSE
ldebug = -debug:full -debugtype:cv
!ENDIF

# declarations common to all linker options
lcommon = /NODEFAULTLIB /RELEASE /NOLOGO

# declarations for use on Intel i386, i486, and Pentium systems
!IF "$(MACHINE)" == "IX86"
DLLENTRY = @12
lflags   = $(lcommon) -align:0x1000 /MACHINE:$(MACHINE)
!ELSE
lflags   = $(lcommon) /MACHINE:$(MACHINE)
!ENDIF

conlflags = $(lflags) -subsystem:console -entry:mainCRTStartup
guilflags = $(lflags) -subsystem:windows -entry:WinMainCRTStartup
dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll

!IF "$(MACHINE)" == "PPC"
libc = libc.lib
libcdll = crtdll.lib
!ELSE
libc = libc.lib oldnames.lib
libcdll = msvcrt.lib oldnames.lib
!ENDIF

baselibs   = kernel32.lib $(optlibs) advapi32.lib
winlibs    = $(baselibs) user32.lib gdi32.lib comdlg32.lib winspool.lib
guilibs	   = $(libc) $(winlibs)

guilibsdll = $(libcdll) $(winlibs)

######################################################################
# Compile flags
######################################################################

!IFDEF NODEBUG





cdebug = -Oti -Gs -GD

!ELSE
cdebug = -Z7 -Od -WX
!ENDIF

# declarations common to all compiler options
ccommon = -c -W3 -nologo -YX

!IF "$(MACHINE)" == "IX86"
cflags = $(ccommon) -D_X86_=1
!ELSE
!IF "$(MACHINE)" == "MIPS"
cflags = $(ccommon) -D_MIPS_=1
!ELSE
!IF "$(MACHINE)" == "PPC"
cflags = $(ccommon) -D_PPC_=1
!ELSE
!IF "$(MACHINE)" == "ALPHA"
cflags = $(ccommon) -D_ALPHA_=1
!ENDIF
!ENDIF
!ENDIF
!ENDIF

cvars      = -DWIN32 -D_WIN32
cvarsmt    = $(cvars) -D_MT
cvarsdll   = $(cvarsmt) -D_DLL







CON_CFLAGS	= $(cdebug) $(cflags) $(cvars) $(include32) -DCONSOLE

######################################################################
# Project specific targets
######################################################################

all:    $(WISH)
test:	$(TKTEST)
plugin:	$(TKPLUGINDLL) $(WISHP)








































$(TKLIB): $(TKDLL)




$(TKDLL): $(TKOBJS) $(TMPDIR)\tk.res $(TMPDIR)\tk.def
	set LIB=$(TOOLS32)\lib
        $(link32) $(ldebug) $(dlllflags) -def:$(TMPDIR)\tk.def \
		-out:$@ $(TMPDIR)\tk.res $(TCLLIBDIR)\$(TCLLIB) \
		$(guilibsdll) @<<
			$(TKOBJS)
<<

$(TKPLUGINLIB): $(TKPLUGINDLL)

$(TKPLUGINDLL): $(TKOBJS) $(TMPDIR)\tk.res $(TMPDIR)\plugin.def
	set LIB=$(TOOLS32)\lib
        $(link32) $(ldebug) $(dlllflags) -def:$(TMPDIR)\plugin.def \
		-out:$@ $(TMPDIR)\tk.res $(TCLLIBDIR)\$(TCLPLUGINLIB) \
		$(guilibsdll) @<<
			$(TKOBJS)
<<

$(WISH): $(WISHOBJS) $(TKLIB) $(TMPDIR)\wish.res
	set LIB=$(TOOLS32)\lib
	$(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \
		$(guilibsdll) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB) $(WISHOBJS) 






$(WISHP): $(WISHOBJS) $(TKPLUGINLIB) $(TMPDIR)\wish.res
	set LIB=$(TOOLS32)\lib
	$(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \
		$(guilibsdll) $(TCLLIBDIR)\$(TCLPLUGINLIB) \
		$(TKPLUGINLIB) $(WISHOBJS) 

$(TKTEST): $(TKTESTOBJS) $(TKLIB) $(TMPDIR)\wish.res
	set LIB=$(TOOLS32)\lib
	$(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \
		$(guilibsdll) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB) $(TKTESTOBJS)

$(TMPDIR)\tk.def: $(DUMPEXTS) $(TKOBJS)
	$(DUMPEXTS) -o $@ $(TKDLL) @<<
		$(TKOBJS)
<<

$(TMPDIR)\plugin.def: $(DUMPEXTS) $(TKOBJS)
	$(DUMPEXTS) -o $@ $(TKPLUGINDLL) @<<
		$(TKOBJS)
<<

$(DUMPEXTS): $(TCLDIR)\win\winDumpExts.c
	$(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
	set LIB=$(TOOLS32)\lib
	$(link32) $(ldebug) $(conlflags) $(guilibs) -out:$@ \
		$(TMPDIR)\winDumpExts.obj 














#
# Special case object file targets
#

$(TMPDIR)\testMain.obj: $(ROOT)\win\winMain.c
	$(cc32) $(TK_CFLAGS) -DTK_TEST -Fo$@ $?










#
# Implicit rules
#

{$(XLIBDIR)}.c{$(TMPDIR)}.obj:
	$(cc32) $(TK_CFLAGS) -Fo$(TMPDIR)\ $<

{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
	$(cc32) $(TK_CFLAGS) -Fo$(TMPDIR)\ $<

{$(WINDIR)}.c{$(TMPDIR)}.obj:
	$(cc32) $(TK_CFLAGS) -Fo$(TMPDIR)\ $<

{$(ROOT)\unix}.c{$(TMPDIR)}.obj:
	$(cc32) $(TK_CFLAGS) -Fo$(TMPDIR)\ $<

{$(RCDIR)}.rc{$(TMPDIR)}.res:
	$(rc32) -fo $@ -r -i $(GENERICDIR) $<


clean:
	-@del *.exp
	-@del *.lib
	-@del *.dll
	-@del *.exe


        -@del $(TMPDIR)\*.obj 
        -@del $(TMPDIR)\*.res
        -@del $(TMPDIR)\*.def




# dependencies

$(TMPDIR)\tk.res: \
    $(RCDIR)\buttons.bmp \
    $(RCDIR)\cursor*.cur \
    $(RCDIR)\tk.ico







>
>



















>
>


>
>
>
|
|
|
>
|





|







>
>
>
|





|











|









|
|

|
|





|






|
>
>
>
>
>

>





|




















>
>
>
>
>
>







|
|
|
>
>
>
>
>

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



|
|



















>
>
>
>
>












|




|









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





|
>
>
>
>
>
>
>
>
>






|


|


|


|


|
>


|
|
|
|
>
>
|


>
>
>







182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
	$(TMPDIR)\tkListbox.obj \
	$(TMPDIR)\tkMacWinMenu.obj \
	$(TMPDIR)\tkMain.obj \
	$(TMPDIR)\tkMenu.obj \
	$(TMPDIR)\tkMenubutton.obj \
	$(TMPDIR)\tkMenuDraw.obj \
	$(TMPDIR)\tkMessage.obj \
	$(TMPDIR)\tkObj.obj \
	$(TMPDIR)\tkOldConfig.obj \
	$(TMPDIR)\tkOption.obj \
	$(TMPDIR)\tkPack.obj \
	$(TMPDIR)\tkPlace.obj \
	$(TMPDIR)\tkPointer.obj \
	$(TMPDIR)\tkRectOval.obj \
	$(TMPDIR)\tkScale.obj \
	$(TMPDIR)\tkScrollbar.obj \
	$(TMPDIR)\tkSelect.obj \
	$(TMPDIR)\tkText.obj \
	$(TMPDIR)\tkTextBTree.obj \
	$(TMPDIR)\tkTextDisp.obj \
	$(TMPDIR)\tkTextImage.obj \
	$(TMPDIR)\tkTextIndex.obj \
	$(TMPDIR)\tkTextMark.obj \
	$(TMPDIR)\tkTextTag.obj \
	$(TMPDIR)\tkTextWind.obj \
	$(TMPDIR)\tkTrig.obj \
	$(TMPDIR)\tkUtil.obj \
	$(TMPDIR)\tkVisual.obj \
	$(TMPDIR)\tkStubInit.obj \
	$(TMPDIR)\tkStubLib.obj \
	$(TMPDIR)\tkWindow.obj

TKSTUBOBJS = $(TMPDIR)\tkStubLib.obj \


cc32		= "$(TOOLS32)\bin\cl.exe"
link32		= "$(TOOLS32)\bin\link.exe"
lib32		= "$(TOOLS32)\bin\lib.exe"
rc32		= "$(TOOLS32_rc)\bin\rc.exe"
include32	= -I"$(TOOLS32)\include"

WINDIR          = $(ROOT)\win
GENERICDIR	= $(ROOT)\generic
XLIBDIR		= $(ROOT)\xlib
BITMAPDIR	= $(ROOT)\bitmaps
TCLLIBDIR       = $(TCLDIR)\win\$(OUTDIRNAME)
RCDIR		= $(WINDIR)\rc

TK_INCLUDES	= -I$(WINDIR) -I$(GENERICDIR) -I$(BITMAPDIR) -I$(XLIBDIR) \
			-I$(TCLDIR)\generic
TK_DEFINES	= $(DEBUGDEFINES)

TK_CFLAGS	= $(cdebug) $(cflags) $(cvarsdll) $(include32) \
			$(TK_INCLUDES) $(TK_DEFINES) -DUSE_TCL_STUBS

WISH_CFLAGS	= $(cdebug) $(cflags) $(cvarsdll) $(include32) \
			$(TK_INCLUDES) $(TK_DEFINES)

######################################################################
# Link flags
######################################################################

!IF "$(NODEBUG)" == "1"
ldebug = /RELEASE
!ELSE
ldebug = -debug:full -debugtype:cv
!ENDIF

# declarations common to all linker options
lcommon = /NODEFAULTLIB /RELEASE /NOLOGO

# declarations for use on Intel i386, i486, and Pentium systems
!IF "$(MACHINE)" == "IX86"
DLLENTRY = @12
lflags   = $(lcommon) /MACHINE:$(MACHINE)
!ELSE
lflags   = $(lcommon) /MACHINE:$(MACHINE)
!ENDIF

conlflags = $(lflags) -subsystem:console -entry:mainCRTStartup
guilflags = $(lflags) -subsystem:windows -entry:WinMainCRTStartup
dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll

!IF "$(MACHINE)" == "PPC"
libc = libc$(DBGX).lib
libcdll = crtdll$(DBGX).lib
!ELSE
libc = libc$(DBGX).lib oldnames.lib
libcdll = msvcrt$(DBGX).lib oldnames.lib
!ENDIF

baselibs   = kernel32.lib $(optlibs) advapi32.lib
winlibs    = $(baselibs) user32.lib gdi32.lib comdlg32.lib winspool.lib
guilibs	   = $(libc) $(winlibs)
conlibs    = $(libc) $(baselibs)
guilibsdll = $(libcdll) $(winlibs)

######################################################################
# Compile flags
######################################################################

!IF "$(NODEBUG)" == "1"
!IF "$(MACHINE)" == "ALPHA"
# MSVC on Alpha doesn't understand -Ot
cdebug = -O2i -Gs -GD
!ELSE
# NOTE: Due to a bug in MSVC, we cannot use -O2 here or Tk starts to misbehave.
cdebug = -Oti -Gs -GD
!ENDIF
!ELSE
cdebug = -Z7 -Od -WX
!ENDIF

# declarations common to all compiler options
ccommon = -c -W3 -nologo -Fp$(TMPDIR)\ -YX

!IF "$(MACHINE)" == "IX86"
cflags = $(ccommon) -D_X86_=1
!ELSE
!IF "$(MACHINE)" == "MIPS"
cflags = $(ccommon) -D_MIPS_=1
!ELSE
!IF "$(MACHINE)" == "PPC"
cflags = $(ccommon) -D_PPC_=1
!ELSE
!IF "$(MACHINE)" == "ALPHA"
cflags = $(ccommon) -D_ALPHA_=1
!ENDIF
!ENDIF
!ENDIF
!ENDIF

cvars      = -DWIN32 -D_WIN32
cvarsmt    = $(cvars) -D_MT
cvarsdll   = $(cvarsmt) -D_DLL

!IF "$(NODEBUG)" == "1"
cvarsdll   = $(cvars) -MD
!ELSE
cvarsdll   = $(cvars) -MDd
!ENDIF

CON_CFLAGS	= $(cdebug) $(cflags) $(cvars) $(include32) -DCONSOLE

######################################################################
# Project specific targets
######################################################################

all:    setup $(WISH) $(CAT32)
install: install-binaries install-libraries
plugin:	setup $(TKPLUGINDLL) $(WISHP)
tktest: setup $(TKTEST) $(CAT32)
test:	setup $(TKTEST) $(TKLIB) $(CAT32)
	set TCL_LIBRARY=$(TCLDIR)/library
	set PATH=$(TCLDIR)\win\$(TMPDIRNAME);$(PATH)
	$(TKTEST) $(ROOT)/tests/all.tcl | $(CAT32)

#       copy $(TCLDIR)\bin\pkgIndex.tcl $(OUTDIR)

console-wish : all $(WISHC)

stubs:
	$(TCLDIR)\win\$(TMPDIRNAME)\tclsh$(VERSION)$(DBGX) \
		$(TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \
		$(GENERICDIR)\tk.decls $(GENERICDIR)\tkInt.decls

setup:
	@mkd $(TMPDIR)
	@mkd $(OUTDIR)

install-binaries:
	@mkd "$(BIN_INSTALL_DIR)"
	copy $(TKDLL) "$(BIN_INSTALL_DIR)"
	copy $(WISH) "$(BIN_INSTALL_DIR)"
	@mkd "$(LIB_INSTALL_DIR)"
	copy $(TKLIB) "$(LIB_INSTALL_DIR)"

install-libraries:
	@mkd "$(INCLUDE_INSTALL_DIR)"
	@mkd "$(INCLUDE_INSTALL_DIR)\X11"
	copy "$(ROOT)\generic\tk.h" "$(INCLUDE_INSTALL_DIR)"
	xcopy "$(ROOT)\xlib\X11\*.h" "$(INCLUDE_INSTALL_DIR)\X11"
	@mkd "$(SCRIPT_INSTALL_DIR)"
	@mkd "$(SCRIPT_INSTALL_DIR)\images"
	@mkd "$(SCRIPT_INSTALL_DIR)\demos"
	@mkd "$(SCRIPT_INSTALL_DIR)\demos\images"
	xcopy "$(ROOT)\library" "$(SCRIPT_INSTALL_DIR)"
	xcopy "$(ROOT)\library\images" "$(SCRIPT_INSTALL_DIR)\images"
	xcopy "$(ROOT)\library\demos" "$(SCRIPT_INSTALL_DIR)\demos"
	xcopy "$(ROOT)\library\demos\images" "$(SCRIPT_INSTALL_DIR)\demos\images"

$(TKLIB): $(TKDLL) $(TKSTUBLIB)

$(TKSTUBLIB): $(TKSTUBOBJS)
        $(lib32) /out:$@ $(TKSTUBOBJS)

$(TKDLL): $(TKOBJS) $(TMPDIR)\tk.res $(TMPDIR)\tk.def
	set LIB=$(TOOLS32)\lib
       $(link32) $(ldebug) $(dlllflags) -def:$(TMPDIR)\tk.def \
		-out:$@ $(TMPDIR)\tk.res $(TCLLIBDIR)\$(TCLSTUBLIB) \
		$(guilibsdll) @<<
			$(TKOBJS)
<<

$(TKPLUGINLIB): $(TKPLUGINDLL)

$(TKPLUGINDLL): $(TKOBJS) $(TMPDIR)\tk.res $(TMPDIR)\plugin.def
	set LIB=$(TOOLS32)\lib
        $(link32) $(ldebug) $(dlllflags) -def:$(TMPDIR)\plugin.def \
		-out:$@ $(TMPDIR)\tk.res $(TCLLIBDIR)\$(TCLPLUGINLIB) \
		$(guilibsdll) @<<
			$(TKOBJS)
<<

$(WISH): $(WISHOBJS) $(TKLIB) $(TMPDIR)\wish.res
	set LIB=$(TOOLS32)\lib
	$(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \
		$(guilibsdll) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB) $(WISHOBJS) 

$(WISHC): $(WISHOBJS) $(TKLIB) $(TMPDIR)\wish.res
	set LIB=$(TOOLS32)\lib
	$(link32) $(ldebug) $(conlflags) $(TMPDIR)\wish.res -out:$@ \
		$(guilibsdll) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB) $(WISHOBJS) 

$(WISHP): $(WISHOBJS) $(TKPLUGINLIB) $(TMPDIR)\wish.res
	set LIB=$(TOOLS32)\lib
	$(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \
		$(guilibsdll) $(TCLLIBDIR)\$(TCLPLUGINLIB) \
		$(TKPLUGINLIB) $(WISHOBJS) 

$(TKTEST): $(TKTESTOBJS) $(TKLIB) $(TMPDIR)\wish.res
	set LIB=$(TOOLS32)\lib
	$(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \
		$(guilibsdll) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB) $(TKTESTOBJS)

$(TMPDIR)\tk.def: $(DUMPEXTS) $(TKOBJS)
	$(DUMPEXTS) -o $@ $(TKDLLNAME) @<<
		$(TKOBJS)
<<

$(TMPDIR)\plugin.def: $(DUMPEXTS) $(TKOBJS)
	$(DUMPEXTS) -o $@ $(TKPLUGINDLLNAME) @<<
		$(TKOBJS)
<<

$(DUMPEXTS): $(TCLDIR)\win\winDumpExts.c
	$(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
	set LIB=$(TOOLS32)\lib
	$(link32) $(ldebug) $(conlflags) $(guilibs) -out:$@ \
		$(TMPDIR)\winDumpExts.obj 

$(CAT32): $(TCLDIR)\win\cat.c
	$(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
	set LIB=$(TOOLS32)\lib
	$(link32) $(conlflags) -out:$@ -stack:16384 $(TMPDIR)\cat.obj $(conlibs)

#
# Regenerate the stubs files.
#

genstubs:
	tclsh$(VERSION) $(TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \
		$(GENERICDIR)\tk.decls $(GENERICDIR)\tkInt.decls

#
# Special case object file targets
#

$(TMPDIR)\testMain.obj: $(ROOT)\win\winMain.c
	$(cc32) $(WISH_CFLAGS) -DTK_TEST -Fo$@ $?

$(TMPDIR)\tkTest.obj: $(ROOT)\generic\tkTest.c
	$(cc32) $(WISH_CFLAGS) -Fo$@ $?

$(TMPDIR)\tkSquare.obj: $(ROOT)\generic\tkSquare.c
	$(cc32) $(WISH_CFLAGS) -Fo$@ $?

$(TMPDIR)\winMain.obj: $(ROOT)\win\winMain.c
	$(cc32) $(WISH_CFLAGS) -Fo$@ $?

#
# Implicit rules
#

{$(XLIBDIR)}.c{$(TMPDIR)}.obj:
	$(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -Fo$(TMPDIR)\ $<

{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
	$(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -Fo$(TMPDIR)\ $<

{$(WINDIR)}.c{$(TMPDIR)}.obj:
	$(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -Fo$(TMPDIR)\ $<

{$(ROOT)\unix}.c{$(TMPDIR)}.obj:
	$(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -Fo$(TMPDIR)\ $<

{$(RCDIR)}.rc{$(TMPDIR)}.res:
	$(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TOOLS32)\include" \
		-i "$(TCLDIR)\generic" $<

clean:
        -@del $(OUTDIR)\*.exp 
	-@del $(OUTDIR)\*.lib 
	-@del $(OUTDIR)\*.dll 
	-@del $(OUTDIR)\*.exe
	-@del $(OUTDIR)\*.pdb
	-@del $(TMPDIR)\*.pch
        -@del $(TMPDIR)\*.obj
        -@del $(TMPDIR)\*.res
        -@del $(TMPDIR)\*.def
        -@del $(TMPDIR)\*.exe
	-@rmd $(OUTDIR)
	-@rmd $(TMPDIR)

# dependencies

$(TMPDIR)\tk.res: \
    $(RCDIR)\buttons.bmp \
    $(RCDIR)\cursor*.cur \
    $(RCDIR)\tk.ico

Added win/mkd.bat.











































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
@echo off
rem RCS: @(#) $Id: mkd.bat,v 1.1.4.2 1998/10/06 20:29:51 stanton Exp $

if exist %1\tag.txt goto end

if "%OS%" == "Windows_NT" goto winnt

md %1
if errorlevel 1 goto end

goto success

:winnt
md %1
if errorlevel 1 goto end

:success
echo TAG >%1\tag.txt
echo created directory %1

:end

Deleted win/rc/buttons.bmp.

Deleted win/rc/cursor00.cur.

Deleted win/rc/cursor02.cur.

Deleted win/rc/cursor04.cur.

Deleted win/rc/cursor06.cur.

Deleted win/rc/cursor08.cur.

Deleted win/rc/cursor0a.cur.

Deleted win/rc/cursor0c.cur.

Deleted win/rc/cursor0e.cur.

Deleted win/rc/cursor10.cur.

Deleted win/rc/cursor12.cur.

Deleted win/rc/cursor14.cur.

Deleted win/rc/cursor16.cur.

Deleted win/rc/cursor18.cur.

Deleted win/rc/cursor1a.cur.

Deleted win/rc/cursor1c.cur.

Deleted win/rc/cursor1e.cur.

Deleted win/rc/cursor20.cur.

1
2
  0( @���B���R�*��
��~�~
<
<




Deleted win/rc/cursor22.cur.

Deleted win/rc/cursor24.cur.

1
2
  0( @�����
��"�B�����B�"��
<
<




Deleted win/rc/cursor26.cur.

Deleted win/rc/cursor28.cur.

Deleted win/rc/cursor2a.cur.

Deleted win/rc/cursor2c.cur.

Deleted win/rc/cursor2e.cur.

Deleted win/rc/cursor30.cur.

Deleted win/rc/cursor32.cur.

Deleted win/rc/cursor34.cur.

Deleted win/rc/cursor36.cur.

Deleted win/rc/cursor38.cur.

Deleted win/rc/cursor3a.cur.

Deleted win/rc/cursor3c.cur.

Deleted win/rc/cursor3e.cur.

Deleted win/rc/cursor40.cur.

Deleted win/rc/cursor42.cur.

Deleted win/rc/cursor44.cur.

Deleted win/rc/cursor46.cur.

Deleted win/rc/cursor48.cur.

Deleted win/rc/cursor4a.cur.

Deleted win/rc/cursor4c.cur.

Deleted win/rc/cursor4e.cur.

Deleted win/rc/cursor50.cur.

Deleted win/rc/cursor52.cur.

Deleted win/rc/cursor54.cur.

Deleted win/rc/cursor56.cur.

Deleted win/rc/cursor58.cur.

Deleted win/rc/cursor5a.cur.

Deleted win/rc/cursor5c.cur.

Deleted win/rc/cursor5e.cur.

1
  
<


Deleted win/rc/cursor60.cur.

Deleted win/rc/cursor62.cur.

Deleted win/rc/cursor64.cur.

Deleted win/rc/cursor66.cur.

Deleted win/rc/cursor68.cur.

Deleted win/rc/cursor6a.cur.

Deleted win/rc/cursor6c.cur.

Deleted win/rc/cursor6e.cur.

Deleted win/rc/cursor70.cur.

Deleted win/rc/cursor72.cur.

Deleted win/rc/cursor74.cur.

Deleted win/rc/cursor76.cur.

Deleted win/rc/cursor78.cur.

1
  0( @����
<


Deleted win/rc/cursor7a.cur.

Deleted win/rc/cursor7c.cur.

Deleted win/rc/cursor7e.cur.

Deleted win/rc/cursor80.cur.

Deleted win/rc/cursor82.cur.

Deleted win/rc/cursor84.cur.

Deleted win/rc/cursor86.cur.

Deleted win/rc/cursor88.cur.

Deleted win/rc/cursor8a.cur.

Deleted win/rc/cursor8c.cur.

Deleted win/rc/cursor8e.cur.

Deleted win/rc/cursor90.cur.

Deleted win/rc/cursor92.cur.

Deleted win/rc/cursor94.cur.

Deleted win/rc/cursor96.cur.

Deleted win/rc/cursor98.cur.

Deleted win/rc/tk.ico.

Changes to win/rc/tk.rc.

1
2
3
4
5

6
7
8
9
10
11
12
// SCCS: @(#) tk.rc 1.22 97/03/21 18:35:14
//
// Version
//


#define RESOURCE_INCLUDED
#include <tk.h>

#define STRINGIFY1(x)       #x
#define STRINGIFY(x)        STRINGIFY1(x) 
 
VS_VERSION_INFO VERSIONINFO
|




>







1
2
3
4
5
6
7
8
9
10
11
12
13
// RCS: @(#) $Id: tk.rc,v 1.1.4.3 1998/10/06 03:27:38 stanton Exp $
//
// Version
//

#include <windows.h>
#define RESOURCE_INCLUDED
#include <tk.h>

#define STRINGIFY1(x)       #x
#define STRINGIFY(x)        STRINGIFY1(x) 
 
VS_VERSION_INFO VERSIONINFO
31
32
33
34
35
36
37






























38
39
40
41
42
43
44
            VALUE "ProductVersion", TK_PATCH_LEVEL
        END
    END
    BLOCK "VarFileInfo"
    BEGIN
        VALUE "Translation", 0x409, 1200
    END






























END

//
// Icons
//

tk                      ICON    DISCARDABLE     "tk.ico"







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







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
            VALUE "ProductVersion", TK_PATCH_LEVEL
        END
    END
    BLOCK "VarFileInfo"
    BEGIN
        VALUE "Translation", 0x409, 1200
    END
END

#include <dlgs.h>
FILEOPENORD DIALOG DISCARDABLE  36, 24, 218, 138
STYLE DS_MODALFRAME | DS_3DLOOK | WS_POPUP | WS_CAPTION | WS_SYSMENU
CAPTION "Choose Directory"
FONT 8, "Helv"
BEGIN
    LTEXT           "Directory &name:",-1,8,6,118,9
    EDITTEXT        edt10,8,26,144,12, WS_TABSTOP | ES_AUTOHSCROLL
    LISTBOX         lst2,8,40,144,64,LBS_SORT | LBS_OWNERDRAWFIXED | 
                    LBS_HASSTRINGS | LBS_NOINTEGRALHEIGHT | 
                    LBS_DISABLENOSCROLL | WS_VSCROLL | WS_TABSTOP
    LTEXT           "Dri&ves:",stc4,8,106,92,9
    COMBOBOX        cmb2,8,115,144,68,CBS_DROPDOWNLIST | CBS_OWNERDRAWFIXED | 
                    CBS_AUTOHSCROLL | CBS_SORT | CBS_HASSTRINGS | WS_BORDER | 
                    WS_VSCROLL | WS_TABSTOP
    DEFPUSHBUTTON   "OK",1,160,6,50,14,WS_GROUP
    PUSHBUTTON      "Cancel",2,160,24,50,14,WS_GROUP
    PUSHBUTTON      "&Help",psh15,160,42,50,14,WS_GROUP
    CHECKBOX        "&Read only",chx1,160,66,50,12,WS_GROUP
    PUSHBUTTON      "Net&work...",psh14,160,115,50,14,WS_GROUP

    LTEXT           "a",stc3,9,143,114,15
    EDITTEXT        edt1,7,158,135,20,NOT WS_TABSTOP
    LISTBOX         lst1,8,205,134,42,LBS_NOINTEGRALHEIGHT
    COMBOBOX        cmb1,8,253,135,21,CBS_DROPDOWNLIST | CBS_OWNERDRAWFIXED | 
                    CBS_AUTOHSCROLL | CBS_SORT | CBS_HASSTRINGS | WS_BORDER | 
                    WS_VSCROLL

END

//
// Icons
//

tk                      ICON    DISCARDABLE     "tk.ico"

Deleted win/rc/wish.ico.

Changes to win/rc/wish.rc.

1
2
3
4
5
6
7
8
// SCCS: @(#) wish.rc 1.15 96/09/17 13:24:11
//
// Version
//

#define RESOURCE_INCLUDED
#include <tk.h>

|







1
2
3
4
5
6
7
8
// RCS: @(#) $Id: wish.rc,v 1.1.4.1 1998/09/30 02:19:42 stanton Exp $
//
// Version
//

#define RESOURCE_INCLUDED
#include <tk.h>

Added win/rmd.bat.



















































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
@echo off
rem RCS: @(#) $Id: rmd.bat,v 1.1.4.2 1998/10/06 20:29:51 stanton Exp $

if not exist %1\tag.txt goto end

echo Removing directory %1

if "%OS%" == "Windows_NT" goto winnt

cd %1
if errorlevel 1 goto end
del *.*
cd ..
rmdir %1
if errorlevel 1 goto end
goto success

:winnt
rmdir %1 /s /q
if errorlevel 1 goto end

:success
echo deleted directory %1

:end

Changes to win/tkWin.h.

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
/*
 * tkWin.h --
 *
 *	Declarations of public types and interfaces that are only
 *	available under Windows.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWin.h 1.6 96/08/15 13:19:41
 */

#ifndef _TKWIN
#define _TKWIN

#ifndef _TK
#include <tk.h>
#endif

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN






/*
 * The following messages are use to communicate between a Tk toplevel
 * and its container window.
 */

#define TK_CLAIMFOCUS	(WM_USER)
#define TK_GEOMETRYREQ	(WM_USER+1)
#define TK_ATTACHWINDOW	(WM_USER+2)
#define TK_DETACHWINDOW	(WM_USER+3)


/*
 *--------------------------------------------------------------
 *
 * Exported procedures defined for the Windows platform only.
 *
 *--------------------------------------------------------------
 */


EXTERN Window		Tk_AttachHWND _ANSI_ARGS_((Tk_Window tkwin,
			    HWND hwnd));
EXTERN HINSTANCE 	Tk_GetHINSTANCE _ANSI_ARGS_((void));
EXTERN HWND		Tk_GetHWND _ANSI_ARGS_((Window window));
EXTERN Tk_Window	Tk_HWNDToWindow _ANSI_ARGS_((HWND hwnd));
EXTERN void		Tk_PointerEvent _ANSI_ARGS_((HWND hwnd,
			    int x, int y));
EXTERN int		Tk_TranslateWinEvent _ANSI_ARGS_((HWND hwnd,
			    UINT message, WPARAM wParam, LPARAM lParam,
			    LRESULT *result));

#endif /* _TKWIN */






|




|












>
>
>
>
>




















>
|
|
<
|
<
<
<
<
<
<


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
/*
 * tkWin.h --
 *
 *	Declarations of public types and interfaces that are only
 *	available under Windows.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWin.h,v 1.1.4.3 1999/03/10 07:13:52 stanton Exp $
 */

#ifndef _TKWIN
#define _TKWIN

#ifndef _TK
#include <tk.h>
#endif

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

#ifdef BUILD_tk
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * The following messages are use to communicate between a Tk toplevel
 * and its container window.
 */

#define TK_CLAIMFOCUS	(WM_USER)
#define TK_GEOMETRYREQ	(WM_USER+1)
#define TK_ATTACHWINDOW	(WM_USER+2)
#define TK_DETACHWINDOW	(WM_USER+3)


/*
 *--------------------------------------------------------------
 *
 * Exported procedures defined for the Windows platform only.
 *
 *--------------------------------------------------------------
 */

#include "tkPlatDecls.h"

# undef TCL_STORAGE_CLASS

# define TCL_STORAGE_CLASS DLLIMPORT







#endif /* _TKWIN */

Changes to win/tkWin32Dll.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
/* 
 * tkWin32Dll.c --
 *
 *	This file contains a stub dll entry point.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWin32Dll.c 1.9 96/08/06 15:59:08
 */

#include "tkPort.h"
#include "tkWinInt.h"


/*
 * The following declaration is for the VC++ DLL entry point.
 */

BOOL APIENTRY		DllMain _ANSI_ARGS_((HINSTANCE hInst,
			    DWORD reason, LPVOID reserved));










|


|
|
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
/* 
 * tkWin32Dll.c --
 *
 *	This file contains a stub dll entry point.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWin32Dll.c,v 1.1.4.2 1998/09/30 02:19:27 stanton Exp $
 */

#include "tkWinInt.h"

static int tkPlatformId;

/*
 * The following declaration is for the VC++ DLL entry point.
 */

BOOL APIENTRY		DllMain _ANSI_ARGS_((HINSTANCE hInst,
			    DWORD reason, LPVOID reserved));
66
67
68
69
70
71
72


73
74
75
76
77
78
79




80
81
82
83
84
85




























BOOL APIENTRY
DllMain(hInstance, reason, reserved)
    HINSTANCE hInstance;
    DWORD reason;
    LPVOID reserved;
{


    /*
     * If we are attaching to the DLL from a new process, tell Tk about
     * the hInstance to use. If we are detaching then clean up any
     * data structures related to this DLL.
     */
    
    if (reason == DLL_PROCESS_ATTACH) {




        TkWinXInit(hInstance);
    } else if (reason == DLL_PROCESS_DETACH) {
        TkWinXCleanup(hInstance);
    }
    return(TRUE);
}


































>
>







>
>
>
>






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

BOOL APIENTRY
DllMain(hInstance, reason, reserved)
    HINSTANCE hInstance;
    DWORD reason;
    LPVOID reserved;
{
    OSVERSIONINFO os;

    /*
     * If we are attaching to the DLL from a new process, tell Tk about
     * the hInstance to use. If we are detaching then clean up any
     * data structures related to this DLL.
     */
    
    if (reason == DLL_PROCESS_ATTACH) {
	os.dwOSVersionInfoSize = sizeof(os);
	GetVersionEx(&os);
	tkPlatformId = os.dwPlatformId;

        TkWinXInit(hInstance);
    } else if (reason == DLL_PROCESS_DETACH) {
        TkWinXCleanup(hInstance);
    }
    return(TRUE);
}

/*
 *----------------------------------------------------------------------
 *
 * TkWinGetPlatformId --
 *
 *	Determines whether running under NT, 95, or Win32s, to allow 
 *	runtime conditional code.
 *
 * Results:
 *	The return value is one of:
 *	    VER_PLATFORM_WIN32s		Win32s on Windows 3.1. 
 *	    VER_PLATFORM_WIN32_WINDOWS	Win32 on Windows 95.
 *	    VER_PLATFORM_WIN32_NT	Win32 on Windows NT
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int		
TkWinGetPlatformId()
{
    return tkPlatformId;
}

Changes to win/tkWin3d.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
/* 
 * tkWin3d.c --
 *
 *	This file contains the platform specific routines for
 *	drawing 3d borders in the Windows 95 style.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWin3d.c 1.6 97/08/12 14:28:54
 */

#include <tk3d.h>
#include <tkWinInt.h>

/*
 * This structure is used to keep track of the extra colors used by
 * Windows 3d borders.
 */

typedef struct {











|


|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
/* 
 * tkWin3d.c --
 *
 *	This file contains the platform specific routines for
 *	drawing 3d borders in the Windows 95 style.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWin3d.c,v 1.1.4.2 1998/09/30 02:19:28 stanton Exp $
 */

#include "tkWinInt.h"
#include "tk3d.h"

/*
 * This structure is used to keep track of the extra colors used by
 * Windows 3d borders.
 */

typedef struct {

Changes to win/tkWinButton.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkWinButton.c --
 *
 *	This file implements the Windows specific portion of the button
 *	widgets.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinButton.c 1.12 97/09/02 13:18:27
 */

#define OEMRESOURCE
#include "tkWinInt.h"
#include "tkButton.h"

/*






|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkWinButton.c --
 *
 *	This file implements the Windows specific portion of the button
 *	widgets.
 *
 * Copyright (c) 1996-1998 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinButton.c,v 1.1.4.3 1998/12/13 08:16:15 lfb Exp $
 */

#define OEMRESOURCE
#include "tkWinInt.h"
#include "tkButton.h"

/*
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
    PAL_BOTTOM_INNER = 3,
    PAL_INTERIOR = 4,
    PAL_TOP_INNER = 5,
    PAL_BACKGROUND = 6
};

/*
 * Set to non-zero if this module is initialized.
 */

static int initialized = 0;

/*
 * Variables for the cached information about the boxes bitmap.
 */


static BITMAPINFOHEADER *boxesPtr = NULL;   /* Information about the bitmap. */
static DWORD *boxesPalette = NULL;	    /* Pointer to color palette. */
static LPSTR boxesBits = NULL;		    /* Pointer to bitmap data. */
static DWORD boxHeight = 0, boxWidth = 0;    /* Size of each sub-image. */

/*
 * This variable holds the default border width for a button in string
 * form for use in a Tk_ConfigSpec.
 */


static char defWidth[8];

/*
 * Declarations for functions defined in this file.
 */

static int		ButtonBindProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, XEvent *eventPtr,
			    Tk_Window tkwin, KeySym keySym));
static LRESULT CALLBACK	ButtonProc _ANSI_ARGS_((HWND hwnd, UINT message,
			    WPARAM wParam, LPARAM lParam));
static DWORD		ComputeStyle _ANSI_ARGS_((WinButton* butPtr));
static Window		CreateProc _ANSI_ARGS_((Tk_Window tkwin,
			    Window parent, ClientData instanceData));
static void		InitBoxes _ANSI_ARGS_((void));
static void		UpdateButtonDefaults _ANSI_ARGS_((void));

/*
 * The class procedure table for the button widgets.
 */

TkClassProcs tkpButtonProcs = { 
    CreateProc,			/* createProc. */







<
<
|
<
|
<
|


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














<







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
    PAL_BOTTOM_INNER = 3,
    PAL_INTERIOR = 4,
    PAL_TOP_INNER = 5,
    PAL_BACKGROUND = 6
};

/*


 * Cached information about the boxes bitmap, and the default border 

 * width for a button in string form for use in Tk_OptionSpecs for 

 * the various button widget classes.
 */

typedef struct ThreadSpecificData { 
    BITMAPINFOHEADER *boxesPtr;   /* Information about the bitmap. */
    DWORD *boxesPalette;	  /* Pointer to color palette. */
    LPSTR boxesBits;		  /* Pointer to bitmap data. */
    DWORD boxHeight;              /* Height of each sub-image. */
    DWORD boxWidth ;              /* Width of each sub-image. */




    char defWidth[TCL_INTEGER_SPACE];
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Declarations for functions defined in this file.
 */

static int		ButtonBindProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, XEvent *eventPtr,
			    Tk_Window tkwin, KeySym keySym));
static LRESULT CALLBACK	ButtonProc _ANSI_ARGS_((HWND hwnd, UINT message,
			    WPARAM wParam, LPARAM lParam));
static DWORD		ComputeStyle _ANSI_ARGS_((WinButton* butPtr));
static Window		CreateProc _ANSI_ARGS_((Tk_Window tkwin,
			    Window parent, ClientData instanceData));
static void		InitBoxes _ANSI_ARGS_((void));


/*
 * The class procedure table for the button widgets.
 */

TkClassProcs tkpButtonProcs = { 
    CreateProc,			/* createProc. */
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
     */

    HMODULE module = (HINSTANCE) Tk_GetHINSTANCE();
    HRSRC hrsrc;
    HGLOBAL hblk;
    LPBITMAPINFOHEADER newBitmap;
    DWORD size;



    hrsrc = FindResource(module, "buttons", RT_BITMAP);
    if (hrsrc) {
	hblk = LoadResource(module, hrsrc);
	boxesPtr = (LPBITMAPINFOHEADER)LockResource(hblk);
    }

    /*
     * Copy the DIBitmap into writable memory.
     */

    if (boxesPtr != NULL && !(boxesPtr->biWidth % 4)
	    && !(boxesPtr->biHeight % 2)) {
	size = boxesPtr->biSize + (1 << boxesPtr->biBitCount) * sizeof(RGBQUAD)
	    + boxesPtr->biSizeImage;
	newBitmap = (LPBITMAPINFOHEADER) ckalloc(size);
	memcpy(newBitmap, boxesPtr, size);
	boxesPtr = newBitmap;
	boxWidth = boxesPtr->biWidth / 4;
	boxHeight = boxesPtr->biHeight / 2;
	boxesPalette = (DWORD*) (((LPSTR)boxesPtr) + boxesPtr->biSize);

	boxesBits = ((LPSTR)boxesPalette)
	    + ((1 << boxesPtr->biBitCount) * sizeof(RGBQUAD));
    } else {
	boxesPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateButtonDefaults --
 *
 *	This function retrieves the current system defaults for
 *	the button widgets.

 *
 * Results:
 *	None.

 *
 * Side effects:
 *	Updates the configuration defaults for buttons.
 *
 *----------------------------------------------------------------------
 */

void
UpdateButtonDefaults()



{
    Tk_ConfigSpec *specPtr;
    int width = GetSystemMetrics(SM_CXEDGE);





    if (width == 0) {
	width = 1;
    }
    sprintf(defWidth, "%d", width);
    for (specPtr = tkpButtonConfigSpecs; specPtr->type != TK_CONFIG_END;

	    specPtr++) {
	if (specPtr->offset == Tk_Offset(TkButton, borderWidth)) {
	    specPtr->defValue = defWidth;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *







>
>




|






|
|
|
|

|
|
|
|
|
>
|
|

|






|

|
|
>


<
>


|





|
>
>
>

<
|
>
>

>
>
|
|
|
|
<
>
|
|
|







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
     */

    HMODULE module = (HINSTANCE) Tk_GetHINSTANCE();
    HRSRC hrsrc;
    HGLOBAL hblk;
    LPBITMAPINFOHEADER newBitmap;
    DWORD size;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    hrsrc = FindResource(module, "buttons", RT_BITMAP);
    if (hrsrc) {
	hblk = LoadResource(module, hrsrc);
	tsdPtr->boxesPtr = (LPBITMAPINFOHEADER)LockResource(hblk);
    }

    /*
     * Copy the DIBitmap into writable memory.
     */

    if (tsdPtr->boxesPtr != NULL && !(tsdPtr->boxesPtr->biWidth % 4)
	    && !(tsdPtr->boxesPtr->biHeight % 2)) {
	size = tsdPtr->boxesPtr->biSize + (1 << tsdPtr->boxesPtr->biBitCount) 
                * sizeof(RGBQUAD) + tsdPtr->boxesPtr->biSizeImage;
	newBitmap = (LPBITMAPINFOHEADER) ckalloc(size);
	memcpy(newBitmap, tsdPtr->boxesPtr, size);
	tsdPtr->boxesPtr = newBitmap;
	tsdPtr->boxWidth = tsdPtr->boxesPtr->biWidth / 4;
	tsdPtr->boxHeight = tsdPtr->boxesPtr->biHeight / 2;
	tsdPtr->boxesPalette = (DWORD*) (((LPSTR) tsdPtr->boxesPtr) 
                + tsdPtr->boxesPtr->biSize);
	tsdPtr->boxesBits = ((LPSTR) tsdPtr->boxesPalette)
	    + ((1 << tsdPtr->boxesPtr->biBitCount) * sizeof(RGBQUAD));
    } else {
	tsdPtr->boxesPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkpButtonSetDefaults --
 *
 *	This procedure is invoked before option tables are created for
 *	buttons.  It modifies some of the default values to match the
 *	current values defined for this platform.
 *
 * Results:

 *	Some of the default values in *specPtr are modified.
 *
 * Side effects:
 *	Updates some of.
 *
 *----------------------------------------------------------------------
 */

void
TkpButtonSetDefaults(specPtr)
    Tk_OptionSpec *specPtr;	/* Points to an array of option specs,
				 * terminated by one with type
				 * TK_OPTION_END. */
{

    int width;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (tsdPtr->defWidth[0] == 0) {
	width = GetSystemMetrics(SM_CXEDGE);
	if (width == 0) {
	    width = 1;
	}
	sprintf(tsdPtr->defWidth, "%d", width);

    }
    for ( ; specPtr->type != TK_OPTION_END; specPtr++) {
	if (specPtr->internalOffset == Tk_Offset(TkButton, borderWidth)) {
	    specPtr->defValue = tsdPtr->defWidth;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245

TkButton *
TkpCreateButton(tkwin)
    Tk_Window tkwin;
{
    WinButton *butPtr;

    if (!initialized) {
	UpdateButtonDefaults();
	initialized = 1;
    }

    butPtr = (WinButton *)ckalloc(sizeof(WinButton));
    butPtr->hwnd = NULL;
    return (TkButton *) butPtr;
}

/*
 *----------------------------------------------------------------------







<
<
<
<
<







230
231
232
233
234
235
236





237
238
239
240
241
242
243

TkButton *
TkpCreateButton(tkwin)
    Tk_Window tkwin;
{
    WinButton *butPtr;






    butPtr = (WinButton *)ckalloc(sizeof(WinButton));
    butPtr->hwnd = NULL;
    return (TkButton *) butPtr;
}

/*
 *----------------------------------------------------------------------
350
351
352
353
354
355
356

357




358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
    register Tk_Window tkwin = butPtr->tkwin;
    int width, height;
    int defaultWidth;		/* Width of default ring. */
    int offset;			/* 0 means this is a label widget.  1 means
				 * it is a flavor of button, so we offset
				 * the text to make the button appear to
				 * move up and down as the relief changes. */






    butPtr->flags &= ~REDRAW_PENDING;
    if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
	return;
    }

    border = butPtr->normalBorder;
    if ((butPtr->state == tkDisabledUid) && (butPtr->disabledFg != NULL)) {
	gc = butPtr->disabledGC;
    } else if ((butPtr->state == tkActiveUid)
	    && !Tk_StrictMotif(butPtr->tkwin)) {
	gc = butPtr->activeTextGC;
	border = butPtr->activeBorder;
    } else {
	gc = butPtr->normalTextGC;
    }
    if ((butPtr->flags & SELECTED) && (butPtr->state != tkActiveUid)
	    && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) {
	border = butPtr->selectBorder;
    }

    /*
     * Override the relief specified for the button if this is a
     * checkbutton or radiobutton and there's no indicator.
     */

    relief = butPtr->relief;
    if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) {
	relief = (butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN
		: TK_RELIEF_RAISED;
    }

    /*
     * Compute width of default ring and offset for pushed buttons.
     */

    if (butPtr->type == TYPE_BUTTON) {
	defaultWidth = ((butPtr->defaultState == tkActiveUid)
		? butPtr->highlightWidth : 0);
	offset = 1;
    } else {
	defaultWidth = 0;
	if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) {
	    offset = 1;
	} else {







>

>
>
>
>






|

|






|




















|







348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
    register Tk_Window tkwin = butPtr->tkwin;
    int width, height;
    int defaultWidth;		/* Width of default ring. */
    int offset;			/* 0 means this is a label widget.  1 means
				 * it is a flavor of button, so we offset
				 * the text to make the button appear to
				 * move up and down as the relief changes. */
    DWORD *boxesPalette;

    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    boxesPalette= tsdPtr->boxesPalette;
    butPtr->flags &= ~REDRAW_PENDING;
    if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
	return;
    }

    border = butPtr->normalBorder;
    if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) {
	gc = butPtr->disabledGC;
    } else if ((butPtr->state == STATE_ACTIVE)
	    && !Tk_StrictMotif(butPtr->tkwin)) {
	gc = butPtr->activeTextGC;
	border = butPtr->activeBorder;
    } else {
	gc = butPtr->normalTextGC;
    }
    if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE)
	    && (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) {
	border = butPtr->selectBorder;
    }

    /*
     * Override the relief specified for the button if this is a
     * checkbutton or radiobutton and there's no indicator.
     */

    relief = butPtr->relief;
    if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) {
	relief = (butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN
		: TK_RELIEF_RAISED;
    }

    /*
     * Compute width of default ring and offset for pushed buttons.
     */

    if (butPtr->type == TYPE_BUTTON) {
	defaultWidth = ((butPtr->defaultState == DEFAULT_ACTIVE)
		? butPtr->highlightWidth : 0);
	offset = 1;
    } else {
	defaultWidth = 0;
	if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) {
	    offset = 1;
	} else {
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546

547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
    /*
     * Draw the indicator for check buttons and radio buttons.  At this
     * point x and y refer to the top-left corner of the text or image
     * or bitmap.
     */

    if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn
	    && boxesPtr) {
	int xSrc, ySrc;

	x -= butPtr->indicatorSpace;
	y -= butPtr->indicatorDiameter / 2;

	xSrc = (butPtr->flags & SELECTED) ? boxWidth : 0;
	if (butPtr->state == tkActiveUid) {
	    xSrc += boxWidth*2;
	}
	ySrc = (butPtr->type == TYPE_RADIO_BUTTON) ? 0 : boxHeight;
		
	/*
	 * Update the palette in the boxes bitmap to reflect the current
	 * button colors.  Note that this code relies on the layout of the
	 * bitmap's palette.  Also, all of the colors used to draw the
	 * bitmap must be in the palette that is selected into the DC of
	 * the offscreen pixmap.  This requires that the static colors
	 * be placed into the palette.
	 */

	boxesPalette[PAL_CHECK] = FlipColor(gc->foreground);
	boxesPalette[PAL_TOP_OUTER] = FlipColor(TkWinGetBorderPixels(tkwin,
		border, TK_3D_DARK_GC));
	boxesPalette[PAL_TOP_INNER] = FlipColor(TkWinGetBorderPixels(tkwin,
		border, TK_3D_DARK2));
	boxesPalette[PAL_BOTTOM_INNER] = FlipColor(TkWinGetBorderPixels(tkwin,
		border, TK_3D_LIGHT2));
	boxesPalette[PAL_BOTTOM_OUTER] = FlipColor(TkWinGetBorderPixels(tkwin,
		border, TK_3D_LIGHT_GC));
	if (butPtr->state == tkDisabledUid) {
	    boxesPalette[PAL_INTERIOR] = FlipColor(TkWinGetBorderPixels(tkwin,
		border, TK_3D_LIGHT2));
	} else if (butPtr->selectBorder != NULL) {
	    boxesPalette[PAL_INTERIOR] = FlipColor(TkWinGetBorderPixels(tkwin,
		    butPtr->selectBorder, TK_3D_FLAT_GC));
	} else {
	    boxesPalette[PAL_INTERIOR] = FlipColor(GetSysColor(COLOR_WINDOW));
	}
	boxesPalette[PAL_BACKGROUND] = FlipColor(TkWinGetBorderPixels(tkwin,
		border, TK_3D_FLAT_GC));

	dc = TkWinGetDrawableDC(butPtr->display, pixmap, &state);
	StretchDIBits(dc, x, y, boxWidth, boxHeight, xSrc, ySrc, 

		boxWidth, boxHeight, boxesBits, (LPBITMAPINFO)boxesPtr, 
		DIB_RGB_COLORS, SRCCOPY);
	TkWinReleaseDrawableDC(pixmap, dc, &state);
    }

    /*
     * If the button is disabled with a stipple rather than a special
     * foreground color, generate the stippled effect.  If the widget
     * is selected and we use a different background color when selected,
     * must temporarily modify the GC.
     */

    if ((butPtr->state == tkDisabledUid)
	    && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
	if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
		&& (butPtr->selectBorder != NULL)) {
	    XSetForeground(butPtr->display, butPtr->disabledGC,
		    Tk_3DBorderColor(butPtr->selectBorder)->pixel);
	}
	XFillRectangle(butPtr->display, pixmap, butPtr->disabledGC,







|





|
|
|

|



















|












|
>
|
|










|







499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
    /*
     * Draw the indicator for check buttons and radio buttons.  At this
     * point x and y refer to the top-left corner of the text or image
     * or bitmap.
     */

    if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn
	    && tsdPtr->boxesPtr) {
	int xSrc, ySrc;

	x -= butPtr->indicatorSpace;
	y -= butPtr->indicatorDiameter / 2;

	xSrc = (butPtr->flags & SELECTED) ? tsdPtr->boxWidth : 0;
	if (butPtr->state == STATE_ACTIVE) {
	    xSrc += tsdPtr->boxWidth*2;
	}
	ySrc = (butPtr->type == TYPE_RADIO_BUTTON) ? 0 : tsdPtr->boxHeight;
		
	/*
	 * Update the palette in the boxes bitmap to reflect the current
	 * button colors.  Note that this code relies on the layout of the
	 * bitmap's palette.  Also, all of the colors used to draw the
	 * bitmap must be in the palette that is selected into the DC of
	 * the offscreen pixmap.  This requires that the static colors
	 * be placed into the palette.
	 */

	boxesPalette[PAL_CHECK] = FlipColor(gc->foreground);
	boxesPalette[PAL_TOP_OUTER] = FlipColor(TkWinGetBorderPixels(tkwin,
		border, TK_3D_DARK_GC));
	boxesPalette[PAL_TOP_INNER] = FlipColor(TkWinGetBorderPixels(tkwin,
		border, TK_3D_DARK2));
	boxesPalette[PAL_BOTTOM_INNER] = FlipColor(TkWinGetBorderPixels(tkwin,
		border, TK_3D_LIGHT2));
	boxesPalette[PAL_BOTTOM_OUTER] = FlipColor(TkWinGetBorderPixels(tkwin,
		border, TK_3D_LIGHT_GC));
	if (butPtr->state == STATE_DISABLED) {
	    boxesPalette[PAL_INTERIOR] = FlipColor(TkWinGetBorderPixels(tkwin,
		border, TK_3D_LIGHT2));
	} else if (butPtr->selectBorder != NULL) {
	    boxesPalette[PAL_INTERIOR] = FlipColor(TkWinGetBorderPixels(tkwin,
		    butPtr->selectBorder, TK_3D_FLAT_GC));
	} else {
	    boxesPalette[PAL_INTERIOR] = FlipColor(GetSysColor(COLOR_WINDOW));
	}
	boxesPalette[PAL_BACKGROUND] = FlipColor(TkWinGetBorderPixels(tkwin,
		border, TK_3D_FLAT_GC));

	dc = TkWinGetDrawableDC(butPtr->display, pixmap, &state);
	StretchDIBits(dc, x, y, tsdPtr->boxWidth, tsdPtr->boxHeight, 
                xSrc, ySrc, tsdPtr->boxWidth, tsdPtr->boxHeight, 
                tsdPtr->boxesBits, (LPBITMAPINFO) tsdPtr->boxesPtr, 
                DIB_RGB_COLORS, SRCCOPY);
	TkWinReleaseDrawableDC(pixmap, dc, &state);
    }

    /*
     * If the button is disabled with a stipple rather than a special
     * foreground color, generate the stippled effect.  If the widget
     * is selected and we use a different background color when selected,
     * must temporarily modify the GC.
     */

    if ((butPtr->state == STATE_DISABLED)
	    && ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
	if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
		&& (butPtr->selectBorder != NULL)) {
	    XSetForeground(butPtr->display, butPtr->disabledGC,
		    Tk_3DBorderColor(butPtr->selectBorder)->pixel);
	}
	XFillRectangle(butPtr->display, pixmap, butPtr->disabledGC,
632
633
634
635
636
637
638


639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692

void
TkpComputeButtonGeometry(butPtr)
    register TkButton *butPtr;	/* Button whose geometry may have changed. */
{
    int width, height, avgWidth;
    Tk_FontMetrics fm;



    if (butPtr->highlightWidth < 0) {
	butPtr->highlightWidth = 0;
    }
    butPtr->inset = butPtr->highlightWidth + butPtr->borderWidth;
    butPtr->indicatorSpace = 0;

    if (!boxesPtr) {
	InitBoxes();
    }

    if (butPtr->image != NULL) {
	Tk_SizeOfImage(butPtr->image, &width, &height);
	imageOrBitmap:
	if (butPtr->width > 0) {
	    width = butPtr->width;
	}
	if (butPtr->height > 0) {
	    height = butPtr->height;
	}
	if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) {
	    butPtr->indicatorSpace = boxWidth * 2;
	    butPtr->indicatorDiameter = boxHeight;
	}
    } else if (butPtr->bitmap != None) {
	Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
	goto imageOrBitmap;
    } else {
	Tk_FreeTextLayout(butPtr->textLayout);
	butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
		butPtr->text, -1, butPtr->wrapLength, butPtr->justify, 0,
		&butPtr->textWidth, &butPtr->textHeight);

	width = butPtr->textWidth;
	height = butPtr->textHeight;
	avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1);
	Tk_GetFontMetrics(butPtr->tkfont, &fm);

	if (butPtr->width > 0) {
	    width = butPtr->width * avgWidth;
	}
	if (butPtr->height > 0) {
	    height = butPtr->height * fm.linespace;
	}

	if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) {
	    butPtr->indicatorDiameter = boxHeight;
	    butPtr->indicatorSpace = butPtr->indicatorDiameter + avgWidth;
	}

	/*
	 * Increase the inset to allow for the focus ring.
	 */








>
>







|













|
|







|
|














|







636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698

void
TkpComputeButtonGeometry(butPtr)
    register TkButton *butPtr;	/* Button whose geometry may have changed. */
{
    int width, height, avgWidth;
    Tk_FontMetrics fm;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (butPtr->highlightWidth < 0) {
	butPtr->highlightWidth = 0;
    }
    butPtr->inset = butPtr->highlightWidth + butPtr->borderWidth;
    butPtr->indicatorSpace = 0;

    if (!tsdPtr->boxesPtr) {
	InitBoxes();
    }

    if (butPtr->image != NULL) {
	Tk_SizeOfImage(butPtr->image, &width, &height);
	imageOrBitmap:
	if (butPtr->width > 0) {
	    width = butPtr->width;
	}
	if (butPtr->height > 0) {
	    height = butPtr->height;
	}
	if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) {
	    butPtr->indicatorSpace = tsdPtr->boxWidth * 2;
	    butPtr->indicatorDiameter = tsdPtr->boxHeight;
	}
    } else if (butPtr->bitmap != None) {
	Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
	goto imageOrBitmap;
    } else {
	Tk_FreeTextLayout(butPtr->textLayout);
	butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
		Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength,
		butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight);

	width = butPtr->textWidth;
	height = butPtr->textHeight;
	avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1);
	Tk_GetFontMetrics(butPtr->tkfont, &fm);

	if (butPtr->width > 0) {
	    width = butPtr->width * avgWidth;
	}
	if (butPtr->height > 0) {
	    height = butPtr->height * fm.linespace;
	}

	if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) {
	    butPtr->indicatorDiameter = tsdPtr->boxHeight;
	    butPtr->indicatorSpace = butPtr->indicatorDiameter + avgWidth;
	}

	/*
	 * Increase the inset to allow for the focus ring.
	 */

784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
	    EndPaint(hwnd, &ps);
	    TkpDisplayButton((ClientData)butPtr);
	    return 0;
	}
	case BN_CLICKED: {
	    int code;
	    Tcl_Interp *interp = butPtr->info.interp;
	    if (butPtr->info.state != tkDisabledUid) {
		Tcl_Preserve((ClientData)interp);
		code = TkInvokeButton((TkButton*)butPtr);
		if (code != TCL_OK && code != TCL_CONTINUE
			&& code != TCL_BREAK) {
		    Tcl_AddErrorInfo(interp, "\n    (button invoke)");
		    Tcl_BackgroundError(interp);
		}







|







790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
	    EndPaint(hwnd, &ps);
	    TkpDisplayButton((ClientData)butPtr);
	    return 0;
	}
	case BN_CLICKED: {
	    int code;
	    Tcl_Interp *interp = butPtr->info.interp;
	    if (butPtr->info.state != STATE_DISABLED) {
		Tcl_Preserve((ClientData)interp);
		code = TkInvokeButton((TkButton*)butPtr);
		if (code != TCL_OK && code != TCL_CONTINUE
			&& code != TCL_BREAK) {
		    Tcl_AddErrorInfo(interp, "\n    (button invoke)");
		    Tcl_BackgroundError(interp);
		}

Changes to win/tkWinClipboard.c.

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
/* 
 * tkWinClipboard.c --
 *
 *	This file contains functions for managing the clipboard.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinClipboard.c 1.8 97/05/20 17:01:13
 */

#include "tkWinInt.h"
#include "tkSelect.h"


/*
 *----------------------------------------------------------------------
 *
 * TkSelGetSelection --
 *
 *	Retrieve the specified selection from another process.  For
 *	now, only fetching XA_STRING from CLIPBOARD is supported.
 *	Eventually other types should be allowed.
 * 
 * Results:
 *	The return value is a standard Tcl return value.
 *	If an error occurs (such as no selection exists)
 *	then an error message is left in interp->result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */






|




|


















|







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
/* 
 * tkWinClipboard.c --
 *
 *	This file contains functions for managing the clipboard.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinClipboard.c,v 1.1.4.4 1998/12/13 08:16:16 lfb Exp $
 */

#include "tkWinInt.h"
#include "tkSelect.h"


/*
 *----------------------------------------------------------------------
 *
 * TkSelGetSelection --
 *
 *	Retrieve the specified selection from another process.  For
 *	now, only fetching XA_STRING from CLIPBOARD is supported.
 *	Eventually other types should be allowed.
 * 
 * Results:
 *	The return value is a standard Tcl return value.
 *	If an error occurs (such as no selection exists)
 *	then an error message is left in the interp's result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

46
47
48
49
50
51
52

53
54
55
56
57
58
59
    Atom target;		/* Desired form in which selection
				 * is to be returned. */
    Tk_GetSelProc *proc;	/* Procedure to call to process the
				 * selection, once it has been retrieved. */
    ClientData clientData;	/* Arbitrary value to pass to proc. */
{
    char *data, *buffer, *destPtr;

    HGLOBAL handle;
    int result, length;

    if ((selection == Tk_InternAtom(tkwin, "CLIPBOARD"))
	    && (target == XA_STRING)) {
	if (OpenClipboard(NULL)) {
	    handle = GetClipboardData(CF_TEXT);







>







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
    Atom target;		/* Desired form in which selection
				 * is to be returned. */
    Tk_GetSelProc *proc;	/* Procedure to call to process the
				 * selection, once it has been retrieved. */
    ClientData clientData;	/* Arbitrary value to pass to proc. */
{
    char *data, *buffer, *destPtr;
    Tcl_DString ds;
    HGLOBAL handle;
    int result, length;

    if ((selection == Tk_InternAtom(tkwin, "CLIPBOARD"))
	    && (target == XA_STRING)) {
	if (OpenClipboard(NULL)) {
	    handle = GetClipboardData(CF_TEXT);
68
69
70
71
72
73
74
75
76


77
78
79
80
81
82
83
			destPtr++;
		    }
		    data++;
		}
		*destPtr = '\0';
		GlobalUnlock(handle);
		CloseClipboard();
		result = (*proc)(clientData, interp, buffer);
		ckfree(buffer);


		return result;
	    }
	    CloseClipboard();
	}
    }

    Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),







|

>
>







69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
			destPtr++;
		    }
		    data++;
		}
		*destPtr = '\0';
		GlobalUnlock(handle);
		CloseClipboard();
		Tcl_ExternalToUtfDString(NULL, buffer, -1, &ds);
		ckfree(buffer);
		result = (*proc)(clientData, interp, Tcl_DStringValue(&ds));
		Tcl_DStringFree(&ds);
		return result;
	    }
	    CloseClipboard();
	}
    }

    Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
    Tk_Window tkwin;

    /*
     * This is a gross hack because the Tk_InternAtom interface is broken.
     * It expects a Tk_Window, even though it only needs a Tk_Display.
     */

    tkwin = (Tk_Window)tkMainWindowList->winPtr;

    if (selection == Tk_InternAtom(tkwin, "CLIPBOARD")) {

	/*
	 * Only claim and empty the clipboard if we aren't already the
	 * owner of the clipboard.
	 */







|







118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
    Tk_Window tkwin;

    /*
     * This is a gross hack because the Tk_InternAtom interface is broken.
     * It expects a Tk_Window, even though it only needs a Tk_Display.
     */

    tkwin = (Tk_Window) TkGetMainInfoList()->winPtr;

    if (selection == Tk_InternAtom(tkwin, "CLIPBOARD")) {

	/*
	 * Only claim and empty the clipboard if we aren't already the
	 * owner of the clipboard.
	 */
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
TkWinClipboardRender(dispPtr, format)
    TkDisplay *dispPtr;
    UINT format;
{
    TkClipboardTarget *targetPtr;
    TkClipboardBuffer *cbPtr;
    HGLOBAL handle;
    char *buffer, *p, *endPtr;
    int length;


    for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
	    targetPtr = targetPtr->nextPtr) {
	if (targetPtr->type == XA_STRING)
	    break;
    }
    length = 0;
    if (targetPtr != NULL) {
	for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
		cbPtr = cbPtr->nextPtr) {
	    length += cbPtr->length;
	    for (p = cbPtr->buffer, endPtr = p + cbPtr->length;
		    p < endPtr; p++) {
		if (*p == '\n') {
		    length++;
		}
	    }
	}
    }
    handle = GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE, length+1);
    if (!handle) {
	return;
    }
    buffer = GlobalLock(handle);
    if (targetPtr != NULL) {
	for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
		cbPtr = cbPtr->nextPtr) {
	    for (p = cbPtr->buffer, endPtr = p + cbPtr->length;
		    p < endPtr; p++) {
		if (*p == '\n') {
		    *buffer++ = '\r';
		}
		*buffer++ = *p;
	    }
	}
    }
    *buffer = '\0';










    GlobalUnlock(handle);

    SetClipboardData(CF_TEXT, handle);
    return;
}

/*
 *----------------------------------------------------------------------
 *







|

>



















<
<
<
<
|













>
>
>
>
>
>
>
>
>
>

>







161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189




190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
TkWinClipboardRender(dispPtr, format)
    TkDisplay *dispPtr;
    UINT format;
{
    TkClipboardTarget *targetPtr;
    TkClipboardBuffer *cbPtr;
    HGLOBAL handle;
    char *buffer, *p, *rawText, *endPtr;
    int length;
    Tcl_DString ds;

    for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
	    targetPtr = targetPtr->nextPtr) {
	if (targetPtr->type == XA_STRING)
	    break;
    }
    length = 0;
    if (targetPtr != NULL) {
	for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
		cbPtr = cbPtr->nextPtr) {
	    length += cbPtr->length;
	    for (p = cbPtr->buffer, endPtr = p + cbPtr->length;
		    p < endPtr; p++) {
		if (*p == '\n') {
		    length++;
		}
	    }
	}
    }




    buffer = rawText = ckalloc(length + 1);
    if (targetPtr != NULL) {
	for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
		cbPtr = cbPtr->nextPtr) {
	    for (p = cbPtr->buffer, endPtr = p + cbPtr->length;
		    p < endPtr; p++) {
		if (*p == '\n') {
		    *buffer++ = '\r';
		}
		*buffer++ = *p;
	    }
	}
    }
    *buffer = '\0';
    Tcl_UtfToExternalDString(NULL, rawText, -1, &ds);
    ckfree(rawText);
    handle = GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE,
	    Tcl_DStringLength(&ds)+1);
    if (!handle) {
	Tcl_DStringFree(&ds);
	return;
    }
    buffer = GlobalLock(handle);
    memcpy(buffer, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds) + 1);
    GlobalUnlock(handle);
    Tcl_DStringFree(&ds);
    SetClipboardData(CF_TEXT, handle);
    return;
}

/*
 *----------------------------------------------------------------------
 *

Changes to win/tkWinColor.c.

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
/* 
 * tkWinColor.c --
 *
 *	Functions to map color names to system color values.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 * Copyright (c) 1994 Software Research Associates, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinColor.c 1.20 97/10/27 16:39:23
 */

#include <tkColor.h>
#include <tkWinInt.h>

/*
 * The following structure is used to keep track of each color that is
 * allocated by this module.
 */

typedef struct WinColor {
    TkColor info;		/* Generic color information. */
    int index;			/* Index for GetSysColor(), -1 if color
				 * is not a "live" system color. */
} WinColor;

/*
 * colorTable is a hash table used to look up X colors by name.
 */

static Tcl_HashTable colorTable;

/*
 * The sysColors array contains the names and index values for the
 * Windows indirect system color names.  In use, all of the names
 * will have the string "System" prepended, but we omit it in the table
 * to save space.
 */












|


|
|












<
<
<
<
<
<







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
/* 
 * tkWinColor.c --
 *
 *	Functions to map color names to system color values.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 * Copyright (c) 1994 Software Research Associates, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinColor.c,v 1.1.4.3 1998/12/13 08:16:16 lfb Exp $
 */

#include "tkWinInt.h"
#include "tkColor.h"

/*
 * The following structure is used to keep track of each color that is
 * allocated by this module.
 */

typedef struct WinColor {
    TkColor info;		/* Generic color information. */
    int index;			/* Index for GetSysColor(), -1 if color
				 * is not a "live" system color. */
} WinColor;







/*
 * The sysColors array contains the names and index values for the
 * Windows indirect system color names.  In use, all of the names
 * will have the string "System" prepended, but we omit it in the table
 * to save space.
 */

71
72
73
74
75
76
77

78


79
80
81
82
83
84
85
    "Scrollbar",		COLOR_SCROLLBAR,
    "Window",			COLOR_WINDOW,
    "WindowFrame",		COLOR_WINDOWFRAME,
    "WindowText",		COLOR_WINDOWTEXT,
    NULL,			0
};


static int ncolors = 0;



/*
 * Forward declarations for functions defined later in this file.
 */

static int	FindSystemColor _ANSI_ARGS_((const char *name,
		    XColor *colorPtr, int *indexPtr));







>
|
>
>







65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
    "Scrollbar",		COLOR_SCROLLBAR,
    "Window",			COLOR_WINDOW,
    "WindowFrame",		COLOR_WINDOWFRAME,
    "WindowText",		COLOR_WINDOWTEXT,
    NULL,			0
};

typedef struct ThreadSpecificData { 
    int ncolors;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations for functions defined later in this file.
 */

static int	FindSystemColor _ANSI_ARGS_((const char *name,
		    XColor *colorPtr, int *indexPtr));
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
static int
FindSystemColor(name, colorPtr, indexPtr)
    const char *name;		/* Color name. */
    XColor *colorPtr;		/* Where to store results. */
    int *indexPtr;		/* Out parameter to store color index. */
{
    int l, u, r, i;



    /*
     * Count the number of elements in the color array if we haven't
     * done so yet.
     */

    if (ncolors == 0) {
	SystemColorEntry *ePtr;
	int version;

	version = LOBYTE(LOWORD(GetVersion()));
	for (ePtr = sysColors; ePtr->name != NULL; ePtr++) {
	    if (version < 4) {
		if (ePtr->index == COLOR_3DDKSHADOW) {
		    ePtr->index = COLOR_BTNSHADOW;
		} else if (ePtr->index == COLOR_3DLIGHT) {
		    ePtr->index = COLOR_BTNHIGHLIGHT;
		}
	    }
	    ncolors++;
	}
    }

    /*
     * Perform a binary search on the sorted array of colors.
     */

    l = 0;
    u = ncolors - 1;
    while (l <= u) {
	i = (l + u) / 2;
	r = strcasecmp(name, sysColors[i].name);
	if (r == 0) {
	    break;
	} else if (r < 0) {
	    u = i-1;







>
>






|












|








|







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
static int
FindSystemColor(name, colorPtr, indexPtr)
    const char *name;		/* Color name. */
    XColor *colorPtr;		/* Where to store results. */
    int *indexPtr;		/* Out parameter to store color index. */
{
    int l, u, r, i;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Count the number of elements in the color array if we haven't
     * done so yet.
     */

    if (tsdPtr->ncolors == 0) {
	SystemColorEntry *ePtr;
	int version;

	version = LOBYTE(LOWORD(GetVersion()));
	for (ePtr = sysColors; ePtr->name != NULL; ePtr++) {
	    if (version < 4) {
		if (ePtr->index == COLOR_3DDKSHADOW) {
		    ePtr->index = COLOR_BTNSHADOW;
		} else if (ePtr->index == COLOR_3DLIGHT) {
		    ePtr->index = COLOR_BTNHIGHLIGHT;
		}
	    }
	    tsdPtr->ncolors++;
	}
    }

    /*
     * Perform a binary search on the sorted array of colors.
     */

    l = 0;
    u = tsdPtr->ncolors - 1;
    while (l <= u) {
	i = (l + u) / 2;
	r = strcasecmp(name, sysColors[i].name);
	if (r == 0) {
	    break;
	} else if (r < 0) {
	    u = i-1;

Added win/tkWinConfig.c.

























































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
/* 
 * tkWinConfig.c --
 *
 *	This module implements the Windows system defaults for
 *	the configuration package.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinConfig.c,v 1.1.2.2 1998/09/30 02:19:30 stanton Exp $
 */

#include "tk.h"
#include "tkInt.h"
#include "tkWinInt.h"


/*
 *----------------------------------------------------------------------
 *
 * TkpGetSystemDefault --
 *
 *	Given a dbName and className for a configuration option,
 *	return a string representation of the option.
 *
 * Results:
 *	Returns a Tk_Uid that is the string identifier that identifies
 *	this option. Returns NULL if there are no system defaults
 *	that match this pair.
 *
 * Side effects:
 *	None, once the package is initialized.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TkpGetSystemDefault(
    Tk_Window tkwin,		/* A window to use. */
    char *dbName,		/* The option database name. */
    char *className)		/* The name of the option class. */
{
    Tcl_Obj *valueObjPtr;
    Tk_Uid classUid;

    if (tkwin == NULL) {
	return NULL;
    }

    valueObjPtr = NULL;
    classUid = Tk_Class(tkwin);

    if (strcmp(classUid, "Menu") == 0) {
	valueObjPtr = TkWinGetMenuSystemDefault(tkwin, dbName, className);
    }

    return valueObjPtr;
}

Changes to win/tkWinCursor.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkWinCursor.c --
 *
 *	This file contains Win32 specific cursor related routines.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinCursor.c 1.10 97/09/02 13:21:01
 */

#include "tkWinInt.h"

/*
 * The following data structure contains the system specific data
 * necessary to control Windows cursors.










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkWinCursor.c --
 *
 *	This file contains Win32 specific cursor related routines.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinCursor.c,v 1.1.4.2 1998/09/30 02:19:30 stanton Exp $
 */

#include "tkWinInt.h"

/*
 * The following data structure contains the system specific data
 * necessary to control Windows cursors.
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
{
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TkFreeCursor --
 *
 *	This procedure is called to release a cursor allocated by
 *	TkGetCursorByName.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The cursor data structure is deallocated.
 *
 *----------------------------------------------------------------------
 */

void
TkFreeCursor(cursorPtr)
    TkCursor *cursorPtr;
{
    TkWinCursor *winCursorPtr = (TkWinCursor *) cursorPtr;
    ckfree((char *) winCursorPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TkpSetCursor --
 *







|














|



<







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
{
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TkpFreeCursor --
 *
 *	This procedure is called to release a cursor allocated by
 *	TkGetCursorByName.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The cursor data structure is deallocated.
 *
 *----------------------------------------------------------------------
 */

void
TkpFreeCursor(cursorPtr)
    TkCursor *cursorPtr;
{
    TkWinCursor *winCursorPtr = (TkWinCursor *) cursorPtr;

}

/*
 *----------------------------------------------------------------------
 *
 * TkpSetCursor --
 *

Changes to win/tkWinDefault.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * tkWinDefault.h --
 *
 *	This file defines the defaults for all options for all of
 *	the Tk widgets.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinDefault.h 1.34 97/10/09 17:45:20
 */

#ifndef _TKWINDEFAULT
#define _TKWINDEFAULT

/*
 * The definitions below provide symbolic names for the default colors.











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * tkWinDefault.h --
 *
 *	This file defines the defaults for all options for all of
 *	the Tk widgets.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinDefault.h,v 1.1.4.4 1999/02/16 06:00:43 lfb Exp $
 */

#ifndef _TKWINDEFAULT
#define _TKWINDEFAULT

/*
 * The definitions below provide symbolic names for the default colors.
61
62
63
64
65
66
67

68
69
70
71
72
73
74
75
#define DEF_BUTTON_DEFAULT		"disabled"
#define DEF_BUTTON_DISABLED_FG_COLOR	DISABLED
#define DEF_BUTTON_DISABLED_FG_MONO	""
#define DEF_BUTTON_FG			NORMAL_FG
#define DEF_CHKRAD_FG			TEXT_FG
#define DEF_BUTTON_FONT		CTL_FONT
#define DEF_BUTTON_HEIGHT		"0"

#define DEF_BUTTON_HIGHLIGHT_BG	NORMAL_BG
#define DEF_BUTTON_HIGHLIGHT		HIGHLIGHT
#define DEF_LABEL_HIGHLIGHT_WIDTH	"0"
#define DEF_BUTTON_HIGHLIGHT_WIDTH	"1"
#define DEF_BUTTON_IMAGE		(char *) NULL
#define DEF_BUTTON_INDICATOR		"1"
#define DEF_BUTTON_JUSTIFY		"center"
#define DEF_BUTTON_OFF_VALUE		"0"







>
|







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
#define DEF_BUTTON_DEFAULT		"disabled"
#define DEF_BUTTON_DISABLED_FG_COLOR	DISABLED
#define DEF_BUTTON_DISABLED_FG_MONO	""
#define DEF_BUTTON_FG			NORMAL_FG
#define DEF_CHKRAD_FG			TEXT_FG
#define DEF_BUTTON_FONT		CTL_FONT
#define DEF_BUTTON_HEIGHT		"0"
#define DEF_BUTTON_HIGHLIGHT_BG_COLOR	DEF_BUTTON_BG_COLOR
#define DEF_BUTTON_HIGHLIGHT_BG_MONO	DEF_BUTTON_BG_MONO
#define DEF_BUTTON_HIGHLIGHT		HIGHLIGHT
#define DEF_LABEL_HIGHLIGHT_WIDTH	"0"
#define DEF_BUTTON_HIGHLIGHT_WIDTH	"1"
#define DEF_BUTTON_IMAGE		(char *) NULL
#define DEF_BUTTON_INDICATOR		"1"
#define DEF_BUTTON_JUSTIFY		"center"
#define DEF_BUTTON_OFF_VALUE		"0"
284
285
286
287
288
289
290

291
292
293
294
295
296
297
298
#define DEF_MENUBUTTON_CURSOR		""
#define DEF_MENUBUTTON_DIRECTION	"below"
#define DEF_MENUBUTTON_DISABLED_FG_COLOR DISABLED
#define DEF_MENUBUTTON_DISABLED_FG_MONO	""
#define DEF_MENUBUTTON_FONT		CTL_FONT
#define DEF_MENUBUTTON_FG		NORMAL_FG
#define DEF_MENUBUTTON_HEIGHT		"0"

#define DEF_MENUBUTTON_HIGHLIGHT_BG	NORMAL_BG
#define DEF_MENUBUTTON_HIGHLIGHT	HIGHLIGHT
#define DEF_MENUBUTTON_HIGHLIGHT_WIDTH	"0"
#define DEF_MENUBUTTON_IMAGE		(char *) NULL
#define DEF_MENUBUTTON_INDICATOR	"0"
#define DEF_MENUBUTTON_JUSTIFY		"center"
#define DEF_MENUBUTTON_MENU		""
#define DEF_MENUBUTTON_PADX		"4p"







>
|







285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
#define DEF_MENUBUTTON_CURSOR		""
#define DEF_MENUBUTTON_DIRECTION	"below"
#define DEF_MENUBUTTON_DISABLED_FG_COLOR DISABLED
#define DEF_MENUBUTTON_DISABLED_FG_MONO	""
#define DEF_MENUBUTTON_FONT		CTL_FONT
#define DEF_MENUBUTTON_FG		NORMAL_FG
#define DEF_MENUBUTTON_HEIGHT		"0"
#define DEF_MENUBUTTON_HIGHLIGHT_BG_COLOR DEF_MENUBUTTON_BG_COLOR
#define DEF_MENUBUTTON_HIGHLIGHT_BG_MONO  DEF_MENUBUTTON_BG_MONO
#define DEF_MENUBUTTON_HIGHLIGHT	HIGHLIGHT
#define DEF_MENUBUTTON_HIGHLIGHT_WIDTH	"0"
#define DEF_MENUBUTTON_IMAGE		(char *) NULL
#define DEF_MENUBUTTON_INDICATOR	"0"
#define DEF_MENUBUTTON_JUSTIFY		"center"
#define DEF_MENUBUTTON_MENU		""
#define DEF_MENUBUTTON_PADX		"4p"
343
344
345
346
347
348
349

350
351
352
353
354
355
356
357
#define DEF_SCALE_COMMAND		""
#define DEF_SCALE_CURSOR		""
#define DEF_SCALE_DIGITS		"0"
#define DEF_SCALE_FONT			CTL_FONT
#define DEF_SCALE_FG_COLOR		NORMAL_FG
#define DEF_SCALE_FG_MONO		BLACK
#define DEF_SCALE_FROM			"0"

#define DEF_SCALE_HIGHLIGHT_BG		NORMAL_BG
#define DEF_SCALE_HIGHLIGHT		HIGHLIGHT
#define DEF_SCALE_HIGHLIGHT_WIDTH	"2"
#define DEF_SCALE_LABEL			""
#define DEF_SCALE_LENGTH		"100"
#define DEF_SCALE_ORIENT		"vertical"
#define DEF_SCALE_RELIEF		"flat"
#define DEF_SCALE_REPEAT_DELAY	"300"







>
|







345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
#define DEF_SCALE_COMMAND		""
#define DEF_SCALE_CURSOR		""
#define DEF_SCALE_DIGITS		"0"
#define DEF_SCALE_FONT			CTL_FONT
#define DEF_SCALE_FG_COLOR		NORMAL_FG
#define DEF_SCALE_FG_MONO		BLACK
#define DEF_SCALE_FROM			"0"
#define DEF_SCALE_HIGHLIGHT_BG_COLOR	DEF_SCALE_BG_COLOR
#define DEF_SCALE_HIGHLIGHT_BG_MONO	DEF_SCALE_BG_MONO
#define DEF_SCALE_HIGHLIGHT		HIGHLIGHT
#define DEF_SCALE_HIGHLIGHT_WIDTH	"2"
#define DEF_SCALE_LABEL			""
#define DEF_SCALE_LENGTH		"100"
#define DEF_SCALE_ORIENT		"vertical"
#define DEF_SCALE_RELIEF		"flat"
#define DEF_SCALE_REPEAT_DELAY	"300"

Changes to win/tkWinDialog.c.


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21










22
23
24

25
26
27
28
29
30
31
32

33




34
35
36
37
38
39
40
41
42
43
44








45








46

47
48


49

50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68

69

70
71
72





73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

91
92
93







94
95
96
97
98

99
100
101
102
103
104
105

106
107
108
109

110
111
112
113
114
115
116
117
118
119

120
121
122
123



124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188



189

190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208

209
210
211
212
213
214
215
216
217
218
219
220
221

222
223
224
225
226


227
228
229
230
231
232
233
234
235
236
237
238


239

240
241
242
243
244
245
246



247




248
249
250
251

252

253
254
255
256
257
258
259
260
261
262
263
264
265

266
267
268
269
270
271
272
273
274
275
276
277
278
279
280

281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321

322
323

324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343

344
345

346

347


348
349
350

351

352



353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443

444














445


446






















447




448
449
450









451
452

453



454
455










456












457









































458




459

































460
461
462

463
464
465
466
467

468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484

485
486
487
488

489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511

512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550


551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574


575
576
577

578
579
580
581

582


583
584
585
586
587


588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612

613
614
615
616
617
618

619
620
621
622
623
624
625
626
627
628
629
630

631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646

647
648
649
650
651
652
653
654
655
656
657
658

659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687

688
689
690

691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712

/*
 * tkWinDialog.c --
 *
 *	Contains the Windows implementation of the common dialog boxes.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinDialog.c 1.10 97/10/21 11:29:18
 *
 */
 
#include "tkWinInt.h"
#include "tkFileFilter.h"

#include <commdlg.h>    /* includes common dialog functionality */
#include <dlgs.h>       /* includes common dialog template defines */
#include <cderr.h>      /* includes the common dialog error codes */











#if ((TK_MAJOR_VERSION == 4) && (TK_MINOR_VERSION <= 2))
/*
 * The following function is implemented on tk4.3 and after only 

 */
#define Tk_GetHWND TkWinGetHWND
#endif

#define SAVE_FILE 0
#define OPEN_FILE 1

/*----------------------------------------------------------------------

 * MsgTypeInfo --




 *
 *	This structure stores the type of available message box in an
 *	easy-to-process format. Used by th Tk_MessageBox() function
 *----------------------------------------------------------------------
 */
typedef struct MsgTypeInfo {
    char * name;
    int type;
    int numButtons;
    char * btnNames[3];
} MsgTypeInfo;

















#define NUM_TYPES 6


static MsgTypeInfo 


msgTypeInfo[NUM_TYPES] = {

    {"abortretryignore", MB_ABORTRETRYIGNORE, 3, {"abort", "retry", "ignore"}},
    {"ok", 		 MB_OK, 	      1, {"ok"                      }},
    {"okcancel",	 MB_OKCANCEL,	      2, {"ok",    "cancel"         }},
    {"retrycancel",	 MB_RETRYCANCEL,      2, {"retry", "cancel"         }},
    {"yesno",		 MB_YESNO,	      2, {"yes",   "no"             }},
    {"yesnocancel",	 MB_YESNOCANCEL,      3, {"yes",   "no",    "cancel"}}
};

/*
 * The following structure is used in the GetOpenFileName() and
 * GetSaveFileName() calls.
 */
typedef struct _OpenFileData {
    Tcl_Interp * interp;
    TCHAR szFile[MAX_PATH+1];
} OpenFileData;

/*
 * The following structure is used in the ChooseColor() call.

 */

typedef struct _ChooseColorData {
    Tcl_Interp * interp;
    char * title;			/* Title of the color dialog */





} ChooseColorData;


static int 		GetFileName _ANSI_ARGS_((ClientData clientData,
    			    Tcl_Interp *interp, int argc, char **argv,
    			    int isOpen));
static UINT CALLBACK	ColorDlgHookProc _ANSI_ARGS_((HWND hDlg, UINT uMsg,
			    WPARAM wParam, LPARAM lParam));
static int 		MakeFilter _ANSI_ARGS_((Tcl_Interp *interp,
    			    OPENFILENAME *ofnPtr, char * string));
static int		ParseFileDlgArgs _ANSI_ARGS_((Tcl_Interp * interp,
    			    OPENFILENAME *ofnPtr, int argc, char ** argv,
			    int isOpen));
static int 		ProcessCDError _ANSI_ARGS_((Tcl_Interp * interp,
			    DWORD dwErrorCode, HWND hWnd));

/*
 *----------------------------------------------------------------------

 *
 * EvalArgv --
 *







 *	Invokes the Tcl procedure with the arguments. argv[0] is set by
 *	the caller of this function. It may be different than cmdName.
 *	The TCL command will see argv[0], not cmdName, as its name if it
 *	invokes [lindex [info level 0] 0]
 *

 * Results:
 *	TCL_ERROR if the command does not exist and cannot be autoloaded.
 *	Otherwise, return the result of the evaluation of the command.
 *
 * Side effects:
 *	The command may be autoloaded.
 *

 *----------------------------------------------------------------------
 */

static int 

EvalArgv(interp, cmdName, argc, argv)
    Tcl_Interp *interp;		/* Current interpreter. */
    char * cmdName;		/* Name of the TCL command to call */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    Tcl_CmdInfo cmdInfo;

    if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
	char * cmdArgv[2];


	/*
	 * This comand is not in the interpreter yet -- looks like we
	 * have to auto-load it



	 */
	if (!Tcl_GetCommandInfo(interp, "auto_load", &cmdInfo)) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "cannot execute command \"auto_load\"",
		NULL);
	    return TCL_ERROR;
	}

	cmdArgv[0] = "auto_load";
	cmdArgv[1] = cmdName;

	if ((*cmdInfo.proc)(cmdInfo.clientData, interp, 2, cmdArgv)!= TCL_OK){ 
	    return TCL_ERROR;
	}

	if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "cannot auto-load command \"",
		cmdName, "\"",NULL);
	    return TCL_ERROR;
	}
    }

    return (*cmdInfo.proc)(cmdInfo.clientData, interp, argc, argv);
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_ChooseColorCmd --
 *
 *	This procedure implements the color dialog box for the Windows
 *	platform. See the user documentation for details on what it
 *	does.
 *
 * Results:
 *	See user documentation.
 *
 * Side effects:
 *	A dialog window is created the first time this procedure is called.
 *	This window is not destroyed and will be reused the next time the
 *	application invokes the "tk_chooseColor" command.
 *
 *----------------------------------------------------------------------
 */

int
Tk_ChooseColorCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    Tk_Window parent = Tk_MainWindow(interp);
    ChooseColorData custData;
    int oldMode;
    CHOOSECOLOR chooseColor;
    char * colorStr = NULL;
    int i;
    int winCode, tclCode;
    XColor * colorPtr = NULL;
    static inited = 0;
    static long dwCustColors[16];
    static long oldColor;		/* the color selected last time */




    custData.title     = NULL;


    if (!inited) {
	/*
	 * dwCustColors stores the custom color which the user can
	 * modify. We store these colors in a fixed array so that the next
	 * time the color dialog pops up, the same set of custom colors
	 * remain in the dialog.
	 */
	for (i=0; i<16; i++) {
	    dwCustColors[i] = (RGB(255-i*10, i, i*10)) ;
	}
	oldColor = RGB(0xa0,0xa0,0xa0);
	inited = 1;
    }

    /*
     * 1. Parse the arguments
     */


    chooseColor.lStructSize  = sizeof(CHOOSECOLOR) ;
    chooseColor.hwndOwner    = 0;			/* filled in below */
    chooseColor.hInstance    = 0;
    chooseColor.rgbResult    = oldColor;
    chooseColor.lpCustColors = (LPDWORD) dwCustColors ;
    chooseColor.Flags        = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK;
    chooseColor.lCustData    = (LPARAM)&custData;
    chooseColor.lpfnHook     = ColorDlgHookProc;
    chooseColor.lpTemplateName = NULL;

    for (i=1; i<argc; i+=2) {
        int v = i+1;
	int len = strlen(argv[i]);


	if (strncmp(argv[i], "-initialcolor", len)==0) {
	    if (v==argc) {goto arg_missing;}

	    colorStr = argv[v];


	}
	else if (strncmp(argv[i], "-parent", len)==0) {
	    if (v==argc) {goto arg_missing;}

	    parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
	    if (parent == NULL) {
		return TCL_ERROR;
	    }
	}
	else if (strncmp(argv[i], "-title", len)==0) {
	    if (v==argc) {goto arg_missing;}



	    custData.title = argv[v];

	}
	else {
    	    Tcl_AppendResult(interp, "unknown option \"", 
		argv[i], "\", must be -initialcolor, -parent or -title",
		NULL);
		return TCL_ERROR;
	}



    }





    if (Tk_WindowId(parent) == None) {
	Tk_MakeWindowExist(parent);
    }

    chooseColor.hwndOwner = Tk_GetHWND(Tk_WindowId(parent));


    if (colorStr != NULL) {
	colorPtr = Tk_GetColor(interp, Tk_MainWindow(interp), colorStr);
	if (!colorPtr) {
	    return TCL_ERROR;
	}
	chooseColor.rgbResult = RGB((colorPtr->red/0x100), 
	    (colorPtr->green/0x100), (colorPtr->blue/0x100));
    }	

    /*
     * 2. Popup the dialog
     */


    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
    winCode = ChooseColor(&chooseColor);
    (void) Tcl_SetServiceMode(oldMode);

    /*
     * Clear the interp result since anything may have happened during the
     * modal loop.
     */

    Tcl_ResetResult(interp);

    /*
     * 3. Process the result of the dialog
     */

    if (winCode) {
	/*
	 * User has selected a color
	 */
	char result[100];

	sprintf(result, "#%02x%02x%02x",
	    GetRValue(chooseColor.rgbResult), 
	    GetGValue(chooseColor.rgbResult), 
	    GetBValue(chooseColor.rgbResult));
        Tcl_AppendResult(interp, result, NULL);
	tclCode = TCL_OK;

	oldColor = chooseColor.rgbResult;
    } else {
	/*
	 * User probably pressed Cancel, or an error occurred
	 */
	tclCode = ProcessCDError(interp, CommDlgExtendedError(), 
	     chooseColor.hwndOwner);
    }

    if (colorPtr) {
	Tk_FreeColor(colorPtr);
    }

    return tclCode;

  arg_missing:
    Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
	NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ColorDlgHookProc --
 *
 *	Gets called during the execution of the color dialog. It processes
 *	the "interesting" messages that Windows send to the dialog.

 *
 * Results:

 *	TRUE if the message has been processed, FALSE otherwise.
 *
 * Side effects:
 *	Changes the title of the dialog window when it is popped up.
 *
 *----------------------------------------------------------------------
 */

static UINT
CALLBACK ColorDlgHookProc(hDlg, uMsg, wParam, lParam)
    HWND hDlg;			/* Handle to the color dialog */
    UINT uMsg;			/* Type of message */
    WPARAM wParam;		/* word param, interpretation depends on uMsg*/
    LPARAM lParam;		/* long param, interpretation depends on uMsg*/
{
    CHOOSECOLOR * ccPtr;
    ChooseColorData * pCustData;

    switch (uMsg) {
      case WM_INITDIALOG:

	/* Save the pointer to CHOOSECOLOR so that we can use it later */
	SetWindowLong(hDlg, DWL_USER, lParam);



	/* Set the title string of the dialog */


	ccPtr = (CHOOSECOLOR*)lParam;
	pCustData = (ChooseColorData*)(ccPtr->lCustData);
	if (pCustData->title && *(pCustData->title)) {

 	    SetWindowText(hDlg, (LPCSTR)pCustData->title);

	}




	return TRUE;
    }

    return FALSE;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetOpenFileCmd --
 *
 *	This procedure implements the "open file" dialog box for the
 *	Windows platform. See the user documentation for details on what
 *	it does.
 *
 * Results:
 *	See user documentation.
 *
 * Side effects:
 *	A dialog window is created the first this procedure is called.
 *	This window is not destroyed and will be reused the next time
 *	the application invokes the "tk_getOpenFile" or
 *	"tk_getSaveFile" command.
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetOpenFileCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    return GetFileName(clientData, interp, argc, argv, OPEN_FILE);
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetSaveFileCmd --
 *
 *	Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
 *	instead
 *
 * Results:
 *	Same as Tk_GetOpenFileCmd.
 *
 * Side effects:
 *	Same as Tk_GetOpenFileCmd.
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetSaveFileCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    return GetFileName(clientData, interp, argc, argv, SAVE_FILE);
}

/*
 *----------------------------------------------------------------------
 *
 * GetFileName --
 *
 *	Calls GetOpenFileName() or GetSaveFileName().
 *
 * Results:
 *	See user documentation.
 *
 * Side effects:
 *	See user documentation.
 *
 *----------------------------------------------------------------------
 */

static int 
GetFileName(clientData, interp, argc, argv, isOpen)
    ClientData clientData;	/* Main window associated with interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
    int isOpen;			/* true if we should call GetOpenFileName(),
				 * false if we should call GetSaveFileName() */
{
    OPENFILENAME openFileName, *ofnPtr;

    int tclCode, winCode, oldMode;














    OpenFileData *custData;


    char buffer[MAX_PATH+1];






















    




    ofnPtr = &openFileName;

    /*









     * 1. Parse the arguments.
     */

    if (ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen) != TCL_OK) {



	return TCL_ERROR;
    }










    custData = (OpenFileData*) ofnPtr->lCustData;






















































    /*




     * 2. Call the common dialog function.

































     */
    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
    GetCurrentDirectory(MAX_PATH+1, buffer);

    if (isOpen) {
	winCode = GetOpenFileName(ofnPtr);
    } else {
	winCode = GetSaveFileName(ofnPtr);
    }

    SetCurrentDirectory(buffer);
    (void) Tcl_SetServiceMode(oldMode);

    /*
     * Clear the interp result since anything may have happened during the
     * modal loop.
     */

    Tcl_ResetResult(interp);

    if (ofnPtr->lpstrInitialDir != NULL) {
	ckfree((char*) ofnPtr->lpstrInitialDir);
    }

    /*
     * 3. Process the results.
     */

    if (winCode) {
	char *p;
	Tcl_ResetResult(interp);


	for (p = custData->szFile; p && *p; p++) {
	    /*
	     * Change the pathname to the Tcl "normalized" pathname, where
	     * back slashes are used instead of forward slashes
	     */
	    if (*p == '\\') {
		*p = '/';
	    }
	}
	Tcl_AppendResult(interp, custData->szFile, NULL);
	tclCode = TCL_OK;
    } else {
	tclCode = ProcessCDError(interp, CommDlgExtendedError(),
		ofnPtr->hwndOwner);
    }

    if (custData) {
	ckfree((char*)custData);
    }
    if (ofnPtr->lpstrFilter) {
	ckfree((char*)ofnPtr->lpstrFilter);
    }


    return tclCode;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseFileDlgArgs --
 *
 *	Parses the arguments passed to tk_getOpenFile and tk_getSaveFile.
 *
 * Results:
 *	A standard TCL return value.
 *
 * Side effects:
 *	The OPENFILENAME structure is initialized and modified according
 *	to the arguments.
 *
 *----------------------------------------------------------------------
 */

static int 
ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen)
    Tcl_Interp * interp;	/* Current interpreter. */
    OPENFILENAME *ofnPtr;	/* Info about the file dialog */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
    int isOpen;			/* true if we should call GetOpenFileName(),
				 * false if we should call GetSaveFileName() */
{
    OpenFileData * custData;
    int i;
    Tk_Window parent = Tk_MainWindow(interp);
    int doneFilter = 0;
    int windowsMajorVersion;
    Tcl_DString buffer;

    custData = (OpenFileData*)ckalloc(sizeof(OpenFileData));
    custData->interp = interp;
    strcpy(custData->szFile, "");



    /* Fill in the OPENFILENAME structure to */
    ofnPtr->lStructSize       = sizeof(OPENFILENAME);
    ofnPtr->hwndOwner         = 0;			/* filled in below */
    ofnPtr->lpstrFilter       = NULL;
    ofnPtr->lpstrCustomFilter = NULL;
    ofnPtr->nMaxCustFilter    = 0;
    ofnPtr->nFilterIndex      = 0;
    ofnPtr->lpstrFile         = custData->szFile;
    ofnPtr->nMaxFile          = sizeof(custData->szFile);
    ofnPtr->lpstrFileTitle    = NULL;
    ofnPtr->nMaxFileTitle     = 0;
    ofnPtr->lpstrInitialDir   = NULL;
    ofnPtr->lpstrTitle        = NULL;
    ofnPtr->nFileOffset       = 0;
    ofnPtr->nFileExtension    = 0;
    ofnPtr->lpstrDefExt       = NULL;
    ofnPtr->lpfnHook 	      = NULL; 
    ofnPtr->lCustData         = (DWORD)custData;
    ofnPtr->lpTemplateName    = NULL;
    ofnPtr->Flags             = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST;

    windowsMajorVersion = LOBYTE(LOWORD(GetVersion()));
    if (windowsMajorVersion >= 4) {


	/*
	 * Use the "explorer" style file selection box on platforms that
	 * support it (Win95 and NT4.0, both have a major version number

	 * of 4)
	 */
	ofnPtr->Flags |= OFN_EXPLORER;
    }





    if (isOpen) {
	ofnPtr->Flags |= OFN_FILEMUSTEXIST;
    } else {
	ofnPtr->Flags |= OFN_OVERWRITEPROMPT;


    }

    for (i=1; i<argc; i+=2) {
        int v = i+1;
	int len = strlen(argv[i]);

	if (strncmp(argv[i], "-defaultextension", len)==0) {
	    if (v==argc) {goto arg_missing;}

	    ofnPtr->lpstrDefExt = argv[v];
	    if (ofnPtr->lpstrDefExt[0] == '.') {
		/* Windows will insert the dot for us */
		ofnPtr->lpstrDefExt ++;
	    }
	}
	else if (strncmp(argv[i], "-filetypes", len)==0) {
	    if (v==argc) {goto arg_missing;}

	    if (MakeFilter(interp, ofnPtr, argv[v]) != TCL_OK) {
		return TCL_ERROR;
	    }
	    doneFilter = 1;
	}
	else if (strncmp(argv[i], "-initialdir", len)==0) {
	    if (v==argc) {goto arg_missing;}


	    if (Tcl_TranslateFileName(interp, argv[v], &buffer) == NULL) {
		return TCL_ERROR;
	    }
	    ofnPtr->lpstrInitialDir = ckalloc(Tcl_DStringLength(&buffer)+1);
	    strcpy((char*)ofnPtr->lpstrInitialDir, Tcl_DStringValue(&buffer));

	    Tcl_DStringFree(&buffer);
	}
	else if (strncmp(argv[i], "-initialfile", len)==0) {
	    if (v==argc) {goto arg_missing;}

	    if (Tcl_TranslateFileName(interp, argv[v], &buffer) == NULL) {
		return TCL_ERROR;
	    }
	    strcpy(ofnPtr->lpstrFile, Tcl_DStringValue(&buffer));
	    Tcl_DStringFree(&buffer);
	}
	else if (strncmp(argv[i], "-parent", len)==0) {

	    if (v==argc) {goto arg_missing;}

	    parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
	    if (parent == NULL) {
		return TCL_ERROR;
	    }
	}
	else if (strncmp(argv[i], "-title", len)==0) {
	    if (v==argc) {goto arg_missing;}

	    ofnPtr->lpstrTitle = argv[v];
	}
	else {
    	    Tcl_AppendResult(interp, "unknown option \"", 
		argv[i], "\", must be -defaultextension, ",
		"-filetypes, -initialdir, -initialfile, -parent or -title",

		NULL);
	    return TCL_ERROR;
	}
    }

    if (!doneFilter) {
	if (MakeFilter(interp, ofnPtr, "") != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    if (Tk_WindowId(parent) == None) {

	Tk_MakeWindowExist(parent);
    }
    ofnPtr->hwndOwner = Tk_GetHWND(Tk_WindowId(parent));

    return TCL_OK;

  arg_missing:
    Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
	NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * MakeFilter --
 *
 *	Allocate a buffer to store the filters in a format understood by
 *	Windows
 *
 * Results:
 *	A standard TCL return value.
 *
 * Side effects:
 *	ofnPtr->lpstrFilter is modified.
 *
 *----------------------------------------------------------------------
 */
static int MakeFilter(interp, ofnPtr, string) 

    Tcl_Interp *interp;		/* Current interpreter. */
    OPENFILENAME *ofnPtr;	/* Info about the file dialog */
    char *string;		/* String value of the -filetypes option */

{
    char *filterStr;
    char *p;
    int pass;
    FileFilterList flist;
    FileFilter *filterPtr;

    TkInitFileFilters(&flist);
    if (TkGetFileFilters(interp, &flist, string, 1) != TCL_OK) {
	return TCL_ERROR;
    }

    if (flist.filters == NULL) {
	/*
	 * Use "All Files (*.*) as the default filter is none is specified
	 */
	char *defaultFilter = "All Files (*.*)";

	p = filterStr = (char*)ckalloc(30 * sizeof(char));

	strcpy(p, defaultFilter);
	p+= strlen(defaultFilter);
>










|


|







>
>
>
>
>
>
>
>
>
>
|

|
>

<
<

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

>
>
>
>
>
>
>
>
|
>

|
>
>
|
>
|
|
|
|
|
|


|
<
<
<
<
<
<
<


|
>

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


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



|

|













|



|


|
|

|
<
|

<
<
<
<

|

|
>
>
>
|
>

|


|



|
|

|



<
|
<

>
|
|
|
|
|
|
|
|
|

|
|
|
>

|
|

|
>
>

<
|
|
|
|
|
<

<
<

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

<
<
|

<
|
<
>















>







|
|
|

<
<

<
<
<
<
<
<

<
<
<
<
<
<
<
<
<
<
|



|



<
|
>


>
|


|




|
|
|
|
|
|

|
|


|
>
|
<
>

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

















<
<
<





|


|
|

|




















|


|
|

|



















|


|
|
|
|

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

|
|
>
|
|

|

>
|
<








<
<
<
<

|

>
|

|

>
|








|
|
<
<
<


|
|

|
|

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


















|
>

<

>














|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37


38


39

40
41
42
43
44
45
46






47



48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81







82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103







104
105

106
107

108
109
110
111
112
113
114
115
116
117
118
119

120
121


122



123
124

125
126
127
128
129
130
131



132

133
134
135
136


137
138
139
140





141
142
143
144
145



146
147




148

149

150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179

180
181




182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205

206

207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230

231
232
233
234
235

236


237
238
239
240
241
242

243

244
245
246
247
248
249
250
251
252
253
254
255

256
257
258
259
260
261




262


263
264

265

266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293


294






295










296
297
298
299
300
301
302
303

304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330

331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367



368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494

495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616

617
618
619
620
621
622
623
624




625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644



645
646
647
648
649
650
651
652
653
654
655
656








657

658


659



660





661


662



663


664
665


666
667
668
















669



670


671
672
673


674
675



676
677
678
679
680




681
682
683
684



685


686








687



688



689
690





691
692



693


694
695
696

697
698
699
700
701
702
703




704

705




706
707



708


709
710

711

712
713
714

715
716





717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737

738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761

/*
 * tkWinDialog.c --
 *
 *	Contains the Windows implementation of the common dialog boxes.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinDialog.c,v 1.1.4.4 1998/12/13 09:54:45 lfb Exp $
 *
 */

#include "tkWinInt.h"
#include "tkFileFilter.h"

#include <commdlg.h>    /* includes common dialog functionality */
#include <dlgs.h>       /* includes common dialog template defines */
#include <cderr.h>      /* includes the common dialog error codes */

typedef struct ThreadSpecificData { 
    int debugFlag;            /* Flags whether we should output debugging 
			       * information while displaying a builtin 
			       * dialog. */
    Tcl_Interp *debugInterp;  /* Interpreter to used for debugging. */
    UINT WM_LBSELCHANGED;     /* Holds a registered windows event used for
			       * communicating between the Directory
			       * Chooser dialog and its hook proc. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * The following structures are used by Tk_MessageBox() to parse 
 * arguments and return results.
 */





static const TkStateMap iconMap[] = {

    {MB_ICONERROR,		"error"},
    {MB_ICONINFORMATION,	"info"},
    {MB_ICONQUESTION,		"question"},
    {MB_ICONWARNING,		"warning"},
    {-1,			NULL}
};
	  






static const TkStateMap typeMap[] = {



    {MB_ABORTRETRYIGNORE,	"abortretryignore"},
    {MB_OK, 			"ok"},
    {MB_OKCANCEL,		"okcancel"},
    {MB_RETRYCANCEL,		"retrycancel"},
    {MB_YESNO,			"yesno"},
    {MB_YESNOCANCEL,		"yesnocancel"},
    {-1,			NULL}
};

static const TkStateMap buttonMap[] = {
    {IDABORT,			"abort"},
    {IDRETRY,			"retry"},
    {IDIGNORE,			"ignore"},
    {IDOK,			"ok"},
    {IDCANCEL,			"cancel"},
    {IDNO,			"no"},
    {IDYES,			"yes"},
    {-1,			NULL}
};

static const int buttonFlagMap[] = {
    MB_DEFBUTTON1, MB_DEFBUTTON2, MB_DEFBUTTON3, MB_DEFBUTTON4
};

static const struct {int type; int btnIds[3];} allowedTypes[] = {
    {MB_ABORTRETRYIGNORE,	{IDABORT, IDRETRY,  IDIGNORE}},
    {MB_OK, 			{IDOK,    -1,       -1      }},
    {MB_OKCANCEL,		{IDOK,    IDCANCEL, -1      }},
    {MB_RETRYCANCEL,		{IDRETRY, IDCANCEL, -1      }},
    {MB_YESNO,			{IDYES,   IDNO,     -1      }},
    {MB_YESNOCANCEL,		{IDYES,   IDNO,     IDCANCEL}}
};

#define NUM_TYPES (sizeof(allowedTypes) / sizeof(allowedTypes[0]))








/*
 * The following structure is used to pass information between the directory
 * chooser procedure, Tk_ChooseDirectoryObjCmd(), and its dialog hook proc.
 */

typedef struct ChooseDir {
    Tcl_Interp *interp;		/* Interp, used only if debug is turned on, 
				 * for setting the "tk_dialog" variable. */
    int lastCtrl;		/* Used by hook proc to keep track of last
				 * control that had input focus, so when OK
				 * is pressed we know whether to browse a
				 * new directory or return. */
    int lastIdx;		/* Last item that was selected in directory 
				 * browser listbox. */
    TCHAR path[MAX_PATH];	/* On return from choose directory dialog, 
				 * holds the selected path.  Cannot return 
				 * selected path in ofnPtr->lpstrFile because
				 * the default dialog proc stores a '\0' in 
				 * it, since, of course, no _file_ was 
				 * selected. */
} ChooseDir;








/*

 * Definitions of procedures used only in this file.
 */


static UINT APIENTRY	ChooseDirectoryHookProc(HWND hdlg, UINT uMsg, 
			    WPARAM wParam, LPARAM lParam);
static UINT CALLBACK	ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam,
			    LPARAM lParam);
static int 		GetFileName(ClientData clientData, 
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[], int isOpen);
static int 		MakeFilter(Tcl_Interp *interp, char *string, 
			    Tcl_DString *dsPtr);
static UINT APIENTRY	OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam, 
			    LPARAM lParam);

static void		SetTkDialog(ClientData clientData);
static int		TrySetDirectory(HWND hwnd, const TCHAR *dir);






/*
 *-------------------------------------------------------------------------

 *
 * TkWinDialogDebug --
 *
 *	Function to turn on/off debugging support for common dialogs under
 *	windows.  The variable "tk_debug" is set to the identifier of the
 *	dialog window when the modal dialog window pops up and it is safe to 
 *	send messages to the dialog.



 *

 * Results:
 *	None.
 *
 * Side effects:


 *	This variable only makes sense if just one dialog is up at a time.
 *
 *-------------------------------------------------------------------------
 */






void	    	
TkWinDialogDebug(
    int debug)
{



    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));






    tsdPtr->debugFlag = debug;

}

/*
 *-------------------------------------------------------------------------
 *
 * Tk_ChooseColorObjCmd --
 *
 *	This procedure implements the color dialog box for the Windows
 *	platform. See the user documentation for details on what it
 *	does.
 *
 * Results:
 *	See user documentation.
 *
 * Side effects:
 *	A dialog window is created the first time this procedure is called.
 *	This window is not destroyed and will be reused the next time the
 *	application invokes the "tk_chooseColor" command.
 *
 *-------------------------------------------------------------------------
 */

int
Tk_ChooseColorObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window associated with interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    Tk_Window tkwin, parent;

    int i, oldMode, winCode;
    CHOOSECOLOR chooseColor;




    static inited = 0;
    static COLORREF dwCustColors[16];
    static long oldColor;		/* the color selected last time */
    static char *optionStrings[] = {
	"-initialcolor",    "-parent",	    "-title",	    NULL
    };
    enum options {
	COLOR_INITIAL,	    COLOR_PARENT,   COLOR_TITLE
    };

    if (inited == 0) {
	/*
	 * dwCustColors stores the custom color which the user can
	 * modify. We store these colors in a static array so that the next
	 * time the color dialog pops up, the same set of custom colors
	 * remain in the dialog.
	 */
	for (i = 0; i < 16; i++) {
	    dwCustColors[i] = RGB(255-i * 10, i, i * 10);
	}
	oldColor = RGB(0xa0, 0xa0, 0xa0);
	inited = 1;
    }


    tkwin = (Tk_Window) clientData;


    parent			= tkwin;
    chooseColor.lStructSize	= sizeof(CHOOSECOLOR) ;
    chooseColor.hwndOwner	= 0;			
    chooseColor.hInstance	= 0;
    chooseColor.rgbResult	= oldColor;
    chooseColor.lpCustColors	= dwCustColors ;
    chooseColor.Flags		= CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK;
    chooseColor.lCustData	= (LPARAM) NULL;
    chooseColor.lpfnHook	= ColorDlgHookProc;
    chooseColor.lpTemplateName	= (LPTSTR) interp;

    for (i = 1; i < objc; i += 2) {
	int index;
	char *string;
	Tcl_Obj *optionPtr, *valuePtr;

	optionPtr = objv[i];
	valuePtr = objv[i + 1];

	if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}

	if (i + 1 == objc) {
	    string = Tcl_GetStringFromObj(optionPtr, NULL);
	    Tcl_AppendResult(interp, "value for \"", string, "\" missing", 
		    (char *) NULL);
	    return TCL_ERROR;

	}



	string = Tcl_GetStringFromObj(valuePtr, NULL);
	switch ((enum options) index) {
	    case COLOR_INITIAL: {
		XColor *colorPtr;


		colorPtr = Tk_GetColor(interp, tkwin, string);

		if (colorPtr == NULL) {
		    return TCL_ERROR;
		}
		chooseColor.rgbResult = RGB(colorPtr->red / 0x100, 
			colorPtr->green / 0x100, colorPtr->blue / 0x100);
		break;
	    }
	    case COLOR_PARENT: {
		parent = Tk_NameToWindow(interp, string, tkwin);
		if (parent == NULL) {
		    return TCL_ERROR;
		}

		break;
	    }
	    case COLOR_TITLE: {
		chooseColor.lCustData = (LPARAM) string;
		break;
	    }




	}


    }


    Tk_MakeWindowExist(parent);

    chooseColor.hwndOwner = Tk_GetHWND(Tk_WindowId(parent));

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
    winCode = ChooseColor(&chooseColor);
    (void) Tcl_SetServiceMode(oldMode);

    /*
     * Clear the interp result since anything may have happened during the
     * modal loop.
     */

    Tcl_ResetResult(interp);

    /*
     * 3. Process the result of the dialog
     */

    if (winCode) {
	/*
	 * User has selected a color
	 */
	char result[100];

	sprintf(result, "#%02x%02x%02x",
	GetRValue(chooseColor.rgbResult), 
	        GetGValue(chooseColor.rgbResult), 
		GetBValue(chooseColor.rgbResult));
        Tcl_AppendResult(interp, result, NULL);


	oldColor = chooseColor.rgbResult;






    }










    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ColorDlgHookProc --
 *

 *	Provides special handling of messages for the Color common dialog
 *	box.  Used to set the title when the dialog first appears.
 *
 * Results:
 *	The return value is 0 if the default dialog box procedure should
 *	handle the message, non-zero otherwise. 
 *
 * Side effects:
 *	Changes the title of the dialog window.
 *
 *----------------------------------------------------------------------
 */

static UINT CALLBACK 
ColorDlgHookProc(hDlg, uMsg, wParam, lParam)
    HWND hDlg;			/* Handle to the color dialog. */
    UINT uMsg;			/* Type of message. */
    WPARAM wParam;		/* First message parameter. */
    LPARAM lParam;		/* Second message parameter. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    switch (uMsg) {
	case WM_INITDIALOG: {
	    const char *title;
	    CHOOSECOLOR *ccPtr;

	    Tcl_DString ds;

	    /* 
	     * Set the title string of the dialog.
	     */

	    ccPtr = (CHOOSECOLOR *) lParam;
	    title = (const char *) ccPtr->lCustData;
	    if ((title != NULL) && (title[0] != '\0')) {
		Tcl_UtfToExternalDString(NULL, title, -1, &ds);
		SetWindowText(hDlg, (TCHAR *) Tcl_DStringValue(&ds));
		Tcl_DStringFree(&ds);
	    }
	    if (tsdPtr->debugFlag) {
		tsdPtr->debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName;
		Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg);
	    }
	    return TRUE;
	}
    }
    return FALSE;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetOpenFileCmd --
 *
 *	This procedure implements the "open file" dialog box for the
 *	Windows platform. See the user documentation for details on what
 *	it does.
 *
 * Results:
 *	See user documentation.
 *
 * Side effects:
 *	A dialog window is created the first this procedure is called.



 *
 *----------------------------------------------------------------------
 */

int
Tk_GetOpenFileObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window associated with interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    return GetFileName(clientData, interp, objc, objv, 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetSaveFileCmd --
 *
 *	Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
 *	instead
 *
 * Results:
 *	Same as Tk_GetOpenFileCmd.
 *
 * Side effects:
 *	Same as Tk_GetOpenFileCmd.
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetSaveFileObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window associated with interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    return GetFileName(clientData, interp, objc, objv, 0);
}

/*
 *----------------------------------------------------------------------
 *
 * GetFileName --
 *
 *	Calls GetOpenFileName() or GetSaveFileName().
 *
 * Results:
 *	See user documentation.
 *
 * Side effects:
 *	See user documentation.
 *
 *----------------------------------------------------------------------
 */

static int 
GetFileName(clientData, interp, objc, objv, open)
    ClientData clientData;	/* Main window associated with interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
    int open;			/* 1 to call GetOpenFileName(), 0 to 
				 * call GetSaveFileName(). */
{
    OPENFILENAME ofn;
    TCHAR file[MAX_PATH], savePath[MAX_PATH];
    int result, winCode, oldMode, i;
    char *extension, *filter, *title;
    Tk_Window tkwin;
    Tcl_DString utfFilterString, utfDirString;
    Tcl_DString extString, filterString, dirString, titleString;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    static char *optionStrings[] = {
	"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
	"-parent",	"-title",	NULL
    };
    enum options {
	FILE_DEFAULT,	FILE_TYPES,	FILE_INITDIR,	FILE_INITFILE,
	FILE_PARENT,	FILE_TITLE
    };

    result = TCL_ERROR;
    file[0] = '\0';

    /*
     * Parse the arguments.
     */

    extension = NULL;
    filter = NULL;
    Tcl_DStringInit(&utfFilterString);
    Tcl_DStringInit(&utfDirString);
    tkwin = (Tk_Window) clientData;
    title = NULL;

    for (i = 1; i < objc; i += 2) {
	int index;
	char *string;
	Tcl_Obj *optionPtr, *valuePtr;

	optionPtr = objv[i];
	valuePtr = objv[i + 1];

	if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option", 
		0, &index) != TCL_OK) {
	    goto end;
	}
	if (i + 1 == objc) {
	    string = Tcl_GetStringFromObj(optionPtr, NULL);
	    Tcl_AppendResult(interp, "value for \"", string, "\" missing", 
		    (char *) NULL);
	    goto end;
	}

	string = Tcl_GetStringFromObj(valuePtr, NULL);
	switch ((enum options) index) {
	    case FILE_DEFAULT: {
		if (string[0] == '.') {
		    string++;
		}
		extension = string;
		break;
	    }
	    case FILE_TYPES: {

		Tcl_DStringFree(&utfFilterString);
		if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) {
		    goto end;
		}
		filter = Tcl_DStringValue(&utfFilterString);
		break;
	    }
	    case FILE_INITDIR: {
		Tcl_DStringFree(&utfDirString);
		if (Tcl_TranslateFileName(interp, string, 
			&utfDirString) == NULL) {
		    goto end;
		}
		break;
	    }
	    case FILE_INITFILE: {
		Tcl_DString ds;

		if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
		    goto end;
		}
		Tcl_UtfToExternal(NULL, NULL, Tcl_DStringValue(&ds), 
			Tcl_DStringLength(&ds), 0, NULL, (char *) file, 
			sizeof(file), NULL, NULL, NULL);
		break;
	    }
	    case FILE_PARENT: {
		tkwin = Tk_NameToWindow(interp, string, tkwin);
		if (tkwin == NULL) {
		    goto end;
		}
		break;
	    }
	    case FILE_TITLE: {
		title = string;
		break;
	    }
	}
    }

    if (filter == NULL) {
	if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) {
	    goto end;
	}
    }

    Tk_MakeWindowExist(tkwin);

    ofn.lStructSize		= sizeof(ofn);
    ofn.hwndOwner		= Tk_GetHWND(Tk_WindowId(tkwin));
    ofn.hInstance		= (HINSTANCE) GetWindowLong(ofn.hwndOwner, 
					GWL_HINSTANCE);
    ofn.lpstrFilter		= NULL;
    ofn.lpstrCustomFilter	= NULL;
    ofn.nMaxCustFilter		= 0;
    ofn.nFilterIndex		= 0;
    ofn.lpstrFile		= (LPTSTR) file;
    ofn.nMaxFile		= MAX_PATH;
    ofn.lpstrFileTitle		= NULL;
    ofn.nMaxFileTitle		= 0;
    ofn.lpstrInitialDir		= NULL;
    ofn.lpstrTitle		= NULL;
    ofn.Flags			= OFN_HIDEREADONLY | OFN_PATHMUSTEXIST 
				  | OFN_NOCHANGEDIR;
    ofn.nFileOffset		= 0;
    ofn.nFileExtension		= 0;
    ofn.lpstrDefExt		= NULL;
    ofn.lpfnHook		= OFNHookProc;
    ofn.lCustData		= (LPARAM) interp;
    ofn.lpTemplateName		= NULL;

    if (LOBYTE(LOWORD(GetVersion())) >= 4) {
	/*
	 * Use the "explorer" style file selection box on platforms that
	 * support it (Win95 and NT4.0 both have a major version number
	 * of 4).
	 */

	ofn.Flags |= OFN_EXPLORER;
    }

    if (open != 0) {
	ofn.Flags |= OFN_FILEMUSTEXIST;
    } else {
	ofn.Flags |= OFN_OVERWRITEPROMPT;
    }

    if (tsdPtr->debugFlag != 0) {
	ofn.Flags |= OFN_ENABLEHOOK;
    }

    if (extension != NULL) {
	Tcl_UtfToExternalDString(NULL, extension, -1, &extString);
	ofn.lpstrDefExt = (LPTSTR) Tcl_DStringValue(&extString);
    }
    Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfFilterString),
	    Tcl_DStringLength(&utfFilterString), &filterString);
    ofn.lpstrFilter = (LPTSTR) Tcl_DStringValue(&filterString);

    if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
	Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString),
		Tcl_DStringLength(&utfDirString), &dirString);
        ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString);
    }
    if (title != NULL) {
	Tcl_UtfToExternalDString(NULL, title, -1, &titleString);
	ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString);
    }

    /*
     * Popup the dialog.  
     */

    GetCurrentDirectory(MAX_PATH, savePath);
    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
    if (open != 0) {
	winCode = GetOpenFileName(&ofn);
    } else {
	winCode = GetSaveFileName(&ofn);
    }
    Tcl_SetServiceMode(oldMode);
    SetCurrentDirectory(savePath);


    /*
     * Clear the interp result since anything may have happened during the
     * modal loop.
     */

    Tcl_ResetResult(interp);





    /*
     * Process the results.
     */

    if (winCode != 0) {
	char *p;
	Tcl_DString ds;

	Tcl_ExternalToUtfDString(NULL, (char *) ofn.lpstrFile, -1, &ds);
	for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
	    /*
	     * Change the pathname to the Tcl "normalized" pathname, where
	     * back slashes are used instead of forward slashes
	     */
	    if (*p == '\\') {
		*p = '/';
	    }
	}
	Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
	Tcl_DStringFree(&ds);



    }

    if (ofn.lpstrTitle != NULL) {
	Tcl_DStringFree(&titleString);
    }
    if (ofn.lpstrInitialDir != NULL) {
	Tcl_DStringFree(&dirString);
    }
    Tcl_DStringFree(&filterString);
    if (ofn.lpstrDefExt != NULL) {
	Tcl_DStringFree(&extString);
    }








    result = TCL_OK;




    end:



    Tcl_DStringFree(&utfDirString);





    Tcl_DStringFree(&utfFilterString);






    return result;


}



/*
 *-------------------------------------------------------------------------
 *
















 * OFNHookProc --



 *


 *	Hook procedure called only if debugging is turned on.  Sets
 *	the "tk_dialog" variable when the dialog is ready to receive
 *	messages.


 *
 * Results:



 *	Returns 0 to allow default processing of messages to occur.
 *
 * Side effects:
 *	None.
 *




 *-------------------------------------------------------------------------
 */

static UINT APIENTRY 



OFNHookProc(


    HWND hdlg,		// handle to child dialog window








    UINT uMsg,		// message identifier



    WPARAM wParam,	// message parameter



    LPARAM lParam) 	// message parameter
{





    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));



    OPENFILENAME *ofnPtr;



    if (uMsg == WM_INITDIALOG) {
	SetWindowLong(hdlg, GWL_USERDATA, lParam);

    } else if (uMsg == WM_WINDOWPOSCHANGED) {
	/*
	 * This message is delivered at the right time to both 
	 * old-style and explorer-style hook procs to enable Tk
	 * to set the debug information.  Unhooks itself so it 
	 * won't set the debug information every time it gets a 
	 * WM_WINDOWPOSCHANGED message.




	 */






        ofnPtr = (OPENFILENAME *) GetWindowLong(hdlg, GWL_USERDATA);
	if (ofnPtr != NULL) {



	    if (ofnPtr->Flags & OFN_EXPLORER) {


		hdlg = GetParent(hdlg);
	    }

	    tsdPtr->debugInterp = (Tcl_Interp *) ofnPtr->lCustData;

	    Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg);
	    SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL);
	}

    }
    return 0;





}

/*
 *----------------------------------------------------------------------
 *
 * MakeFilter --
 *
 *	Allocate a buffer to store the filters in a format understood by
 *	Windows
 *
 * Results:
 *	A standard TCL return value.
 *
 * Side effects:
 *	ofnPtr->lpstrFilter is modified.
 *
 *----------------------------------------------------------------------
 */
static int 
MakeFilter(interp, string, dsPtr) 
    Tcl_Interp *interp;		/* Current interpreter. */

    char *string;		/* String value of the -filetypes option */
    Tcl_DString *dsPtr;		/* Filled with windows filter string. */
{
    char *filterStr;
    char *p;
    int pass;
    FileFilterList flist;
    FileFilter *filterPtr;

    TkInitFileFilters(&flist);
    if (TkGetFileFilters(interp, &flist, string, 1) != TCL_OK) {
	return TCL_ERROR;
    }

    if (flist.filters == NULL) {
	/*
	 * Use "All Files (*.*) as the default filter if none is specified
	 */
	char *defaultFilter = "All Files (*.*)";

	p = filterStr = (char*)ckalloc(30 * sizeof(char));

	strcpy(p, defaultFilter);
	p+= strlen(defaultFilter);
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804




























































































































































































































































































































































































































805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835

836
837
838
839
840
841
842

843



844
845
846

847
848
849
850

851
852
853
854
855

856
857

858
859
860
861
862


863
864
865


866
867
868
869
870
871
872
873
874
875
876
877
878
879

880
881
882

883
884

885

886
887

888
889
890

891


892

893
894
895
896
897
898
899
900
901
902
903
904



905
906

907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922

923



924
925

926

927
928
929
930
931
932
933

934
935
936
937
938
939

940
941
942
943
944
945
946
947
948
949


950
951
952
953

954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042


1043


1044
1045
1046

1047

1048
1049
1050
	 * Windows requires the filter string to be ended by two NULL
	 * characters.
	 */
	*p++ = '\0';
	*p = '\0';
    }

    if (ofnPtr->lpstrFilter != NULL) {
	ckfree((char*)ofnPtr->lpstrFilter);
    }
    ofnPtr->lpstrFilter = filterStr;

    TkFreeFileFilters(&flist);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *




























































































































































































































































































































































































































 * Tk_MessageBoxCmd --
 *
 *	This procedure implements the MessageBox window for the
 *	Windows platform. See the user documentation for details on what
 *	it does.
 *
 * Results:
 *	See user documentation.
 *
 * Side effects:
 *	None. The MessageBox window will be destroy before this procedure
 *	returns.
 *
 *----------------------------------------------------------------------
 */

int
Tk_MessageBoxCmd(clientData, interp, argc, argv)
    ClientData clientData;	/* Main window associated with interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    int flags;
    Tk_Window parent = Tk_MainWindow(interp);
    HWND hWnd;
    char *message = "";
    char *title = "";
    int icon = MB_ICONINFORMATION;
    int type = MB_OK;
    int i, j;

    char *result;
    int code, oldMode;
    char *defaultBtn = NULL;
    int defaultBtnIdx = -1;

    for (i=1; i<argc; i+=2) {
	int v = i+1;

	int len = strlen(argv[i]);




	if (strncmp(argv[i], "-default", len)==0) {
	    if (v==argc) {goto arg_missing;}


	    defaultBtn = argv[v];
	}
	else if (strncmp(argv[i], "-icon", len)==0) {

	    if (v==argc) {goto arg_missing;}

	    if (strcmp(argv[v], "error") == 0) {
		icon = MB_ICONERROR;
	    }

	    else if (strcmp(argv[v], "info") == 0) {
		icon = MB_ICONINFORMATION;

	    }
	    else if (strcmp(argv[v], "question") == 0) {
		icon = MB_ICONQUESTION;
	    }
	    else if (strcmp(argv[v], "warning") == 0) {


		icon = MB_ICONWARNING;
	    }
	    else {


	        Tcl_AppendResult(interp, "invalid icon \"", argv[v],
		    "\", must be error, info, question or warning", NULL);
		return TCL_ERROR;
	    }
	}
	else if (strncmp(argv[i], "-message", len)==0) {
	    if (v==argc) {goto arg_missing;}

	    message = argv[v];
	}
	else if (strncmp(argv[i], "-parent", len)==0) {
	    if (v==argc) {goto arg_missing;}

	    parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));

	    if (parent == NULL) {
		return TCL_ERROR;
	    }

	}
	else if (strncmp(argv[i], "-title", len)==0) {

	    if (v==argc) {goto arg_missing;}


	    title = argv[v];

	}
	else if (strncmp(argv[i], "-type", len)==0) {
	    int found = 0;




	    if (v==argc) {goto arg_missing;}


	    for (j=0; j<NUM_TYPES; j++) {
		if (strcmp(argv[v], msgTypeInfo[j].name) == 0) {
		    type = msgTypeInfo[j].type;
		    found = 1;
		    break;
		}
	    }
	    if (!found) {
		Tcl_AppendResult(interp, "invalid message box type \"", 
		    argv[v], "\", must be abortretryignore, ok, ",
		    "okcancel, retrycancel, yesno or yesnocancel", NULL);



		return TCL_ERROR;
	    }

	}
	else {
    	    Tcl_AppendResult(interp, "unknown option \"", 
		argv[i], "\", must be -default, -icon, ",
		"-message, -parent, -title or -type", NULL);
		return TCL_ERROR;
	}
    }

    /* Make sure we have a valid hWnd to act as the parent of this message box
     */
    if (Tk_WindowId(parent) == None) {
	Tk_MakeWindowExist(parent);
    }
    hWnd = Tk_GetHWND(Tk_WindowId(parent));


    if (defaultBtn != NULL) {



	for (i=0; i<NUM_TYPES; i++) {
	    if (type == msgTypeInfo[i].type) {

		for (j=0; j<msgTypeInfo[i].numButtons; j++) {

		    if (strcmp(defaultBtn, msgTypeInfo[i].btnNames[j])==0) {
		        defaultBtnIdx = j;
			break;
		    }
		}
		if (defaultBtnIdx < 0) {
		    Tcl_AppendResult(interp, "invalid default button \"",

			defaultBtn, "\"", NULL);
		    return TCL_ERROR;
		}
		break;
	    }
	}


	switch (defaultBtnIdx) {
	  case 0: flags = MB_DEFBUTTON1; break;
	  case 1: flags = MB_DEFBUTTON2; break;
	  case 2: flags = MB_DEFBUTTON3; break;
	  case 3: flags = MB_DEFBUTTON4; break;
	}
    } else {
	flags = 0;
    }


    
    flags |= icon | type;
    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
    code = MessageBox(hWnd, message, title, flags|MB_SYSTEMMODAL);

    (void) Tcl_SetServiceMode(oldMode);

    switch (code) {
      case IDABORT:	result = "abort";  break;
      case IDCANCEL:	result = "cancel"; break;
      case IDIGNORE:	result = "ignore"; break;
      case IDNO:	result = "no";     break;
      case IDOK:	result = "ok";     break;
      case IDRETRY:	result = "retry";  break;
      case IDYES:	result = "yes";    break;
      default:		result = "";
    }

    /*
     * When we come to here interp->result may have been changed by some
     * background scripts. Call Tcl_SetResult() to make sure that any stuff
     * lingering in interp->result will not appear in the result of
     * this command.
     */

    Tcl_SetResult(interp, result, TCL_STATIC);
    return TCL_OK;

  arg_missing:
    Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
	NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ProcessCDError --
 *
 *	This procedure gets called if a Windows-specific error message
 *	has occurred during the execution of a common dialog or the
 *	user has pressed the CANCEL button.
 *
 * Results:
 *	If an error has indeed happened, returns a standard TCL result
 *	that reports the error code in string format. If the user has
 *	pressed the CANCEL button (dwErrorCode == 0), resets
 *	interp->result to the empty string.
 *
 * Side effects:
 *	interp->result is changed.
 *
 *----------------------------------------------------------------------
 */
static int ProcessCDError(interp, dwErrorCode, hWnd)
    Tcl_Interp * interp;		/* Current interpreter. */
    DWORD dwErrorCode;			/* The Windows-specific error code */
    HWND hWnd;				/* window in which the error happened*/
{
    char *string;

    Tcl_ResetResult(interp);

    switch(dwErrorCode) {
      case 0:	  /* User has hit CANCEL */
	return TCL_OK;

      case CDERR_DIALOGFAILURE:   string="CDERR_DIALOGFAILURE";  	break;
      case CDERR_STRUCTSIZE:      string="CDERR_STRUCTSIZE";   		break;
      case CDERR_INITIALIZATION:  string="CDERR_INITIALIZATION";   	break;
      case CDERR_NOTEMPLATE:      string="CDERR_NOTEMPLATE";   		break;
      case CDERR_NOHINSTANCE:     string="CDERR_NOHINSTANCE";   	break;
      case CDERR_LOADSTRFAILURE:  string="CDERR_LOADSTRFAILURE";   	break;
      case CDERR_FINDRESFAILURE:  string="CDERR_FINDRESFAILURE";   	break;
      case CDERR_LOADRESFAILURE:  string="CDERR_LOADRESFAILURE";   	break;
      case CDERR_LOCKRESFAILURE:  string="CDERR_LOCKRESFAILURE";   	break;
      case CDERR_MEMALLOCFAILURE: string="CDERR_MEMALLOCFAILURE";   	break;
      case CDERR_MEMLOCKFAILURE:  string="CDERR_MEMLOCKFAILURE";   	break;
      case CDERR_NOHOOK:          string="CDERR_NOHOOK";   	 	break;
      case PDERR_SETUPFAILURE:    string="PDERR_SETUPFAILURE";   	break;
      case PDERR_PARSEFAILURE:    string="PDERR_PARSEFAILURE";   	break;
      case PDERR_RETDEFFAILURE:   string="PDERR_RETDEFFAILURE";   	break;
      case PDERR_LOADDRVFAILURE:  string="PDERR_LOADDRVFAILURE";   	break;
      case PDERR_GETDEVMODEFAIL:  string="PDERR_GETDEVMODEFAIL";   	break;
      case PDERR_INITFAILURE:     string="PDERR_INITFAILURE";   	break;
      case PDERR_NODEVICES:       string="PDERR_NODEVICES";   		break;
      case PDERR_NODEFAULTPRN:    string="PDERR_NODEFAULTPRN";   	break;
      case PDERR_DNDMMISMATCH:    string="PDERR_DNDMMISMATCH";   	break;
      case PDERR_CREATEICFAILURE: string="PDERR_CREATEICFAILURE";   	break;
      case PDERR_PRINTERNOTFOUND: string="PDERR_PRINTERNOTFOUND";   	break;
      case CFERR_NOFONTS:         string="CFERR_NOFONTS";   	 	break;
      case FNERR_SUBCLASSFAILURE: string="FNERR_SUBCLASSFAILURE";   	break;
      case FNERR_INVALIDFILENAME: string="FNERR_INVALIDFILENAME";   	break;
      case FNERR_BUFFERTOOSMALL:  string="FNERR_BUFFERTOOSMALL";   	break;


	


      default:
	string="unknown error";
    }



    Tcl_AppendResult(interp, "Win32 internal error: ", string, NULL); 
    return TCL_ERROR;
}







|
|
<
<








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
















|


|
|

<
|

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

<
<
>

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


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

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


>
|
<
<
<
<
<



<
<
<
|
<


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





>
|





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

|
>


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

>
|
<

835
836
837
838
839
840
841
842
843


844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286

1287
1288
1289


1290
1291
1292
1293

1294

1295


1296
1297
1298
1299
1300
1301


1302
1303
1304

1305
1306
1307
1308

1309
1310
1311
1312
1313
1314
1315
1316
1317
1318

1319
1320
1321
1322

1323
1324
1325
1326
1327
1328





1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344

1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355




1356

1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368





1369
1370
1371



1372

1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400





1401

1402
1403
1404
1405
1406

1407
1408
1409
1410
1411










1412






1413























1414











1415




1416
1417
1418


























1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430

1431
	 * Windows requires the filter string to be ended by two NULL
	 * characters.
	 */
	*p++ = '\0';
	*p = '\0';
    }

    Tcl_DStringAppend(dsPtr, filterStr, p - filterStr);
    ckfree((char *) filterStr);



    TkFreeFileFilters(&flist);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_ChooseDirectoryObjCmd --
 *
 *	This procedure implements the "tk_chooseDirectory" dialog box 
 *	for the Windows platform. See the user documentation for details 
 *	on what it does.
 *
 * Results:
 *	See user documentation.
 *
 * Side effects:
 *	A modal dialog window is created.  Tcl_SetServiceMode() is
 *	called to allow background events to be processed
 *
 *----------------------------------------------------------------------
 */

int
Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window associated with interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    OPENFILENAME ofn;
    TCHAR path[MAX_PATH], savePath[MAX_PATH];
    ChooseDir cd;
    int result, mustExist, code, mode, i;
    Tk_Window tkwin;
    char *utfTitle;
    Tcl_DString utfDirString;
    Tcl_DString titleString, dirString;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    static char *optionStrings[] = {
	"-initialdir",	"-mustexist",	"-parent",	"-title",
	NULL
    };
    enum options {
	DIR_INITIAL,	DIR_EXIST,	DIR_PARENT,	FILE_TITLE
    };

    if (tsdPtr->WM_LBSELCHANGED == 0) {
        tsdPtr->WM_LBSELCHANGED = RegisterWindowMessage(LBSELCHSTRING);
    }
   
    result = TCL_ERROR;
    path[0] = '\0';

    Tcl_DStringInit(&utfDirString);
    mustExist = 0;
    tkwin = (Tk_Window) clientData;
    utfTitle = NULL;

    for (i = 1; i < objc; i += 2) {
	int index;
	char *string;
	Tcl_Obj *optionPtr, *valuePtr;

	optionPtr = objv[i];
	valuePtr = objv[i + 1];

	if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
		0, &index) != TCL_OK) {
	    goto cleanup;
	}
	if (i + 1 == objc) {
	    string = Tcl_GetStringFromObj(optionPtr, NULL);
	    Tcl_AppendResult(interp, "value for \"", string, "\" missing", 
		    (char *) NULL);
	    goto cleanup;
	}

	string = Tcl_GetStringFromObj(valuePtr, NULL);
	switch ((enum options) index) {
	    case DIR_INITIAL: {
		Tcl_DStringFree(&utfDirString);
		if (Tcl_TranslateFileName(interp, string, 
			&utfDirString) == NULL) {
		    goto cleanup;
		}
		break;
	    }
	    case DIR_EXIST: {
		if (Tcl_GetBooleanFromObj(interp, valuePtr, &mustExist) != TCL_OK) {
		    goto cleanup;
		}
		break;
	    }
	    case DIR_PARENT: {
		tkwin = Tk_NameToWindow(interp, string, tkwin);
		if (tkwin == NULL) {
		    goto cleanup;
		}
		break;
	    }
	    case FILE_TITLE: {
		utfTitle = string;
		break;
	    }
	}
    }

    Tk_MakeWindowExist(tkwin);

    cd.interp = interp;

    ofn.lStructSize		= sizeof(ofn);
    ofn.hwndOwner		= Tk_GetHWND(Tk_WindowId(tkwin));
    ofn.hInstance		= (HINSTANCE) GetWindowLong(ofn.hwndOwner, 
					GWL_HINSTANCE);
    ofn.lpstrFilter		= NULL;
    ofn.lpstrCustomFilter	= NULL;
    ofn.nMaxCustFilter		= 0;
    ofn.nFilterIndex		= 0;
    ofn.lpstrFile		= NULL; //(TCHAR *) path;
    ofn.nMaxFile		= MAX_PATH;
    ofn.lpstrFileTitle		= NULL;
    ofn.nMaxFileTitle		= 0;
    ofn.lpstrInitialDir		= NULL;
    ofn.lpstrTitle		= NULL;
    ofn.Flags			= OFN_HIDEREADONLY  
				  | OFN_ENABLEHOOK | OFN_ENABLETEMPLATE;
    ofn.nFileOffset		= 0;
    ofn.nFileExtension		= 0;
    ofn.lpstrDefExt		= NULL;
    ofn.lCustData		= (LPARAM) &cd;
    ofn.lpfnHook		= ChooseDirectoryHookProc;
    ofn.lpTemplateName		= MAKEINTRESOURCE(FILEOPENORD);

    if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
	Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString), 
		Tcl_DStringLength(&utfDirString), &dirString);
	ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString);
    }
    if (mustExist) {
	ofn.Flags |= OFN_PATHMUSTEXIST;
    }
    if (utfTitle != NULL) {
	Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString);
	ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString);
    }

    /*
     * Display dialog.  The choose directory dialog doesn't preserve the
     * current directory, so it must be saved and restored here.
     */
    
    GetCurrentDirectory(MAX_PATH, savePath);
    mode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
    code = GetOpenFileName(&ofn);
    Tcl_SetServiceMode(mode);
    SetCurrentDirectory(savePath);

    Tcl_ResetResult(interp);
    if (code != 0) {
	/*
	 * Change the pathname to the Tcl "normalized" pathname, where
	 * back slashes are used instead of forward slashes
	 */

	char *p;
	Tcl_DString ds;

	Tcl_ExternalToUtfDString(NULL, (char *) cd.path, -1, &ds);
	for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
	    if (*p == '\\') {
		*p = '/';
	    }
	}
	Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
	Tcl_DStringFree(&ds);
    }

    if (ofn.lpstrTitle != NULL) {
	Tcl_DStringFree(&titleString);
    }
    if (ofn.lpstrInitialDir != NULL) {
	Tcl_DStringFree(&dirString);
    }
    result = TCL_OK;

    cleanup:
    Tcl_DStringFree(&utfDirString);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ChooseDirectoryHookProc --
 *
 *	Hook procedure called by the ChooseDirectory dialog to modify
 *	its default behavior.  The ChooseDirectory dialog is really an
 *	OpenFile dialog with certain controls rearranged and certain
 *	behaviors changed.  For instance, typing a name in the 
 *	ChooseDirectory dialog selects a directory, rather than 
 *	selecting a file.
 *
 * Results:
 *	Returns 0 to allow default processing of message, or 1 to 
 *	tell default dialog procedure not to process the message.
 *
 * Side effects:
 *	A dialog window is created the first this procedure is called.
 *	This window is not destroyed and will be reused the next time
 *	the application invokes the "tk_getOpenFile" or
 *	"tk_getSaveFile" command.
 *
 *----------------------------------------------------------------------
 */

static UINT APIENTRY 
ChooseDirectoryHookProc(
    HWND hwnd,
    UINT message,
    WPARAM wParam,
    LPARAM lParam)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    OPENFILENAME *ofnPtr;

    /*
     * GWL_USERDATA keeps track of ofnPtr.
     */
    
    ofnPtr = (OPENFILENAME *) GetWindowLong(hwnd, GWL_USERDATA);

    if (message == WM_INITDIALOG) {
        ChooseDir *cdPtr;

	SetWindowLong(hwnd, GWL_USERDATA, lParam);
	ofnPtr = (OPENFILENAME *) lParam;
	cdPtr = (ChooseDir *) ofnPtr->lCustData;
	cdPtr->lastCtrl = 0;
	cdPtr->lastIdx = 1000;
	cdPtr->path[0] = '\0';

	if (ofnPtr->lpstrInitialDir == NULL) {
	    GetCurrentDirectory(MAX_PATH, cdPtr->path);
	} else {
	    lstrcpy(cdPtr->path, ofnPtr->lpstrInitialDir);
	}
	SetDlgItemText(hwnd, edt10, cdPtr->path);
	SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
	if (tsdPtr->debugFlag) {
	    tsdPtr->debugInterp = cdPtr->interp;
	    Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd);
	}
	return 0;
    }
    if (ofnPtr == NULL) {
	return 0;
    }

    if (message == tsdPtr->WM_LBSELCHANGED) {
	/*
	 * Called when double-clicking on directory.
	 * If directory wasn't already open, browse that directory.
	 * If directory was already open, return selected directory.
	 */

        ChooseDir *cdPtr;
	int idCtrl, thisItem;

	idCtrl = (int) wParam;
        thisItem = LOWORD(lParam);
	cdPtr = (ChooseDir *) ofnPtr->lCustData;

	GetCurrentDirectory(MAX_PATH, cdPtr->path);
	if (idCtrl == lst2) {
	    if ((cdPtr->lastIdx < 0) || (cdPtr->lastIdx == thisItem)) {
		EndDialog(hwnd, IDOK);
		return 1;
	    }
	    cdPtr->lastIdx = thisItem;
	}
	SetDlgItemText(hwnd, edt10, cdPtr->path);
	SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
    } else if (message == WM_COMMAND) {
        ChooseDir *cdPtr;
	int idCtrl, notifyCode;

	idCtrl = LOWORD(wParam);
	notifyCode = HIWORD(wParam);
	cdPtr = (ChooseDir *) ofnPtr->lCustData;

	if ((idCtrl != IDOK) || (notifyCode != BN_CLICKED)) {
	    /*
	     * OK Button wasn't clicked.  Do the default.
	     */

	    if ((idCtrl == lst2) || (idCtrl == edt10)) {
		cdPtr->lastCtrl = idCtrl;
	    }
	    return 0;
	}

	/*
	 * Dialogs also get the message that OK was clicked when Enter 
	 * is pressed in some other control.  Find out what window
	 * we were really in when we got the supposed "OK", because the 
	 * behavior is different.
	 */

	if (cdPtr->lastCtrl == edt10) {
	    /*
	     * Hit Enter or clicked OK while typing a directory name in the 
	     * edit control.
	     * If it's a new name, try to go to that directory.
	     * If the name hasn't changed since last time, return selected 
	     * directory.
	     */

	    int changed;
	    TCHAR tmp[MAX_PATH];

	    if (GetDlgItemText(hwnd, edt10, tmp, MAX_PATH) == 0) {
		return 0;
	    }

	    changed = lstrcmp(cdPtr->path, tmp);
	    lstrcpy(cdPtr->path, tmp);

	    if (SetCurrentDirectory(cdPtr->path) == 0) {
		/*
		 * Non-existent directory.
		 */

		if (ofnPtr->Flags & OFN_PATHMUSTEXIST) {
		    /*
		     * Directory must exist.  Complain, then rehighlight text.
		     */

		    wsprintf(tmp, _T("Cannot change directory to \"%.200s\"."), 
			    cdPtr->path);
		    MessageBox(hwnd, tmp, NULL, MB_OK);
		    SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
		    return 0;
		} 
		if (changed) {
		    /*
		     * Directory was invalid, but we want to keep displaying
		     * this name.  Don't update the listbox that displays the 
		     * current directory heirarchy, or it'll erase the name.
		     */
		    
		    SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
		    return 0;
		}
	    }
	    if (changed == 0) {
		/*
		 * Name hasn't changed since the last time we hit return
		 * or double-clicked on a directory, so return this.
		 */

		EndDialog(hwnd, IDOK);
		return 1;
	    }
	    
	    cdPtr->lastCtrl = IDOK;

	    /*
	     * The following is the magic code, determined by running 
	     * Spy++ on some other directory chooser, that it takes to 
	     * get this dialog to update the listbox to display the 
	     * current directory.
	     */

	    SetDlgItemText(hwnd, edt1, cdPtr->path);
	    SendMessage(hwnd, WM_COMMAND, (WPARAM) MAKELONG(cmb2, 0x8003), 
		    (LPARAM) GetDlgItem(hwnd, cmb2));
	    return 0;
	} else if (idCtrl == lst2) {
	    /*
	     * Enter key was pressed while in listbox.  
	     * If it's a new directory, allow default behavior to open dir.
	     * If the directory hasn't changed, return selected directory.
	     */

	    int thisItem;

	    thisItem = (int) SendDlgItemMessage(hwnd, lst2, LB_GETCURSEL, 0, 0);
	    if (cdPtr->lastIdx == thisItem) {
		GetCurrentDirectory(MAX_PATH, cdPtr->path);
		EndDialog(hwnd, IDOK);
		return 1;
	    }
	} else if (idCtrl == IDOK) {
	    /* 
	     * The OK button was clicked.  Return the path currently specified
	     * in the listbox.  
	     *
	     * The directory has not yet been changed to the one specified in
	     * the listbox.  Returning 0 allows the default dialog proc to 
	     * change the directory to the one specified in the listbox and 
	     * then causes it to send a WM_LBSELCHANGED back to the hook proc.  
	     * When we get that message, we will record the current directory
	     * and then quit.
	     */

	    cdPtr->lastIdx = -1;
	}
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_MessageBoxObjCmd --
 *
 *	This procedure implements the MessageBox window for the
 *	Windows platform. See the user documentation for details on what
 *	it does.
 *
 * Results:
 *	See user documentation.
 *
 * Side effects:
 *	None. The MessageBox window will be destroy before this procedure
 *	returns.
 *
 *----------------------------------------------------------------------
 */

int
Tk_MessageBoxObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Main window associated with interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{

    Tk_Window tkwin, parent;
    HWND hWnd;
    char *message, *title;


    int defaultBtn, icon, type;
    int i, oldMode, flags, winCode;
    Tcl_DString messageString, titleString;
    static char *optionStrings[] = {

	"-default",	"-icon",	"-message",	"-parent",

	"-title",	"-type",	NULL


    };
    enum options {
	MSG_DEFAULT,	MSG_ICON,	MSG_MESSAGE,	MSG_PARENT,
	MSG_TITLE,	MSG_TYPE
    };



    tkwin = (Tk_Window) clientData;

    defaultBtn	= -1;

    icon	= MB_ICONINFORMATION;
    message	= NULL;
    parent	= tkwin;
    title	= NULL;

    type	= MB_OK;

    for (i = 1; i < objc; i += 2) {
	int index;
	char *string;
	Tcl_Obj *optionPtr, *valuePtr;

	optionPtr = objv[i];
	valuePtr = objv[i + 1];


	if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}

	if (i + 1 == objc) {
	    string = Tcl_GetStringFromObj(optionPtr, NULL);
	    Tcl_AppendResult(interp, "value for \"", string, "\" missing", 
		    (char *) NULL);
	    return TCL_ERROR;
	}






        string = Tcl_GetStringFromObj(valuePtr, NULL);
	switch ((enum options) index) {
        case MSG_DEFAULT:
	    defaultBtn = TkFindStateNumObj(interp, optionPtr, buttonMap, 
		    valuePtr);
	    if (defaultBtn < 0) {
		return TCL_ERROR;
	    }
	    break;

	case MSG_ICON:
	    icon = TkFindStateNumObj(interp, optionPtr, iconMap, valuePtr);
	    if (icon < 0) {
		return TCL_ERROR;
	    }

	    break;

	case MSG_MESSAGE:
	    message = string;
	    break;

	case MSG_PARENT: 
	    parent = Tk_NameToWindow(interp, string, tkwin);
	    if (parent == NULL) {
		return TCL_ERROR;
	    }




	    break;


	case MSG_TITLE:
	    title = string;
	    break;

	case MSG_TYPE:
	    type = TkFindStateNumObj(interp, optionPtr, typeMap, valuePtr);
	    if (type < 0) {
		return TCL_ERROR;
	    }
	    break;






	}
    }




    Tk_MakeWindowExist(parent);

    hWnd = Tk_GetHWND(Tk_WindowId(parent));

    flags = 0;
    if (defaultBtn >= 0) {
	int defaultBtnIdx;

	defaultBtnIdx = -1;
	for (i = 0; i < NUM_TYPES; i++) {
	    if (type == allowedTypes[i].type) {
		int j;

		for (j = 0; j < 3; j++) {
		    if (allowedTypes[i].btnIds[j] == defaultBtn) {
			defaultBtnIdx = j;
			break;
		    }
		}
		if (defaultBtnIdx < 0) {
		    Tcl_AppendResult(interp, "invalid default button \"",
			    TkFindStateString(buttonMap, defaultBtn), 
			    "\"", NULL);
		    return TCL_ERROR;
		}
		break;
	    }
	}
	flags = buttonFlagMap[defaultBtnIdx];
    }





    

    flags |= icon | type | MB_SYSTEMMODAL;

    Tcl_UtfToExternalDString(NULL, message, -1, &messageString);
    Tcl_UtfToExternalDString(NULL, title, -1, &titleString);


    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
    winCode = MessageBox(hWnd, Tcl_DStringValue(&messageString),
		Tcl_DStringValue(&titleString), flags);
    (void) Tcl_SetServiceMode(oldMode);











    Tcl_DStringFree(&messageString);






    Tcl_DStringFree(&titleString);



































    Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC);




    return TCL_OK;
}



























static void 
SetTkDialog(ClientData clientData)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    char buf[32];
    HWND hwnd;

    hwnd = (HWND) clientData;

    sprintf(buf, "0x%08x", hwnd);
    Tcl_SetVar(tsdPtr->debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY);

}

Changes to win/tkWinDraw.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkWinDraw.c --
 *
 *	This file contains the Xlib emulation functions pertaining to
 *	actually drawing objects on a window.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 * Copyright (c) 1994 Software Research Associates, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinDraw.c 1.30 97/03/21 11:20:05
 */

#include "tkWinInt.h"

/*
 * These macros convert between X's bizarre angle units to radians.
 */












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkWinDraw.c --
 *
 *	This file contains the Xlib emulation functions pertaining to
 *	actually drawing objects on a window.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 * Copyright (c) 1994 Software Research Associates, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinDraw.c,v 1.1.4.2 1998/12/13 08:16:17 lfb Exp $
 */

#include "tkWinInt.h"

/*
 * These macros convert between X's bizarre angle units to radians.
 */
101
102
103
104
105
106
107






108
109
110
111
112
113
114

/*
 * The followng typedef is used to pass Windows GDI drawing functions.
 */

typedef BOOL (CALLBACK *WinDrawFunc) _ANSI_ARGS_((HDC dc,
			    CONST POINT* points, int npoints));







/*
 * Forward declarations for procedures defined in this file:
 */

static POINT *		ConvertPoints _ANSI_ARGS_((XPoint *points, int npoints,
			    int mode, RECT *bbox));







>
>
>
>
>
>







101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120

/*
 * The followng typedef is used to pass Windows GDI drawing functions.
 */

typedef BOOL (CALLBACK *WinDrawFunc) _ANSI_ARGS_((HDC dc,
			    CONST POINT* points, int npoints));

typedef struct ThreadSpecificData {
    POINT *winPoints;    /* Array of points that is reused. */
    int nWinPoints;	/* Current size of point array. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations for procedures defined in this file:
 */

static POINT *		ConvertPoints _ANSI_ARGS_((XPoint *points, int npoints,
			    int mode, RECT *bbox));
208
209
210
211
212
213
214
215

216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
 *
 *	Convert an array of X points to an array of Win32 points.
 *
 * Results:
 *	Returns the converted array of POINTs.
 *
 * Side effects:
 *	Allocates a block of memory that should not be freed.

 *
 *----------------------------------------------------------------------
 */

static POINT *
ConvertPoints(points, npoints, mode, bbox)
    XPoint *points;
    int npoints;
    int mode;			/* CoordModeOrigin or CoordModePrevious. */
    RECT *bbox;			/* Bounding box of points. */
{
    static POINT *winPoints = NULL; /* Array of points that is reused. */
    static int nWinPoints = -1;	    /* Current size of point array. */
    int i;

    /*
     * To avoid paying the cost of a malloc on every drawing routine,
     * we reuse the last array if it is large enough.
     */

    if (npoints > nWinPoints) {
	if (winPoints != NULL) {
	    ckfree((char *) winPoints);
	}
	winPoints = (POINT *) ckalloc(sizeof(POINT) * npoints);
	if (winPoints == NULL) {
	    nWinPoints = -1;
	    return NULL;
	}
	nWinPoints = npoints;
    }

    bbox->left = bbox->right = points[0].x;
    bbox->top = bbox->bottom = points[0].y;
    
    if (mode == CoordModeOrigin) {
	for (i = 0; i < npoints; i++) {
	    winPoints[i].x = points[i].x;
	    winPoints[i].y = points[i].y;
	    bbox->left = MIN(bbox->left, winPoints[i].x);
	    bbox->right = MAX(bbox->right, winPoints[i].x);
	    bbox->top = MIN(bbox->top, winPoints[i].y);
	    bbox->bottom = MAX(bbox->bottom, winPoints[i].y);
	}
    } else {
	winPoints[0].x = points[0].x;
	winPoints[0].y = points[0].y;
	for (i = 1; i < npoints; i++) {
	    winPoints[i].x = winPoints[i-1].x + points[i].x;
	    winPoints[i].y = winPoints[i-1].y + points[i].y;
	    bbox->left = MIN(bbox->left, winPoints[i].x);
	    bbox->right = MAX(bbox->right, winPoints[i].x);
	    bbox->top = MIN(bbox->top, winPoints[i].y);
	    bbox->bottom = MAX(bbox->bottom, winPoints[i].y);
	}
    }
    return winPoints;
}

/*
 *----------------------------------------------------------------------
 *
 * XCopyArea --
 *







|
>











|
|







|
|
|

|
|
|


|







|
|
|
|
|
|


|
|

|
|
|
|
|
|


|







214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
 *
 *	Convert an array of X points to an array of Win32 points.
 *
 * Results:
 *	Returns the converted array of POINTs.
 *
 * Side effects:
 *	Allocates a block of memory in thread local storage that 
 *      should not be freed.
 *
 *----------------------------------------------------------------------
 */

static POINT *
ConvertPoints(points, npoints, mode, bbox)
    XPoint *points;
    int npoints;
    int mode;			/* CoordModeOrigin or CoordModePrevious. */
    RECT *bbox;			/* Bounding box of points. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    int i;

    /*
     * To avoid paying the cost of a malloc on every drawing routine,
     * we reuse the last array if it is large enough.
     */

    if (npoints > tsdPtr->nWinPoints) {
	if (tsdPtr->winPoints != NULL) {
	    ckfree((char *) tsdPtr->winPoints);
	}
	tsdPtr->winPoints = (POINT *) ckalloc(sizeof(POINT) * npoints);
	if (tsdPtr->winPoints == NULL) {
	    tsdPtr->nWinPoints = -1;
	    return NULL;
	}
	tsdPtr->nWinPoints = npoints;
    }

    bbox->left = bbox->right = points[0].x;
    bbox->top = bbox->bottom = points[0].y;
    
    if (mode == CoordModeOrigin) {
	for (i = 0; i < npoints; i++) {
	    tsdPtr->winPoints[i].x = points[i].x;
	    tsdPtr->winPoints[i].y = points[i].y;
	    bbox->left = MIN(bbox->left, tsdPtr->winPoints[i].x);
	    bbox->right = MAX(bbox->right, tsdPtr->winPoints[i].x);
	    bbox->top = MIN(bbox->top, tsdPtr->winPoints[i].y);
	    bbox->bottom = MAX(bbox->bottom, tsdPtr->winPoints[i].y);
	}
    } else {
	tsdPtr->winPoints[0].x = points[0].x;
	tsdPtr->winPoints[0].y = points[0].y;
	for (i = 1; i < npoints; i++) {
	    tsdPtr->winPoints[i].x = tsdPtr->winPoints[i-1].x + points[i].x;
	    tsdPtr->winPoints[i].y = tsdPtr->winPoints[i-1].y + points[i].y;
	    bbox->left = MIN(bbox->left, tsdPtr->winPoints[i].x);
	    bbox->right = MAX(bbox->right, tsdPtr->winPoints[i].x);
	    bbox->top = MIN(bbox->top, tsdPtr->winPoints[i].y);
	    bbox->bottom = MAX(bbox->bottom, tsdPtr->winPoints[i].y);
	}
    }
    return tsdPtr->winPoints;
}

/*
 *----------------------------------------------------------------------
 *
 * XCopyArea --
 *

Changes to win/tkWinEmbed.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkWinEmbed.c --
 *
 *	This file contains platform specific procedures for Windows platforms
 *	to provide basic operations needed for application embedding (where
 *	one application can use as its main window an internal window from
 *	another application).
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinEmbed.c 1.20 97/11/05 17:47:09;
 */

#include "tkWinInt.h"


/*
 * One of the following structures exists for each container in this








|




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/* 
 * tkWinEmbed.c --
 *
 *	This file contains platform specific procedures for Windows platforms
 *	to provide basic operations needed for application embedding (where
 *	one application can use as its main window an internal window from
 *	another application).
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinEmbed.c,v 1.1.4.3 1998/12/13 08:16:18 lfb Exp $
 */

#include "tkWinInt.h"


/*
 * One of the following structures exists for each container in this
34
35
36
37
38
39
40
41
42
43


44
45
46
47
48
49
50
					 * window, or NULL if the
					 * embedded application isn't in
					 * this process. */
    struct Container *nextPtr;		/* Next in list of all containers in
					 * this process. */
} Container;

static Container *firstContainerPtr = NULL;
					/* First in list of all containers
					 * managed by this process.  */



static void		CleanupContainerList _ANSI_ARGS_((
    			    ClientData clientData));
static void		ContainerEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		EmbeddedEventProc _ANSI_ARGS_((
			    ClientData clientData, XEvent *eventPtr));







|
|

>
>







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
					 * window, or NULL if the
					 * embedded application isn't in
					 * this process. */
    struct Container *nextPtr;		/* Next in list of all containers in
					 * this process. */
} Container;

typedef struct ThreadSpecificData {
    Container *firstContainerPtr;       /* First in list of all containers
					 * managed by this process.  */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

static void		CleanupContainerList _ANSI_ARGS_((
    			    ClientData clientData));
static void		ContainerEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		EmbeddedEventProc _ANSI_ARGS_((
			    ClientData clientData, XEvent *eventPtr));
70
71
72
73
74
75
76


77
78
79
80
81
82
83
84
85
86
87
88
89
90
91

	/* ARGSUSED */
static void
CleanupContainerList(clientData)
    ClientData clientData;
{
    Container *nextPtr;


    
    for (;
        firstContainerPtr != (Container *) NULL;
        firstContainerPtr = nextPtr) {
        nextPtr = firstContainerPtr->nextPtr;
        ckfree((char *) firstContainerPtr);
    }
    firstContainerPtr = (Container *) NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TkpTestembedCmd --
 *







>
>


|
|
|
|

|







72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95

	/* ARGSUSED */
static void
CleanupContainerList(clientData)
    ClientData clientData;
{
    Container *nextPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    
    for (;
        tsdPtr->firstContainerPtr != (Container *) NULL;
        tsdPtr->firstContainerPtr = nextPtr) {
        nextPtr = tsdPtr->firstContainerPtr->nextPtr;
        ckfree((char *) tsdPtr->firstContainerPtr);
    }
    tsdPtr->firstContainerPtr = (Container *) NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TkpTestembedCmd --
 *
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
 *	application to specify the window in which the application is
 *	embedded.
 *
 * Results:
 *	The return value is normally TCL_OK. If an error occurred (such as
 *	if the argument does not identify a legal Windows window handle),
 *	the return value is TCL_ERROR and an error message is left in the
 *	interp->result if interp is not NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int 
TkpUseWindow(interp, tkwin, string)
    Tcl_Interp *interp;		/* If not NULL, used for error reporting
				 * if string is bogus. */
    Tk_Window tkwin;		/* Tk window that does not yet have an
				 * associated X window. */
    char *string;		/* String identifying an X window to use
				 * for tkwin;  must be an integer value. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    int id;
    HWND hwnd;
    Container *containerPtr;



    if (winPtr->window != None) {
        panic("TkpUseWindow: Already assigned a window");
    }

    if (Tcl_GetInt(interp, string, &id) != TCL_OK) {
        return TCL_ERROR;
    }
    hwnd = (HWND) id;

    /*
     * Check if the window is a valid handle. If it is invalid, return
     * TCL_ERROR and potentially leave an error message in interp->result.

     */

    if (!IsWindow(hwnd)) {
        if (interp != (Tcl_Interp *) NULL) {
            Tcl_AppendResult(interp, "window \"", string,
                    "\" doesn't exist", (char *) NULL);
        }







|




















>
>












|
>







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
 *	application to specify the window in which the application is
 *	embedded.
 *
 * Results:
 *	The return value is normally TCL_OK. If an error occurred (such as
 *	if the argument does not identify a legal Windows window handle),
 *	the return value is TCL_ERROR and an error message is left in the
 *	the interp's result if interp is not NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int 
TkpUseWindow(interp, tkwin, string)
    Tcl_Interp *interp;		/* If not NULL, used for error reporting
				 * if string is bogus. */
    Tk_Window tkwin;		/* Tk window that does not yet have an
				 * associated X window. */
    char *string;		/* String identifying an X window to use
				 * for tkwin;  must be an integer value. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    int id;
    HWND hwnd;
    Container *containerPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (winPtr->window != None) {
        panic("TkpUseWindow: Already assigned a window");
    }

    if (Tcl_GetInt(interp, string, &id) != TCL_OK) {
        return TCL_ERROR;
    }
    hwnd = (HWND) id;

    /*
     * Check if the window is a valid handle. If it is invalid, return
     * TCL_ERROR and potentially leave an error message in the interp's
     * result.
     */

    if (!IsWindow(hwnd)) {
        if (interp != (Tcl_Interp *) NULL) {
            Tcl_AppendResult(interp, "window \"", string,
                    "\" doesn't exist", (char *) NULL);
        }
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
	    (ClientData) winPtr);

    /*
     * If this is the first container, register an exit handler so that
     * things will get cleaned up at finalization.
     */

    if (firstContainerPtr == (Container *) NULL) {
        Tcl_CreateExitHandler(CleanupContainerList, (ClientData) NULL);
    }
    
    /*
     * Save information about the container and the embedded window
     * in a Container structure.  If there is already an existing
     * Container structure, it means that both container and embedded
     * app. are in the same process.
     */

    for (containerPtr = firstContainerPtr; containerPtr != NULL;
	    containerPtr = containerPtr->nextPtr) {
	if (containerPtr->parentHWnd == hwnd) {
	    winPtr->flags |= TK_BOTH_HALVES;
	    containerPtr->parentPtr->flags |= TK_BOTH_HALVES;
	    break;
	}
    }
    if (containerPtr == NULL) {
	containerPtr = (Container *) ckalloc(sizeof(Container));
	containerPtr->parentPtr = NULL;
	containerPtr->parentHWnd = hwnd;
	containerPtr->nextPtr = firstContainerPtr;
	firstContainerPtr = containerPtr;
    }

    /*
     * embeddedHWnd is not created yet. It will be created by TkWmMapWindow(),
     * which will send a TK_ATTACHWINDOW to the container window.
     * TkWinEmbeddedEventProc will process this message and set the embeddedHWnd
     * variable







|










|
|










|
|







193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
	    (ClientData) winPtr);

    /*
     * If this is the first container, register an exit handler so that
     * things will get cleaned up at finalization.
     */

    if (tsdPtr->firstContainerPtr == (Container *) NULL) {
        Tcl_CreateExitHandler(CleanupContainerList, (ClientData) NULL);
    }
    
    /*
     * Save information about the container and the embedded window
     * in a Container structure.  If there is already an existing
     * Container structure, it means that both container and embedded
     * app. are in the same process.
     */

    for (containerPtr = tsdPtr->firstContainerPtr; 
            containerPtr != NULL; containerPtr = containerPtr->nextPtr) {
	if (containerPtr->parentHWnd == hwnd) {
	    winPtr->flags |= TK_BOTH_HALVES;
	    containerPtr->parentPtr->flags |= TK_BOTH_HALVES;
	    break;
	}
    }
    if (containerPtr == NULL) {
	containerPtr = (Container *) ckalloc(sizeof(Container));
	containerPtr->parentPtr = NULL;
	containerPtr->parentHWnd = hwnd;
	containerPtr->nextPtr = tsdPtr->firstContainerPtr;
	tsdPtr->firstContainerPtr = containerPtr;
    }

    /*
     * embeddedHWnd is not created yet. It will be created by TkWmMapWindow(),
     * which will send a TK_ATTACHWINDOW to the container window.
     * TkWinEmbeddedEventProc will process this message and set the embeddedHWnd
     * variable
254
255
256
257
258
259
260


261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290

void
TkpMakeContainer(tkwin)
    Tk_Window tkwin;
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    Container *containerPtr;



    /*
     * If this is the first container, register an exit handler so that
     * things will get cleaned up at finalization.
     */

    if (firstContainerPtr == (Container *) NULL) {
        Tcl_CreateExitHandler(CleanupContainerList, (ClientData) NULL);
    }
    
    /*
     * Register the window as a container so that, for example, we can
     * find out later if the embedded app. is in the same process.
     */

    Tk_MakeWindowExist(tkwin);
    containerPtr = (Container *) ckalloc(sizeof(Container));
    containerPtr->parentPtr = winPtr;
    containerPtr->parentHWnd = Tk_GetHWND(Tk_WindowId(tkwin));
    containerPtr->embeddedHWnd = NULL;
    containerPtr->embeddedPtr = NULL;
    containerPtr->nextPtr = firstContainerPtr;
    firstContainerPtr = containerPtr;
    winPtr->flags |= TK_CONTAINER;

    /*
     * Unlike in tkUnixEmbed.c, we don't make any requests for events
     * in the embedded window here.  Now we just allow the embedding
     * of another TK application into TK windows. When the embedded
     * window makes a request, that will be done by sending to the







>
>






|














|
|







261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299

void
TkpMakeContainer(tkwin)
    Tk_Window tkwin;
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    Container *containerPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * If this is the first container, register an exit handler so that
     * things will get cleaned up at finalization.
     */

    if (tsdPtr->firstContainerPtr == (Container *) NULL) {
        Tcl_CreateExitHandler(CleanupContainerList, (ClientData) NULL);
    }
    
    /*
     * Register the window as a container so that, for example, we can
     * find out later if the embedded app. is in the same process.
     */

    Tk_MakeWindowExist(tkwin);
    containerPtr = (Container *) ckalloc(sizeof(Container));
    containerPtr->parentPtr = winPtr;
    containerPtr->parentHWnd = Tk_GetHWND(Tk_WindowId(tkwin));
    containerPtr->embeddedHWnd = NULL;
    containerPtr->embeddedPtr = NULL;
    containerPtr->nextPtr = tsdPtr->firstContainerPtr;
    tsdPtr->firstContainerPtr = containerPtr;
    winPtr->flags |= TK_CONTAINER;

    /*
     * Unlike in tkUnixEmbed.c, we don't make any requests for events
     * in the embedded window here.  Now we just allow the embedding
     * of another TK application into TK windows. When the embedded
     * window makes a request, that will be done by sending to the
354
355
356
357
358
359
360


361
362
363
364
365
366
367
368
369
370
371
372
373
TkWinEmbeddedEventProc(hwnd, message, wParam, lParam)
    HWND hwnd;
    UINT message;
    WPARAM wParam;
    LPARAM lParam;
{
    Container *containerPtr;



    /*
     * Find the Container structure associated with the parent window.
     */

    for (containerPtr = firstContainerPtr;
	    containerPtr->parentHWnd != hwnd;
	    containerPtr = containerPtr->nextPtr) {
	if (containerPtr == NULL) {
	    panic("TkWinContainerProc couldn't find Container record");
	}
    }








>
>





|







363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
TkWinEmbeddedEventProc(hwnd, message, wParam, lParam)
    HWND hwnd;
    UINT message;
    WPARAM wParam;
    LPARAM lParam;
{
    Container *containerPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Find the Container structure associated with the parent window.
     */

    for (containerPtr = tsdPtr->firstContainerPtr;
	    containerPtr->parentHWnd != hwnd;
	    containerPtr = containerPtr->nextPtr) {
	if (containerPtr == NULL) {
	    panic("TkWinContainerProc couldn't find Container record");
	}
    }

504
505
506
507
508
509
510


511
512
513
514
515
516
517
518
519

TkWindow *
TkpGetOtherWindow(winPtr)
    TkWindow *winPtr;		/* Tk's structure for a container or
				 * embedded window. */
{
    Container *containerPtr;



    for (containerPtr = firstContainerPtr; containerPtr != NULL;
	    containerPtr = containerPtr->nextPtr) {
	if (containerPtr->embeddedPtr == winPtr) {
	    return containerPtr->parentPtr;
	} else if (containerPtr->parentPtr == winPtr) {
	    return containerPtr->embeddedPtr;
	}
    }







>
>

|







515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532

TkWindow *
TkpGetOtherWindow(winPtr)
    TkWindow *winPtr;		/* Tk's structure for a container or
				 * embedded window. */
{
    Container *containerPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL;
	    containerPtr = containerPtr->nextPtr) {
	if (containerPtr->embeddedPtr == winPtr) {
	    return containerPtr->parentPtr;
	} else if (containerPtr->parentPtr == winPtr) {
	    return containerPtr->embeddedPtr;
	}
    }
604
605
606
607
608
609
610


611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645

static void
EmbedWindowDeleted(winPtr)
    TkWindow *winPtr;		/* Tk's information about window that
				 * was deleted. */
{
    Container *containerPtr, *prevPtr;



    /*
     * Find the Container structure for this window work.  Delete the
     * information about the embedded application and free the container's
     * record.
     */

    prevPtr = NULL;
    containerPtr = firstContainerPtr;
    while (1) {
	if (containerPtr->embeddedPtr == winPtr) {
	    containerPtr->embeddedHWnd = NULL;
	    containerPtr->embeddedPtr = NULL;
	    break;
	}
	if (containerPtr->parentPtr == winPtr) {
	    containerPtr->parentPtr = NULL;
	    break;
	}
	prevPtr = containerPtr;
	containerPtr = containerPtr->nextPtr;
	if (containerPtr == NULL) {
	    panic("EmbedWindowDeleted couldn't find window");
	}
    }
    if ((containerPtr->embeddedPtr == NULL)
	    && (containerPtr->parentPtr == NULL)) {
	if (prevPtr == NULL) {
	    firstContainerPtr = containerPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = containerPtr->nextPtr;
	}
	ckfree((char *) containerPtr);
    }
}







>
>








|



















|






617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660

static void
EmbedWindowDeleted(winPtr)
    TkWindow *winPtr;		/* Tk's information about window that
				 * was deleted. */
{
    Container *containerPtr, *prevPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Find the Container structure for this window work.  Delete the
     * information about the embedded application and free the container's
     * record.
     */

    prevPtr = NULL;
    containerPtr = tsdPtr->firstContainerPtr;
    while (1) {
	if (containerPtr->embeddedPtr == winPtr) {
	    containerPtr->embeddedHWnd = NULL;
	    containerPtr->embeddedPtr = NULL;
	    break;
	}
	if (containerPtr->parentPtr == winPtr) {
	    containerPtr->parentPtr = NULL;
	    break;
	}
	prevPtr = containerPtr;
	containerPtr = containerPtr->nextPtr;
	if (containerPtr == NULL) {
	    panic("EmbedWindowDeleted couldn't find window");
	}
    }
    if ((containerPtr->embeddedPtr == NULL)
	    && (containerPtr->parentPtr == NULL)) {
	if (prevPtr == NULL) {
	    tsdPtr->firstContainerPtr = containerPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = containerPtr->nextPtr;
	}
	ckfree((char *) containerPtr);
    }
}

Changes to win/tkWinFont.c.

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
/* 
 * tkWinFont.c --
 *
 *	Contains the Windows implementation of the platform-independant
 *	font package interface.
 *

 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1994 Software Research Associates, Inc. 
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinFont.c 1.20 97/05/14 15:45:30
 */

#include "tkWinInt.h"
#include "tkFont.h"

/*





















































































 * The following structure represents Windows' implementation of a font.

 */




typedef struct WinFont {
    TkFont font;		/* Stuff used by generic font package.  Must
				 * be first in structure. */












    HFONT hFont;		/* Windows information about font. */
    HWND hwnd;			/* Toplevel window of application that owns
				 * this font, used for getting HDC. */



    int widths[256];		/* Widths of first 256 chars in this font. */



} WinFont;

/*














 * The following structure is used as to map between the Tcl strings
 * that represent the system fonts and the numbers used by Windows.
 */

static TkStateMap systemMap[] = {
    {ANSI_FIXED_FONT,	    "ansifixed"},
    {ANSI_VAR_FONT,	    "ansi"},
    {DEVICE_DEFAULT_FONT,   "device"},
    {OEM_FIXED_FONT,	    "oemfixed"},
    {SYSTEM_FIXED_FONT,	    "systemfixed"},
    {SYSTEM_FONT,	    "system"},
    {-1,		    NULL}
};










#define ABS(x)          (((x) < 0) ? -(x) : (x))







static TkFont *		AllocFont _ANSI_ARGS_((TkFont *tkFontPtr, 



                            Tk_Window tkwin, HFONT hFont));












static char *		GetProperty _ANSI_ARGS_((CONST TkFontAttributes *faPtr,
			    CONST char *option));




















static int CALLBACK	WinFontFamilyEnumProc _ANSI_ARGS_((ENUMLOGFONT *elfPtr,
			    NEWTEXTMETRIC *ntmPtr, int fontType,
			    LPARAM lParam));









































/*
 *---------------------------------------------------------------------------
 *
 * TkpGetNativeFont --
 *
 *	Map a platform-specific native font name to a TkFont.






>

|




|






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

>
>
>




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

|
>
>
>
|
>
>
>



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












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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
/* 
 * tkWinFont.c --
 *
 *	Contains the Windows implementation of the platform-independant
 *	font package interface.
 *
 * Copyright (c) 1994 Software Research Associates, Inc. 
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinFont.c,v 1.1.4.5 1999/03/30 04:13:00 stanton Exp $
 */

#include "tkWinInt.h"
#include "tkFont.h"

/*
 * The following structure represents a font family.  It is assumed that
 * all screen fonts constructed from the same "font family" share certain
 * properties; all screen fonts with the same "font family" point to a
 * shared instance of this structure.  The most important shared property
 * is the character existence metrics, used to determine if a screen font
 * can display a given Unicode character.
 *
 * Under Windows, a "font family" is uniquely identified by its face name.
 */

#define FONTMAP_SHIFT	    10

#define FONTMAP_PAGES	    	(1 << (sizeof(Tcl_UniChar)*8 - FONTMAP_SHIFT))
#define FONTMAP_BITSPERPAGE	(1 << FONTMAP_SHIFT)

typedef struct FontFamily {
    struct FontFamily *nextPtr;	/* Next in list of all known font families. */
    int refCount;		/* How many SubFonts are referring to this
				 * FontFamily.  When the refCount drops to
				 * zero, this FontFamily may be freed. */
    /*
     * Key.
     */
     
    Tk_Uid faceName;		/* Face name key for this FontFamily. */

    /*
     * Derived properties.
     */
     
    Tcl_Encoding encoding;	/* Encoding for this font family. */
    int isSymbolFont;		/* Non-zero if this is a symbol font. */
    int isWideFont;		/* 1 if this is a double-byte font, 0 
				 * otherwise. */
    BOOL (WINAPI *textOutProc)(HDC, int, int, TCHAR *, int);
				/* The procedure to use to draw text after
				 * it has been converted from UTF-8 to the 
				 * encoding of this font. */
    BOOL (WINAPI *getTextExtentPoint32Proc)(HDC, TCHAR *, int, LPSIZE);
				/* The procedure to use to measure text after
				 * it has been converted from UTF-8 to the 
				 * encoding of this font. */

    char *fontMap[FONTMAP_PAGES];
				/* Two-level sparse table used to determine
				 * quickly if the specified character exists.
				 * As characters are encountered, more pages
				 * in this table are dynamically added.  The
				 * contents of each page is a bitmask
				 * consisting of FONTMAP_BITSPERPAGE bits,
				 * representing whether this font can be used
				 * to display the given character at the
				 * corresponding bit position.  The high bits
				 * of the character are used to pick which
				 * page of the table is used. */

    /*
     * Cached Truetype font info.
     */
     
    int segCount;		/* The length of the following arrays. */
    USHORT *startCount;		/* Truetype information about the font, */
    USHORT *endCount;		/* indicating which characters this font
				 * can display (malloced).  The format of
				 * this information is (relatively) compact,
				 * but would take longer to search than 
				 * indexing into the fontMap[][] table. */
} FontFamily;

/*
 * The following structure encapsulates an individual screen font.  A font
 * object is made up of however many SubFonts are necessary to display a
 * stream of multilingual characters.
 */

typedef struct SubFont {
    char **fontMap;		/* Pointer to font map from the FontFamily, 
				 * cached here to save a dereference. */
    HFONT hFont;		/* The specific screen font that will be
				 * used when displaying/measuring chars
				 * belonging to the FontFamily. */
    FontFamily *familyPtr;	/* The FontFamily for this SubFont. */
} SubFont;

/*
 * The following structure represents Windows' implementation of a font
 * object.
 */

#define SUBFONT_SPACE		3
#define BASE_CHARS		128

typedef struct WinFont {
    TkFont font;		/* Stuff used by generic font package.  Must
				 * be first in structure. */
    SubFont staticSubFonts[SUBFONT_SPACE];
				/* Builtin space for a limited number of
				 * SubFonts. */
    int numSubFonts;		/* Length of following array. */
    SubFont *subFontArray;	/* Array of SubFonts that have been loaded
				 * in order to draw/measure all the characters
				 * encountered by this font so far.  All fonts
				 * start off with one SubFont initialized by
				 * AllocFont() from the original set of font
				 * attributes.  Usually points to
				 * staticSubFonts, but may point to malloced
				 * space if there are lots of SubFonts. */

    HWND hwnd;			/* Toplevel window of application that owns
				 * this font, used for getting HDC for
				 * offscreen measurements. */
    int pixelSize;		/* Original pixel size used when font was
				 * constructed. */
    int widths[BASE_CHARS];	/* Widths of first 128 chars in the base
				 * font, for handling common case.  The base
				 * font is always used to draw characters
				 * between 0x0000 and 0x007f. */
} WinFont;

/*
 * The following structure is passed as the LPARAM when calling the font
 * enumeration procedure to determine if a font can support the given
 * character.
 */

typedef struct CanUse {
    HDC hdc;
    WinFont *fontPtr;
    Tcl_DString *nameTriedPtr;
    int ch;
    SubFont *subFontPtr;
} CanUse;

/*
 * The following structure is used to map between the Tcl strings that
 * represent the system fonts and the numbers used by Windows.
 */

static TkStateMap systemMap[] = {
    {ANSI_FIXED_FONT,	    "ansifixed"},
    {ANSI_VAR_FONT,	    "ansi"},
    {DEVICE_DEFAULT_FONT,   "device"},
    {OEM_FIXED_FONT,	    "oemfixed"},
    {SYSTEM_FIXED_FONT,	    "systemfixed"},
    {SYSTEM_FONT,	    "system"},
    {-1,		    NULL}
};

typedef struct ThreadSpecificData {
    FontFamily *fontFamilyList; /* The list of font families that are 
				 * currently loaded.  As screen fonts
				 * are loaded, this list grows to hold 
				 * information about what characters
				 * exist in each font family.  */
    Tcl_HashTable uidTable;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Information cached about the system at startup time.
 */
 
static int platformId;
static Tcl_Encoding unicodeEncoding;
static Tcl_Encoding systemEncoding;

/*
 * Procedures used only in this file.
 */

static FontFamily *	AllocFontFamily(HDC hdc, HFONT hFont, int base);
static SubFont *	CanUseFallback(HDC hdc, WinFont *fontPtr, 
			    char *fallbackName,	int ch);
static SubFont *	CanUseFallbackWithAliases(HDC hdc, WinFont *fontPtr, 
			    char *faceName, int ch, Tcl_DString *nameTriedPtr);
static int		FamilyExists(HDC hdc, CONST char *faceName);
static char *		FamilyOrAliasExists(HDC hdc, CONST char *faceName);
static SubFont *	FindSubFontForChar(WinFont *fontPtr, int ch);
static void		FontMapInsert(SubFont *subFontPtr, int ch);
static void		FontMapLoadPage(SubFont *subFontPtr, int row);
static int		FontMapLookup(SubFont *subFontPtr, int ch);
static void		FreeFontFamily(FontFamily *familyPtr);
static HFONT		GetScreenFont(CONST TkFontAttributes *faPtr,
			    CONST char *faceName, int pixelSize);
static void		InitFont(Tk_Window tkwin, HFONT hFont, 
			    int overstrike, WinFont *tkFontPtr);
static void		InitSubFont(HDC hdc, HFONT hFont, int base, 
			    SubFont *subFontPtr);
static int		LoadFontRanges(HDC hdc, HFONT hFont, 
			    USHORT **startCount, USHORT **endCount,
			    int *symbolPtr);
static void		MultiFontTextOut(HDC hdc, WinFont *fontPtr, 
			    CONST char *source, int numBytes, int x, int y);
static void		ReleaseFont(WinFont *fontPtr);
static void		ReleaseSubFont(SubFont *subFontPtr);
static int		SeenName(CONST char *name, Tcl_DString *dsPtr);
static void		SwapLong(PULONG p);
static void		SwapShort(USHORT *p);
static int CALLBACK	WinFontCanUseProc(ENUMLOGFONT *lfPtr, 
			    NEWTEXTMETRIC *tmPtr, int fontType, 
			    LPARAM lParam);
static int CALLBACK	WinFontExistProc(ENUMLOGFONT *lfPtr, 
			    NEWTEXTMETRIC *tmPtr, int fontType, 
			    LPARAM lParam);
static int CALLBACK	WinFontFamilyEnumProc(ENUMLOGFONT *lfPtr, 
			    NEWTEXTMETRIC *tmPtr, int fontType, 
			    LPARAM lParam);

/*
 *-------------------------------------------------------------------------
 * 
 * TkpFontPkgInit --
 *
 *	This procedure is called when an application is created.  It
 *	initializes all the structures that are used by the 
 *	platform-dependant code on a per application basis.
 *
 * Results:
 *	None.  
 *
 * Side effects:
 *	
 *	None.
 *
 *-------------------------------------------------------------------------
 */

void
TkpFontPkgInit(
    TkMainInfo *mainPtr)	/* The application being created. */
{
    OSVERSIONINFO os;

    os.dwOSVersionInfoSize = sizeof(os);
    GetVersionEx(&os);
    platformId = os.dwPlatformId;
    unicodeEncoding = Tcl_GetEncoding(NULL, "unicode");
    if (platformId == VER_PLATFORM_WIN32_NT) {
	/*
	 * If running NT, then we will be calling some Unicode functions 
	 * explictly.  So, even if the Tcl system encoding isn't Unicode, 
	 * make sure we convert to/from the Unicode char set. 
	 */

	systemEncoding = unicodeEncoding;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetNativeFont --
 *
 *	Map a platform-specific native font name to a TkFont.
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
 *	call TkpDeleteFont() when the font is no longer needed.
 *
 *	The caller is responsible for initializing the memory associated
 *	with the generic TkFont when this function returns and releasing
 *	the contents of the generic TkFont before calling TkpDeleteFont().
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

TkFont *
TkpGetNativeFont(tkwin, name)
    Tk_Window tkwin;		/* For display where font will be used. */
    CONST char *name;		/* Platform-specific font name. */
{
    int object;
    HFONT hFont;
    
    object = TkFindStateNum(NULL, NULL, systemMap, name);
    if (object < 0) {
	return NULL;
    }
    hFont = GetStockObject(object);
    if (hFont == NULL) {
	panic("TkpGetNativeFont: can't allocate stock font");
    }




    return AllocFont(NULL, tkwin, hFont);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetFontFromAttributes -- 
 *







|





|
|
|


|
|




<
<
<
|
>
>
>

|







283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306



307
308
309
310
311
312
313
314
315
316
317
318
319
 *	call TkpDeleteFont() when the font is no longer needed.
 *
 *	The caller is responsible for initializing the memory associated
 *	with the generic TkFont when this function returns and releasing
 *	the contents of the generic TkFont before calling TkpDeleteFont().
 *
 * Side effects:
 *	Memory allocated.
 *
 *---------------------------------------------------------------------------
 */

TkFont *
TkpGetNativeFont(
    Tk_Window tkwin,		/* For display where font will be used. */
    CONST char *name)		/* Platform-specific font name. */
{
    int object;
    WinFont *fontPtr;

    object = TkFindStateNum(NULL, NULL, systemMap, name);
    if (object < 0) {
	return NULL;
    }




    tkwin = (Tk_Window) ((TkWindow *) tkwin)->mainPtr->winPtr;
    fontPtr = (WinFont *) ckalloc(sizeof(WinFont));
    InitFont(tkwin, GetStockObject(object), 0, fontPtr);

    return (TkFont *) fontPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetFontFromAttributes -- 
 *
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
 *	specific data when the font is no longer needed.  
 *
 *	The caller is responsible for initializing the memory associated
 *	with the generic TkFont when this function returns and releasing
 *	the contents of the generic TkFont before calling TkpDeleteFont().
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

TkFont *
TkpGetFontFromAttributes(tkFontPtr, tkwin, faPtr)
    TkFont *tkFontPtr;		/* If non-NULL, store the information in
				 * this existing TkFont structure, rather than
				 * allocating a new structure to hold the
				 * font; the existing contents of the font
				 * will be released.  If NULL, a new TkFont
				 * structure is allocated. */
    Tk_Window tkwin;		/* For display where font will be used. */
    CONST TkFontAttributes *faPtr;  /* Set of attributes to match. */

{

    LOGFONT lf;

    HFONT hFont;
    Window window;
    HWND hwnd;
    HDC hdc;


    window = Tk_WindowId(((TkWindow *) tkwin)->mainPtr->winPtr);

    hwnd = (window == None) ? NULL : TkWinGetHWND(window);



















    hdc = GetDC(hwnd);
    lf.lfHeight		= -faPtr->pointsize;
    if (lf.lfHeight < 0) {
	lf.lfHeight = MulDiv(lf.lfHeight, 
	        254 * WidthOfScreen(Tk_Screen(tkwin)),
		720 * WidthMMOfScreen(Tk_Screen(tkwin)));

    }

    lf.lfWidth		= 0;
    lf.lfEscapement	= 0;
    lf.lfOrientation	= 0;
    lf.lfWeight		= (faPtr->weight == TK_FW_NORMAL) ? FW_NORMAL : FW_BOLD;
    lf.lfItalic		= faPtr->slant;
    lf.lfUnderline	= faPtr->underline;
    lf.lfStrikeOut	= faPtr->overstrike;
    lf.lfCharSet	= DEFAULT_CHARSET;
    lf.lfOutPrecision	= OUT_DEFAULT_PRECIS;
    lf.lfClipPrecision	= CLIP_DEFAULT_PRECIS;
    lf.lfQuality	= DEFAULT_QUALITY;
    lf.lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
    if (faPtr->family == NULL) {
	lf.lfFaceName[0] = '\0';
    } else {
	lstrcpyn(lf.lfFaceName, faPtr->family, sizeof(lf.lfFaceName));
    }






    ReleaseDC(hwnd, hdc);

    /*
     * Replace the standard X and Mac family names with the names that
     * Windows likes.
     */

    if ((stricmp(lf.lfFaceName, "Times") == 0)
	    || (stricmp(lf.lfFaceName, "New York") == 0)) {
	strcpy(lf.lfFaceName, "Times New Roman");

    } else if ((stricmp(lf.lfFaceName, "Courier") == 0)
	    || (stricmp(lf.lfFaceName, "Monaco") == 0)) {
	strcpy(lf.lfFaceName, "Courier New");
    } else if ((stricmp(lf.lfFaceName, "Helvetica") == 0)
	    || (stricmp(lf.lfFaceName, "Geneva") == 0)) {
	strcpy(lf.lfFaceName, "Arial");
    }

    hFont = CreateFontIndirect(&lf);
    if (hFont == NULL) {
        hFont = GetStockObject(SYSTEM_FONT);
	if (hFont == NULL) {
	    panic("TkpGetFontFromAttributes: cannot get system font");
	}

    }
    return AllocFont(tkFontPtr, tkwin, hFont);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpDeleteFont --
 *







|



>

|
|





|
|
>

>
|
>


|
|
>

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


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







332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387


388
389
390
391
392
393
394
395









396
397
398
399

400
401
402
403
404
405
406
407
408




409
410


411
412






413

414



415
416
417
418
419
420
421
422
423
424
425
 *	specific data when the font is no longer needed.  
 *
 *	The caller is responsible for initializing the memory associated
 *	with the generic TkFont when this function returns and releasing
 *	the contents of the generic TkFont before calling TkpDeleteFont().
 *
 * Side effects:
 *	Memory allocated.
 *
 *---------------------------------------------------------------------------
 */

TkFont *
TkpGetFontFromAttributes(
    TkFont *tkFontPtr,		/* If non-NULL, store the information in
				 * this existing TkFont structure, rather than
				 * allocating a new structure to hold the
				 * font; the existing contents of the font
				 * will be released.  If NULL, a new TkFont
				 * structure is allocated. */
    Tk_Window tkwin,		/* For display where font will be used. */
    CONST TkFontAttributes *faPtr)
				/* Set of attributes to match. */
{
    int i, j;
    HDC hdc;
    HWND hwnd;
    HFONT hFont;
    Window window;
    WinFont *fontPtr;
    char ***fontFallbacks;
    char *faceName, *fallback, *actualName;

    tkwin   = (Tk_Window) ((TkWindow *) tkwin)->mainPtr->winPtr;
    window  = Tk_WindowId(tkwin);
    hwnd    = (window == None) ? NULL : TkWinGetHWND(window);
    hdc	    = GetDC(hwnd);

    /*
     * Algorithm to get the closest font name to the one requested.
     *
     * try fontname
     * try all aliases for fontname
     * foreach fallback for fontname
     *	    try the fallback
     *	    try all aliases for the fallback
     */

    faceName = faPtr->family;
    if (faceName != NULL) {
	actualName = FamilyOrAliasExists(hdc, faceName);
	if (actualName != NULL) {
	    faceName = actualName;
	    goto found;
	}
	fontFallbacks = TkFontGetFallbacks();


	for (i = 0; fontFallbacks[i] != NULL; i++) {
	    for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
		if (strcasecmp(faceName, fallback) == 0) {
		    break;
		}
	    }
	    if (fallback != NULL) {
		for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {









		    actualName = FamilyOrAliasExists(hdc, fallback);
		    if (actualName != NULL) {
			faceName = actualName;
			goto found;

		    }
		}
	    }
	}
    }

    found:
    ReleaseDC(hwnd, hdc);





    hFont = GetScreenFont(faPtr, faceName, TkFontGetPixels(tkwin, faPtr->size));
    if (tkFontPtr == NULL) {


	fontPtr = (WinFont *) ckalloc(sizeof(WinFont));
    } else {






	fontPtr = (WinFont *) tkFontPtr;

	ReleaseFont(fontPtr);



    }
    InitFont(tkwin, hFont, faPtr->overstrike, fontPtr);

    return (TkFont *) fontPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpDeleteFont --
 *
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262

263














264

265
266
267


268

269
270
271
272
273
274
275
276
277
278



279
280
281
282





283
284





































285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306

307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332

333

334
335
336
337
338
339
340
341
342
343
344
345

346
347
348
349
350
351

















































352
353
354
355
356
357
358
359







360



361
362
363
364
365
366
367
368
369

370













371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
 * Side effects:
 *	TkFont is deallocated.
 *
 *---------------------------------------------------------------------------
 */

void
TkpDeleteFont(tkFontPtr)
    TkFont *tkFontPtr;		/* Token of font to be deleted. */
{
    WinFont *fontPtr;

    fontPtr = (WinFont *) tkFontPtr;
    DeleteObject(fontPtr->hFont);
    ckfree((char *) fontPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetFontFamilies, WinFontEnumFamilyProc --
 *
 *	Return information about the font families that are available
 *	on the display of the given window.
 *
 * Results:
 *	interp->result is modified to hold a list of all the available
 *	font families.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
 
void
TkpGetFontFamilies(interp, tkwin)
    Tcl_Interp *interp;		/* Interp to hold result. */
    Tk_Window tkwin;		/* For display to query. */
{    
    Window window;
    HWND hwnd;
    HDC hdc;

    window = Tk_WindowId(tkwin);
    hwnd = (window == (Window) NULL) ? NULL : TkWinGetHWND(window);
















    hdc = GetDC(hwnd);

    EnumFontFamilies(hdc, NULL, (FONTENUMPROC) WinFontFamilyEnumProc,
	    (LPARAM) interp);
    ReleaseDC(hwnd, hdc);


}


/* ARGSUSED */

static int CALLBACK
WinFontFamilyEnumProc(elfPtr, ntmPtr, fontType, lParam)
    ENUMLOGFONT *elfPtr;	/* Logical-font data. */
    NEWTEXTMETRIC *ntmPtr;	/* Physical-font data (not used). */
    int fontType;		/* Type of font (not used). */
    LPARAM lParam;		/* Interp to hold result. */
{



    Tcl_Interp *interp;

    interp = (Tcl_Interp *) lParam;
    Tcl_AppendElement(interp, elfPtr->elfLogFont.lfFaceName);





    return 1;
}






































/*
 *---------------------------------------------------------------------------
 *
 *  Tk_MeasureChars --
 *
 *	Determine the number of characters from the string that will fit
 *	in the given horizontal span.  The measurement is done under the
 *	assumption that Tk_DrawChars() will be used to actually display
 *	the characters.
 *
 * Results:
 *	The return value is the number of characters from source that
 *	fit into the span that extends from 0 to maxLength.  *lengthPtr is
 *	filled with the x-coordinate of the right edge of the last
 *	character that did fit.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr)
    Tk_Font tkfont;		/* Font in which characters will be drawn. */
    CONST char *source;		/* Characters to be displayed.  Need not be
				 * '\0' terminated. */
    int numChars;		/* Maximum number of characters to consider
				 * from source string. */
    int maxLength;		/* If > 0, maxLength specifies the longest
				 * permissible line length; don't consider any
				 * character that would cross this
				 * x-position.  If <= 0, then line length is
				 * unbounded and the flags argument is
				 * ignored. */
    int flags;			/* Various flag bits OR-ed together:
				 * TK_PARTIAL_OK means include the last char
				 * which only partially fit on this line.
				 * TK_WHOLE_WORDS means stop on a word
				 * boundary, if possible.
				 * TK_AT_LEAST_ONE means return at least one
				 * character even if no characters fit. */
    int *lengthPtr;		/* Filled with x-location just after the
				 * terminating character. */
{
    WinFont *fontPtr;
    HDC hdc;
    HFONT hFont;

    int curX, curIdx;


    /*
     * On the authority of the Gates Empire, Windows does not use kerning
     * or fractional character widths when displaying text on the screen.
     * So that means we can safely measure individual characters or spans
     * of characters and add up the widths w/o any "off-by-one pixel" 
     * errors.  
     */

    fontPtr = (WinFont *) tkfont;

    hdc = GetDC(fontPtr->hwnd);

    hFont = SelectObject(hdc, fontPtr->hFont);

    if (numChars == 0) {
	curX = 0;
	curIdx = 0;
    } else if (maxLength <= 0) {

















































	SIZE size;

	GetTextExtentPoint(hdc, source, numChars, &size);
	curX = size.cx;
	curIdx = numChars;
    } else {
	int newX, termX, sawNonSpace;
	CONST char *term, *end, *p;







	int ch;




	ch = UCHAR(*source);
	newX = curX = termX = 0;
	
	term = source;
	end = source + numChars;

	sawNonSpace = !isspace(ch);
	for (p = source; ; ) {

	    newX += fontPtr->widths[ch];













	    if (newX > maxLength) {
		break;
	    }
	    curX = newX;
	    p++;
	    if (p >= end) {
		term = end;
		termX = curX;
		break;
	    }

	    ch = UCHAR(*p);
	    if (isspace(ch)) {
		if (sawNonSpace) {
		    term = p;
		    termX = curX;
		    sawNonSpace = 0;
		}
	    } else {
		sawNonSpace = 1;







|
|




<
|





|





|









|
|
|

|

|

|
|
>

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


|
|
|
|
|

>
>
>



|
>
>
>
>
>


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






|





|









>

|
|
|

|

|
|
|
|
|

|






|


<

|
>
|
>


|


|






>
|

|

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

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

|



|

|

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




|






|
|







434
435
436
437
438
439
440
441
442
443
444
445
446

447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504

505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609

610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687

688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
 * Side effects:
 *	TkFont is deallocated.
 *
 *---------------------------------------------------------------------------
 */

void
TkpDeleteFont(
    TkFont *tkFontPtr)		/* Token of font to be deleted. */
{
    WinFont *fontPtr;

    fontPtr = (WinFont *) tkFontPtr;

    ReleaseFont(fontPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkpGetFontFamilies, WinFontFamilyEnumProc --
 *
 *	Return information about the font families that are available
 *	on the display of the given window.
 *
 * Results:
 *	Modifies interp's result object to hold a list of all the available
 *	font families.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
 
void
TkpGetFontFamilies(
    Tcl_Interp *interp,		/* Interp to hold result. */
    Tk_Window tkwin)		/* For display to query. */
{    
    HDC hdc;
    HWND hwnd;
    Window window;

    window  = Tk_WindowId(tkwin);
    hwnd    = (window == None) ? NULL : TkWinGetHWND(window);
    hdc	    = GetDC(hwnd);

    /*
     * On any version NT, there may fonts with international names.  
     * Use the NT-only Unicode version of EnumFontFamilies to get the 
     * font names.  If we used the ANSI version on a non-internationalized 
     * version of NT, we would get font names with '?' replacing all 
     * the international characters.
     *
     * On a non-internationalized verson of 95, fonts with international
     * names are not allowed, so the ANSI version of EnumFontFamilies will 
     * work.  On an internationalized version of 95, there may be fonts with 
     * international names; the ANSI version will work, fetching the 
     * name in the system code page.  Can't use the Unicode version of 
     * EnumFontFamilies because it only exists under NT.
     */

    if (platformId == VER_PLATFORM_WIN32_NT) {
	EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontFamilyEnumProc,
		(LPARAM) interp);
    } else {
	EnumFontFamiliesA(hdc, NULL, (FONTENUMPROCA) WinFontFamilyEnumProc,
		(LPARAM) interp);
    }	    
    ReleaseDC(hwnd, hdc);
}


static int CALLBACK
WinFontFamilyEnumProc(
    ENUMLOGFONT *lfPtr,		/* Logical-font data. */
    NEWTEXTMETRIC *tmPtr,	/* Physical-font data (not used). */
    int fontType,		/* Type of font (not used). */
    LPARAM lParam)		/* Result object to hold result. */
{
    char *faceName;
    Tcl_DString faceString;
    Tcl_Obj *strPtr;
    Tcl_Interp *interp;

    interp = (Tcl_Interp *) lParam;
    faceName = lfPtr->elfLogFont.lfFaceName;
    Tcl_ExternalToUtfDString(systemEncoding, faceName, -1, &faceString);
    strPtr = Tcl_NewStringObj(Tcl_DStringValue(&faceString),
	    Tcl_DStringLength(&faceString));
    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), strPtr);
    Tcl_DStringFree(&faceString);
    return 1;
}

/*
 *-------------------------------------------------------------------------
 *
 * TkpGetSubFonts --
 *
 *	A function used by the testing package for querying the actual 
 *	screen fonts that make up a font object.
 *
 * Results:
 *	Modifies interp's result object to hold a list containing the 
 *	names of the screen fonts that make up the given font object.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */
	
void
TkpGetSubFonts(
    Tcl_Interp *interp,		/* Interp to hold result. */
    Tk_Font tkfont)		/* Font object to query. */
{
    int i;
    WinFont *fontPtr;
    FontFamily *familyPtr;
    Tcl_Obj *resultPtr, *strPtr;

    resultPtr = Tcl_GetObjResult(interp);    
    fontPtr = (WinFont *) tkfont;
    for (i = 0; i < fontPtr->numSubFonts; i++) {
	familyPtr = fontPtr->subFontArray[i].familyPtr;
	strPtr = Tcl_NewStringObj(familyPtr->faceName, -1);
	Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 *  Tk_MeasureChars --
 *
 *	Determine the number of bytes from the string that will fit
 *	in the given horizontal span.  The measurement is done under the
 *	assumption that Tk_DrawChars() will be used to actually display
 *	the characters.
 *
 * Results:
 *	The return value is the number of bytes from source that
 *	fit into the span that extends from 0 to maxLength.  *lengthPtr is
 *	filled with the x-coordinate of the right edge of the last
 *	character that did fit.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
Tk_MeasureChars(
    Tk_Font tkfont,		/* Font in which characters will be drawn. */
    CONST char *source,		/* UTF-8 string to be displayed.  Need not be
				 * '\0' terminated. */
    int numBytes,		/* Maximum number of bytes to consider
				 * from source string. */
    int maxLength,		/* If >= 0, maxLength specifies the longest
				 * permissible line length in pixels; don't
				 * consider any character that would cross
				 * this x-position.  If < 0, then line length
				 * is unbounded and the flags argument is
				 * ignored. */
    int flags,			/* Various flag bits OR-ed together:
				 * TK_PARTIAL_OK means include the last char
				 * which only partially fit on this line.
				 * TK_WHOLE_WORDS means stop on a word
				 * boundary, if possible.
				 * TK_AT_LEAST_ONE means return at least one
				 * character even if no characters fit. */
    int *lengthPtr)		/* Filled with x-location just after the
				 * terminating character. */
{

    HDC hdc;
    HFONT oldFont;
    WinFont *fontPtr;
    int curX, curByte;
    SubFont *lastSubFontPtr;

    /*
     * According to Microsoft tech support, Windows does not use kerning
     * or fractional character widths when displaying text on the screen.
     * So that means we can safely measure individual characters or spans
     * of characters and add up the widths w/o any "off-by-one-pixel" 
     * errors.  
     */

    fontPtr = (WinFont *) tkfont;

    hdc = GetDC(fontPtr->hwnd);
    lastSubFontPtr = &fontPtr->subFontArray[0];
    oldFont = SelectObject(hdc, lastSubFontPtr->hFont);

    if (numBytes == 0) {
	curX = 0;
	curByte = 0;
    } else if (maxLength < 0) {				 
	Tcl_UniChar ch;
	SIZE size;
	FontFamily *familyPtr;
	Tcl_DString runString;
	SubFont *thisSubFontPtr;
	CONST char *p, *end, *next;

    	/*
    	 * A three step process:
    	 * 1. Find a contiguous range of characters that can all be 
    	 *    represented by a single screen font.
    	 * 2. Convert those chars to the encoding of that font.
	 * 3. Measure converted chars.
    	 */

        curX = 0;
        end = source + numBytes;
        for (p = source; p < end; ) {
            next = p + Tcl_UtfToUniChar(p, &ch);
            thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
            if (thisSubFontPtr != lastSubFontPtr) {
		familyPtr = lastSubFontPtr->familyPtr;
		Tcl_UtfToExternalDString(familyPtr->encoding, source, 
			p - source, &runString);
		(*familyPtr->getTextExtentPoint32Proc)(hdc, 
			Tcl_DStringValue(&runString),
			Tcl_DStringLength(&runString) >> familyPtr->isWideFont, 
			&size);
		curX += size.cx;
		Tcl_DStringFree(&runString);
                lastSubFontPtr = thisSubFontPtr;
                source = p;

		SelectObject(hdc, lastSubFontPtr->hFont);
            }
            p = next;
        }
	familyPtr = lastSubFontPtr->familyPtr;
	Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source, 
		&runString);
	(*familyPtr->getTextExtentPoint32Proc)(hdc,
		Tcl_DStringValue(&runString),
		Tcl_DStringLength(&runString) >> familyPtr->isWideFont, 
		&size);
	curX += size.cx;
	Tcl_DStringFree(&runString);
	curByte = numBytes;
    } else {
	Tcl_UniChar ch;
	SIZE size;
	char buf[16];
	FontFamily *familyPtr;
	SubFont *thisSubFontPtr;
	CONST char *term, *end, *p, *next;

	int newX, termX, sawNonSpace, srcRead, dstWrote;

	/*
	 * How many chars will fit in the space allotted? 
	 * This first version may be inefficient because it measures
	 * every character individually.  There is a function call that
	 * can measure multiple characters at once and return the
	 * offset of each of them, but it only works on NT, even though
	 * the documentation claims it works for 95.
	 * TODO: verify that GetTextExtentExPoint is still broken in '95, and
	 * possibly use it for NT anyway since it should be much faster and
	 * more accurate.
	 */

	next = source + Tcl_UtfToUniChar(source, &ch);
	newX = curX = termX = 0;
	
	term = source;
	end = source + numBytes;

	sawNonSpace = (ch > 255) || !isspace(ch);
	for (p = source; ; ) {
	    if (ch < BASE_CHARS) {
		newX += fontPtr->widths[ch];
	    } else {
		thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
		if (thisSubFontPtr != lastSubFontPtr) {
		    SelectObject(hdc, thisSubFontPtr->hFont);
		    lastSubFontPtr = thisSubFontPtr;
		}
		familyPtr = lastSubFontPtr->familyPtr;
		Tcl_UtfToExternal(NULL, familyPtr->encoding, p, next - p, 
			0, NULL, buf, sizeof(buf), &srcRead, &dstWrote, NULL);
		(*familyPtr->getTextExtentPoint32Proc)(hdc, buf, 
			dstWrote >> familyPtr->isWideFont, &size);
		newX += size.cx;
	    }
	    if (newX > maxLength) {
		break;
	    }
	    curX = newX;
	    p = next;
	    if (p >= end) {
		term = end;
		termX = curX;
		break;
	    }

	    next += Tcl_UtfToUniChar(next, &ch);
	    if ((ch < 256) && isspace(ch)) {
		if (sawNonSpace) {
		    term = p;
		    termX = curX;
		    sawNonSpace = 0;
		}
	    } else {
		sawNonSpace = 1;
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
	    /*
	     * Include the first character that didn't quite fit in the desired
	     * span.  The width returned will include the width of that extra
	     * character.
	     */

	    curX = newX;
	    p++;
	}
	if ((flags & TK_AT_LEAST_ONE) && (term == source) && (p < end)) {
	    term = p;
	    termX = curX;
	    if (term == source) {
		term++;
		termX = newX;
	    }
	} else if ((p >= end) || !(flags & TK_WHOLE_WORDS)) {
	    term = p;
	    termX = curX;
	}

	curX = termX;
	curIdx = term - source;	
    }

    SelectObject(hdc, hFont);
    ReleaseDC(fontPtr->hwnd, hdc);

    *lengthPtr = curX;
    return curIdx;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_DrawChars --
 *
 *	Draw a string of characters on the screen.  
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Information gets drawn on the screen.
 *
 *---------------------------------------------------------------------------
 */

void
Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y)
    Display *display;		/* Display on which to draw. */
    Drawable drawable;		/* Window or pixmap in which to draw. */
    GC gc;			/* Graphics context for drawing characters. */
    Tk_Font tkfont;		/* Font in which characters will be drawn;
				 * must be the same as font used in GC. */
    CONST char *source;		/* Characters to be displayed.  Need not be
				 * '\0' terminated.  All Tk meta-characters
				 * (tabs, control characters, and newlines)
				 * should be stripped out of the string that
				 * is passed to this function.  If they are
				 * not stripped out, they will be displayed as
				 * regular printing characters. */
    int numChars;		/* Number of characters in string. */
    int x, y;			/* Coordinates at which to place origin of
				 * string when drawing. */
{
    HDC dc;
    HFONT hFont;
    TkWinDCState state;
    WinFont *fontPtr;

    fontPtr = (WinFont *) gc->font;
    display->request++;

    if (drawable == None) {
	return;
    }







|





|








|


|



|



















|
|
|
|
|

|






|
|



|

<







754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822

823
824
825
826
827
828
829
	    /*
	     * Include the first character that didn't quite fit in the desired
	     * span.  The width returned will include the width of that extra
	     * character.
	     */

	    curX = newX;
	    p += Tcl_UtfToUniChar(p, &ch);
	}
	if ((flags & TK_AT_LEAST_ONE) && (term == source) && (p < end)) {
	    term = p;
	    termX = curX;
	    if (term == source) {
		term += Tcl_UtfToUniChar(term, &ch);
		termX = newX;
	    }
	} else if ((p >= end) || !(flags & TK_WHOLE_WORDS)) {
	    term = p;
	    termX = curX;
	}

	curX = termX;
	curByte = term - source;	
    }

    SelectObject(hdc, oldFont);
    ReleaseDC(fontPtr->hwnd, hdc);

    *lengthPtr = curX;
    return curByte;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_DrawChars --
 *
 *	Draw a string of characters on the screen.  
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Information gets drawn on the screen.
 *
 *---------------------------------------------------------------------------
 */

void
Tk_DrawChars(
    Display *display,		/* Display on which to draw. */
    Drawable drawable,		/* Window or pixmap in which to draw. */
    GC gc,			/* Graphics context for drawing characters. */
    Tk_Font tkfont,		/* Font in which characters will be drawn;
				 * must be the same as font used in GC. */
    CONST char *source,		/* UTF-8 string to be displayed.  Need not be
				 * '\0' terminated.  All Tk meta-characters
				 * (tabs, control characters, and newlines)
				 * should be stripped out of the string that
				 * is passed to this function.  If they are
				 * not stripped out, they will be displayed as
				 * regular printing characters. */
    int numBytes,		/* Number of bytes in string. */
    int x, int y)		/* Coordinates at which to place origin of
				 * string when drawing. */
{
    HDC dc;
    WinFont *fontPtr;
    TkWinDCState state;


    fontPtr = (WinFont *) gc->font;
    display->request++;

    if (drawable == None) {
	return;
    }
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553













































554
555





















556
557










558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576



577
578
579
580
581
582
583
584
585
586


587
588
589
590
591
592

593

594
595
596
597
598
599



600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616






617















618
619
620
621
622
623
624
625
626
627
628























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































629




630

631




632



633



634











































































635
636



637
638












639



640





641




642



643











	
	dcMem = CreateCompatibleDC(dc);

	stipple = CreatePatternBrush(twdPtr->bitmap.handle);
	SetBrushOrgEx(dc, gc->ts_x_origin, gc->ts_y_origin, NULL);
	oldBrush = SelectObject(dc, stipple);

	SetTextAlign(dcMem, TA_LEFT | TA_TOP);
	SetTextColor(dcMem, gc->foreground);
	SetBkMode(dcMem, TRANSPARENT);
	SetBkColor(dcMem, RGB(0, 0, 0));

        hFont = SelectObject(dcMem, fontPtr->hFont);

	/*
	 * Compute the bounding box and create a compatible bitmap.
	 */

	GetTextExtentPoint(dcMem, source, numChars, &size);
	GetTextMetrics(dcMem, &tm);
	size.cx -= tm.tmOverhang;
	bitmap = CreateCompatibleBitmap(dc, size.cx, size.cy);
	oldBitmap = SelectObject(dcMem, bitmap);

	/*
	 * The following code is tricky because fonts are rendered in multiple
	 * colors.  First we draw onto a black background and copy the white
	 * bits.  Then we draw onto a white background and copy the black bits.
	 * Both the foreground and background bits of the font are ANDed with
	 * the stipple pattern as they are copied.
	 */

	PatBlt(dcMem, 0, 0, size.cx, size.cy, BLACKNESS);
	TextOut(dcMem, 0, 0, source, numChars);
	BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem,
		0, 0, 0xEA02E9);
	PatBlt(dcMem, 0, 0, size.cx, size.cy, WHITENESS);
	TextOut(dcMem, 0, 0, source, numChars);
	BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem,
		0, 0, 0x8A0E06);

	/*
	 * Destroy the temporary bitmap and restore the device context.
	 */

        SelectObject(dcMem, hFont);
	SelectObject(dcMem, oldBitmap);
	DeleteObject(bitmap);
	DeleteDC(dcMem);
	SelectObject(dc, oldBrush);
	DeleteObject(stipple);
    } else {
	SetTextAlign(dc, TA_LEFT | TA_BASELINE);
	SetTextColor(dc, gc->foreground);
	SetBkMode(dc, TRANSPARENT);













































	hFont = SelectObject(dc, fontPtr->hFont);
	TextOut(dc, x, y, source, numChars);





















        SelectObject(dc, hFont);
    }










    TkWinReleaseDrawableDC(drawable, dc, &state);
}

/*
 *---------------------------------------------------------------------------
 *
 * AllocFont --
 *
 *	Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
 *	Allocates and intializes the memory for a new TkFont that
 *	wraps the platform-specific data.
 *
 * Results:
 *	Returns pointer to newly constructed TkFont.  
 *
 *	The caller is responsible for initializing the fields of the
 *	TkFont that are used exclusively by the generic TkFont code, and
 *	for releasing those fields before calling TkpDeleteFont().
 *



 * Side effects:
 *	Memory allocated.
 *
 *---------------------------------------------------------------------------
 */ 

static TkFont *
AllocFont(tkFontPtr, tkwin, hFont)
    TkFont *tkFontPtr;		/* If non-NULL, store the information in
				 * this existing TkFont structure, rather than


				 * allocating a new structure to hold the
				 * font; the existing contents of the font
				 * will be released.  If NULL, a new TkFont
				 * structure is allocated. */
    Tk_Window tkwin;		/* For display where font will be used. */
    HFONT hFont;		/* Windows information about font. */

{

    HWND hwnd;
    WinFont *fontPtr;
    HDC hdc;
    TEXTMETRIC tm;
    Window window;
    char buf[LF_FACESIZE];



    TkFontAttributes *faPtr;

    if (tkFontPtr != NULL) {
        fontPtr = (WinFont *) tkFontPtr;
        DeleteObject(fontPtr->hFont);
    } else {
        fontPtr = (WinFont *) ckalloc(sizeof(WinFont));
    }
    
    window = Tk_WindowId(((TkWindow *) tkwin)->mainPtr->winPtr);
    hwnd = (window == None) ? NULL : TkWinGetHWND(window);

    hdc = GetDC(hwnd);
    hFont = SelectObject(hdc, hFont);
    GetTextFace(hdc, sizeof(buf), buf);
    GetTextMetrics(hdc, &tm);
    GetCharWidth(hdc, 0, 255, fontPtr->widths);






















    fontPtr->font.fid	= (Font) fontPtr;

    faPtr = &fontPtr->font.fa;
    faPtr->family	= Tk_GetUid(buf);
    faPtr->pointsize	= MulDiv(tm.tmHeight - tm.tmInternalLeading,
	    720 * WidthMMOfScreen(Tk_Screen(tkwin)),
	    254 * WidthOfScreen(Tk_Screen(tkwin)));
    faPtr->weight	= (tm.tmWeight > FW_MEDIUM) ? TK_FW_BOLD : TK_FW_NORMAL;
    faPtr->slant	= (tm.tmItalic != 0) ? TK_FS_ITALIC : TK_FS_ROMAN;
    faPtr->underline	= (tm.tmUnderlined != 0) ? 1 : 0;
    faPtr->overstrike	= (tm.tmStruckOut != 0) ? 1 : 0;




























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































    fontPtr->font.fm.ascent	= tm.tmAscent;

    fontPtr->font.fm.descent	= tm.tmDescent;




    fontPtr->font.fm.maxWidth	= tm.tmMaxCharWidth;



    fontPtr->font.fm.fixed	= !(tm.tmPitchAndFamily & TMPF_FIXED_PITCH);















































































    hFont = SelectObject(hdc, hFont);
    ReleaseDC(hwnd, hdc);




    fontPtr->hFont		= hFont;












    fontPtr->hwnd		= hwnd;









    return (TkFont *) fontPtr;




}






















|




<
<




|














|



|







<









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





|


|
|

<
<
<

|


>
>
>






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

>

|
<


<
>
>
>

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

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


|
|
|
<
<



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

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

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

>
>
>
>
>
>
>
>
>
>
>
852
853
854
855
856
857
858
859
860
861
862
863


864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894

895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995



996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016

1017

1018
1019
1020
1021
1022
1023

1024
1025

1026
1027
1028
1029
1030





1031
1032

1033

1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065


1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
	
	dcMem = CreateCompatibleDC(dc);

	stipple = CreatePatternBrush(twdPtr->bitmap.handle);
	SetBrushOrgEx(dc, gc->ts_x_origin, gc->ts_y_origin, NULL);
	oldBrush = SelectObject(dc, stipple);

	SetTextAlign(dcMem, TA_LEFT | TA_BASELINE);
	SetTextColor(dcMem, gc->foreground);
	SetBkMode(dcMem, TRANSPARENT);
	SetBkColor(dcMem, RGB(0, 0, 0));



	/*
	 * Compute the bounding box and create a compatible bitmap.
	 */

	GetTextExtentPoint(dcMem, source, numBytes, &size);
	GetTextMetrics(dcMem, &tm);
	size.cx -= tm.tmOverhang;
	bitmap = CreateCompatibleBitmap(dc, size.cx, size.cy);
	oldBitmap = SelectObject(dcMem, bitmap);

	/*
	 * The following code is tricky because fonts are rendered in multiple
	 * colors.  First we draw onto a black background and copy the white
	 * bits.  Then we draw onto a white background and copy the black bits.
	 * Both the foreground and background bits of the font are ANDed with
	 * the stipple pattern as they are copied.
	 */

	PatBlt(dcMem, 0, 0, size.cx, size.cy, BLACKNESS);
	MultiFontTextOut(dc, fontPtr, source, numBytes, x, y);
	BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem,
		0, 0, 0xEA02E9);
	PatBlt(dcMem, 0, 0, size.cx, size.cy, WHITENESS);
	MultiFontTextOut(dc, fontPtr, source, numBytes, x, y);
	BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem,
		0, 0, 0x8A0E06);

	/*
	 * Destroy the temporary bitmap and restore the device context.
	 */


	SelectObject(dcMem, oldBitmap);
	DeleteObject(bitmap);
	DeleteDC(dcMem);
	SelectObject(dc, oldBrush);
	DeleteObject(stipple);
    } else {
	SetTextAlign(dc, TA_LEFT | TA_BASELINE);
	SetTextColor(dc, gc->foreground);
	SetBkMode(dc, TRANSPARENT);
	MultiFontTextOut(dc, fontPtr, source, numBytes, x, y);
    }
    TkWinReleaseDrawableDC(drawable, dc, &state);
}

/*
 *-------------------------------------------------------------------------
 *
 * MultiFontTextOut --
 *
 *	Helper function for Tk_DrawChars.  Draws characters, using the 
 *	various screen fonts in fontPtr to draw multilingual characters.
 *	Note: No bidirectional support.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Information gets drawn on the screen.  
 *	Contents of fontPtr may be modified if more subfonts were loaded 
 *	in order to draw all the multilingual characters in the given 
 *	string.
 *
 *-------------------------------------------------------------------------
 */

static void
MultiFontTextOut(
    HDC hdc,			/* HDC to draw into. */
    WinFont *fontPtr,		/* Contains set of fonts to use when drawing
				 * following string. */
    CONST char *source,		/* Potentially multilingual UTF-8 string. */
    int numBytes,		/* Length of string in bytes. */
    int x, int y)		/* Coordinates at which to place origin *
				 * of string when drawing. */
{
    Tcl_UniChar ch;
    SIZE size;
    HFONT oldFont;
    FontFamily *familyPtr;
    Tcl_DString runString;
    CONST char *p, *end, *next;
    SubFont *lastSubFontPtr, *thisSubFontPtr;

    lastSubFontPtr = &fontPtr->subFontArray[0];
    oldFont = SelectObject(hdc, lastSubFontPtr->hFont);

    end = source + numBytes;
    for (p = source; p < end; ) {
        next = p + Tcl_UtfToUniChar(p, &ch);
        thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
        if (thisSubFontPtr != lastSubFontPtr) {
            if (p > source) {
		familyPtr = lastSubFontPtr->familyPtr;
 		Tcl_UtfToExternalDString(familyPtr->encoding, source,
			p - source, &runString);
		(*familyPtr->textOutProc)(hdc, x, y, 
			Tcl_DStringValue(&runString),
			Tcl_DStringLength(&runString) >> familyPtr->isWideFont);
		(*familyPtr->getTextExtentPoint32Proc)(hdc, 
			Tcl_DStringValue(&runString),
			Tcl_DStringLength(&runString) >> familyPtr->isWideFont, 
			&size);
		x += size.cx;
		Tcl_DStringFree(&runString);
	    }
            lastSubFontPtr = thisSubFontPtr;
            source = p;
	    SelectObject(hdc, lastSubFontPtr->hFont);
	}
	p = next;
    }
    if (p > source) {
	familyPtr = lastSubFontPtr->familyPtr;
 	Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source,
		&runString);
	(*familyPtr->textOutProc)(hdc, x, y, Tcl_DStringValue(&runString),
		Tcl_DStringLength(&runString) >> familyPtr->isWideFont);
	Tcl_DStringFree(&runString);
    }
    SelectObject(hdc, oldFont);
}

/*
 *---------------------------------------------------------------------------
 *
 * InitFont --
 *
 *	Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
 *	Initializes the memory for a new WinFont that wraps the 
 *	platform-specific data.
 *



 *	The caller is responsible for initializing the fields of the
 *	WinFont that are used exclusively by the generic TkFont code, and
 *	for releasing those fields before calling TkpDeleteFont().
 *
 * Results:
 *	Fills the WinFont structure.
 *
 * Side effects:
 *	Memory allocated.
 *
 *---------------------------------------------------------------------------
 */ 

static void
InitFont(
    Tk_Window tkwin,		/* Main window of interp in which font will 
				 * be used, for getting HDC. */
    HFONT hFont,		/* Windows token for font. */
    int overstrike,		/* The overstrike attribute of logfont used
				 * to allocate this font.  For some reason,
				 * the TEXTMETRICs may contain incorrect info

				 * in the tmStruckOut field. */

    WinFont *fontPtr)		/* Filled with information constructed from
				 * the above arguments. */
{
    HDC hdc;
    HWND hwnd;
    HFONT oldFont;

    TEXTMETRIC tm;
    Window window;

    TkFontMetrics *fmPtr;
    Tcl_Encoding encoding;
    Tcl_DString faceString;
    TkFontAttributes *faPtr;
    char buf[LF_FACESIZE * sizeof(WCHAR)];





 
    window  = Tk_WindowId(tkwin);

    hwnd    = (window == None) ? NULL : TkWinGetHWND(window);

    hdc	    = GetDC(hwnd);
    oldFont = SelectObject(hdc, hFont);

    GetTextMetrics(hdc, &tm);

    /*
     * On any version NT, there may fonts with international names.  
     * Use the NT-only Unicode version of GetTextFace to get the font's 
     * name.  If we used the ANSI version on a non-internationalized 
     * version of NT, we would get a font name with '?' replacing all 
     * the international characters.
     *
     * On a non-internationalized verson of 95, fonts with international
     * names are not allowed, so the ANSI version of GetTextFace will work.
     * On an internationalized version of 95, there may be fonts with 
     * international names; the ANSI version will work, fetching the 
     * name in the international system code page.  Can't use the Unicode 
     * version of GetTextFace because it only exists under NT.
     */

    if (platformId == VER_PLATFORM_WIN32_NT) {
	GetTextFaceW(hdc, LF_FACESIZE, (WCHAR *) buf);
    } else {
	GetTextFaceA(hdc, LF_FACESIZE, (char *) buf);
    }
    Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString);

    fontPtr->font.fid	= (Font) fontPtr;

    faPtr		= &fontPtr->font.fa;
    faPtr->family	= Tk_GetUid(Tcl_DStringValue(&faceString));
    faPtr->size		= TkFontGetPoints(tkwin, -(tm.tmHeight - tm.tmInternalLeading));


    faPtr->weight	= (tm.tmWeight > FW_MEDIUM) ? TK_FW_BOLD : TK_FW_NORMAL;
    faPtr->slant	= (tm.tmItalic != 0) ? TK_FS_ITALIC : TK_FS_ROMAN;
    faPtr->underline	= (tm.tmUnderlined != 0) ? 1 : 0;
    faPtr->overstrike	= overstrike;
    
    fmPtr		= &fontPtr->font.fm;
    fmPtr->ascent	= tm.tmAscent;
    fmPtr->descent	= tm.tmDescent;
    fmPtr->maxWidth	= tm.tmMaxCharWidth;
    fmPtr->fixed	= !(tm.tmPitchAndFamily & TMPF_FIXED_PITCH);

    fontPtr->hwnd	= hwnd;
    fontPtr->pixelSize	= tm.tmHeight - tm.tmInternalLeading;

    fontPtr->numSubFonts 	= 1;
    fontPtr->subFontArray	= fontPtr->staticSubFonts;
    InitSubFont(hdc, hFont, 1, &fontPtr->subFontArray[0]);

    encoding = fontPtr->subFontArray[0].familyPtr->encoding;
    if (encoding == unicodeEncoding) {
	GetCharWidthW(hdc, 0, BASE_CHARS - 1, fontPtr->widths);
    } else {
	GetCharWidthA(hdc, 0, BASE_CHARS - 1, fontPtr->widths);
    } 
    Tcl_DStringFree(&faceString);

    SelectObject(hdc, oldFont);
    ReleaseDC(hwnd, hdc);
}

/*
 *-------------------------------------------------------------------------
 *
 * ReleaseFont --
 * 
 *	Called to release the windows-specific contents of a TkFont.
 *	The caller is responsible for freeing the memory used by the
 *	font itself.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is freed.
 *
 *---------------------------------------------------------------------------
 */
 
static void
ReleaseFont(
    WinFont *fontPtr)		/* The font to delete. */
{
    int i;

    for (i = 0; i < fontPtr->numSubFonts; i++) {
	ReleaseSubFont(&fontPtr->subFontArray[i]);
    }
    if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
	ckfree((char *) fontPtr->subFontArray);
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * InitSubFont --
 *
 *	Wrap a screen font and load the FontFamily that represents
 *	it.  Used to prepare a SubFont so that characters can be mapped
 *	from UTF-8 to the charset of the font.
 *
 * Results:
 *	The subFontPtr is filled with information about the font.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static void
InitSubFont(
    HDC hdc,			/* HDC in which font can be selected. */
    HFONT hFont,		/* The screen font. */
    int base,			/* Non-zero if this SubFont is being used
				 * as the base font for a font object. */
    SubFont *subFontPtr)	/* Filled with SubFont constructed from 
    				 * above attributes. */
{
    subFontPtr->hFont	    = hFont;
    subFontPtr->familyPtr   = AllocFontFamily(hdc, hFont, base);
    subFontPtr->fontMap	    = subFontPtr->familyPtr->fontMap;
}

/*
 *-------------------------------------------------------------------------
 *
 * ReleaseSubFont --
 *
 *	Called to release the contents of a SubFont.  The caller is 
 *	responsible for freeing the memory used by the SubFont itself.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory and resources are freed.
 *
 *---------------------------------------------------------------------------
 */

static void
ReleaseSubFont(
    SubFont *subFontPtr)	/* The SubFont to delete. */
{
    DeleteObject(subFontPtr->hFont);
    FreeFontFamily(subFontPtr->familyPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * AllocFontFamily --
 *
 *	Find the FontFamily structure associated with the given font
 *	name.  The information should be stored by the caller in a 
 *	SubFont and used when determining if that SubFont supports a 
 *	character.
 *
 *	Cannot use the string name used to construct the font as the 
 *	key, because the capitalization may not be canonical.  Therefore
 *	use the face name actually retrieved from the font metrics as
 *	the key.
 *
 * Results:
 *	A pointer to a FontFamily.  The reference count in the FontFamily
 *	is automatically incremented.  When the SubFont is released, the
 *	reference count is decremented.  When no SubFont is using this
 *	FontFamily, it may be deleted.
 *
 * Side effects:
 *	A new FontFamily structure will be allocated if this font family
 *	has not been seen.  TrueType character existence metrics are
 *	loaded into the FontFamily structure.
 *
 *-------------------------------------------------------------------------
 */

static FontFamily *
AllocFontFamily(
    HDC hdc,			/* HDC in which font can be selected. */
    HFONT hFont,		/* Screen font whose FontFamily is to be
				 * returned. */
    int base)			/* Non-zero if this font family is to be
				 * used in the base font of a font object. */
{
    Tk_Uid faceName;
    FontFamily *familyPtr;
    Tcl_DString faceString;
    Tcl_Encoding encoding;
    char buf[LF_FACESIZE * sizeof(WCHAR)];
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    hFont = SelectObject(hdc, hFont);
    if (platformId == VER_PLATFORM_WIN32_NT) {
	GetTextFaceW(hdc, LF_FACESIZE, (WCHAR *) buf);
    } else {
	GetTextFaceA(hdc, LF_FACESIZE, (char *) buf);
    }
    Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString);
    faceName = Tk_GetUid(Tcl_DStringValue(&faceString));
    Tcl_DStringFree(&faceString);
    hFont = SelectObject(hdc, hFont);

    familyPtr = tsdPtr->fontFamilyList; 
    for ( ; familyPtr != NULL; familyPtr = familyPtr->nextPtr) {
	if (familyPtr->faceName == faceName) {
	    familyPtr->refCount++;
	    return familyPtr;
	}
    }

    familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily));
    memset(familyPtr, 0, sizeof(FontFamily));
    familyPtr->nextPtr = tsdPtr->fontFamilyList;
    tsdPtr->fontFamilyList = familyPtr;

    /* 
     * Set key for this FontFamily. 
     */

    familyPtr->faceName = faceName;

    /* 
     * An initial refCount of 2 means that FontFamily information will
     * persist even when the SubFont that loaded the FontFamily is released.
     * Change it to 1 to cause FontFamilies to be unloaded when not in use.
     */

    familyPtr->refCount = 2;

    familyPtr->segCount = LoadFontRanges(hdc, hFont, &familyPtr->startCount, 
	    &familyPtr->endCount, &familyPtr->isSymbolFont);

    encoding = NULL;
    if (familyPtr->isSymbolFont != 0) {
	/*
	 * Symbol fonts are handled specially.  For instance, Unicode 0393
	 * (GREEK CAPITAL GAMMA) must be mapped to Symbol character 0047
	 * (GREEK CAPITAL GAMMA), because the Symbol font doesn't have a
	 * GREEK CAPITAL GAMMA at location 0393.  If Tk interpreted the
	 * Symbol font using the Unicode encoding, it would decide that
	 * the Symbol font has no GREEK CAPITAL GAMMA, because the Symbol
	 * encoding (of course) reports that character 0393 doesn't exist.  
	 *
	 * With non-symbol Windows fonts, such as Times New Roman, if the
	 * font has a GREEK CAPITAL GAMMA, it will be found in the correct
	 * Unicode location (0393); the GREEK CAPITAL GAMMA will not be off
	 * hiding at some other location.
	 */

	encoding = Tcl_GetEncoding(NULL, faceName);
    }

    if (encoding == NULL) {
	encoding = Tcl_GetEncoding(NULL, "unicode");
	familyPtr->textOutProc =
	    (BOOL (WINAPI *)(HDC, int, int, TCHAR *, int)) TextOutW;
	familyPtr->getTextExtentPoint32Proc = 
	    (BOOL (WINAPI *)(HDC, TCHAR *, int, LPSIZE)) GetTextExtentPoint32W;
	familyPtr->isWideFont = 1;
    } else {
	familyPtr->textOutProc = 
	    (BOOL (WINAPI *)(HDC, int, int, TCHAR *, int)) TextOutA;
	familyPtr->getTextExtentPoint32Proc = 
	    (BOOL (WINAPI *)(HDC, TCHAR *, int, LPSIZE)) GetTextExtentPoint32A;
	familyPtr->isWideFont = 0;
    } 

    familyPtr->encoding = encoding;

    return familyPtr;
}

/*
 *-------------------------------------------------------------------------
 *
 * FreeFontFamily --
 *
 *	Called to free a FontFamily when the SubFont is finished using it.
 *	Frees the contents of the FontFamily and the memory used by the
 *	FontFamily itself.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */
 
static void
FreeFontFamily(
    FontFamily *familyPtr)	/* The FontFamily to delete. */
{
    int i;
    FontFamily **familyPtrPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (familyPtr == NULL) {
        return;
    }
    familyPtr->refCount--;
    if (familyPtr->refCount > 0) {
    	return;
    }
    for (i = 0; i < FONTMAP_PAGES; i++) {
        if (familyPtr->fontMap[i] != NULL) {
            ckfree(familyPtr->fontMap[i]);
        }
    }
    if (familyPtr->startCount != NULL) {
	ckfree((char *) familyPtr->startCount);
    }
    if (familyPtr->endCount != NULL) {
	ckfree((char *) familyPtr->endCount);
    }
    if (familyPtr->encoding != unicodeEncoding) {
	Tcl_FreeEncoding(familyPtr->encoding);
    }
    
    /* 
     * Delete from list. 
     */
         
    for (familyPtrPtr = &tsdPtr->fontFamilyList; ; ) {
        if (*familyPtrPtr == familyPtr) {
  	    *familyPtrPtr = familyPtr->nextPtr;
	    break;
	}
	familyPtrPtr = &(*familyPtrPtr)->nextPtr;
    }
    
    ckfree((char *) familyPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * FindSubFontForChar --
 *
 *	Determine which screen font is necessary to use to display the 
 *	given character.  If the font object does not have a screen font 
 *	that can display the character, another screen font may be loaded 
 *	into the font object, following a set of preferred fallback rules.
 *
 * Results:
 *	The return value is the SubFont to use to display the given 
 *	character. 
 *
 * Side effects:
 *	The contents of fontPtr are modified to cache the results
 *	of the lookup and remember any SubFonts that were dynamically 
 *	loaded.
 *
 *-------------------------------------------------------------------------
 */

static SubFont *
FindSubFontForChar(
    WinFont *fontPtr,		/* The font object with which the character
				 * will be displayed. */
    int ch)			/* The Unicode character to be displayed. */
{
    HDC hdc;
    int i, j, k;
    CanUse canUse;
    char **aliases, **anyFallbacks;
    char ***fontFallbacks;
    char *fallbackName;
    SubFont *subFontPtr;
    Tcl_DString ds;
    
    if (ch < BASE_CHARS) {
	return &fontPtr->subFontArray[0];
    }

    for (i = 0; i < fontPtr->numSubFonts; i++) {
	if (FontMapLookup(&fontPtr->subFontArray[i], ch)) {
	    return &fontPtr->subFontArray[i];
	}
    }

    /*
     * Keep track of all face names that we check, so we don't check some
     * name multiple times if it can be reached by multiple paths.
     */
     
    Tcl_DStringInit(&ds);
    hdc = GetDC(fontPtr->hwnd);
        
    aliases = TkFontGetAliasList(fontPtr->font.fa.family);

    fontFallbacks = TkFontGetFallbacks();
    for (i = 0; fontFallbacks[i] != NULL; i++) {
	for (j = 0; fontFallbacks[i][j] != NULL; j++) {
	    fallbackName = fontFallbacks[i][j];
	    if (strcasecmp(fallbackName, fontPtr->font.fa.family) == 0) {
		/*
		 * If the base font has a fallback...
		 */

		goto tryfallbacks;
	    } else if (aliases != NULL) {
		/* 
		 * Or if an alias for the base font has a fallback...
		 */

		for (k = 0; aliases[k] != NULL; k++) {
		    if (strcasecmp(aliases[k], fallbackName) == 0) {
		        goto tryfallbacks;
		    }
		}
	    }
	}
	continue;

	/* 
	 * ...then see if we can use one of the fallbacks, or an
	 * alias for one of the fallbacks.
	 */

	tryfallbacks:
	for (j = 0; fontFallbacks[i][j] != NULL; j++) {
	    fallbackName = fontFallbacks[i][j];
	    subFontPtr = CanUseFallbackWithAliases(hdc, fontPtr, fallbackName,
		    ch, &ds);
	    if (subFontPtr != NULL) {
		goto end;
	    }
	}
    }

    /*
     * See if we can use something from the global fallback list. 
     */

    anyFallbacks = TkFontGetGlobalClass();
    for (i = 0; anyFallbacks[i] != NULL; i++) {
	fallbackName = anyFallbacks[i];
	subFontPtr = CanUseFallbackWithAliases(hdc, fontPtr, fallbackName, 
		ch, &ds);
	if (subFontPtr != NULL) {
	    goto end;
	}
    }

    /*
     * Try all face names available in the whole system until we
     * find one that can be used.
     */

    canUse.hdc = hdc;
    canUse.fontPtr = fontPtr;
    canUse.nameTriedPtr = &ds;
    canUse.ch = ch;
    canUse.subFontPtr = NULL;
    if (platformId == VER_PLATFORM_WIN32_NT) {
	EnumFontFamiliesW(hdc, NULL, (FONTENUMPROCW) WinFontCanUseProc,
		(LPARAM) &canUse);
    } else {
	EnumFontFamiliesA(hdc, NULL, (FONTENUMPROCA) WinFontCanUseProc,
		(LPARAM) &canUse);
    }
    subFontPtr = canUse.subFontPtr;

    end:
    Tcl_DStringFree(&ds);
    
    if (subFontPtr == NULL) {
        /* 
         * No font can display this character.  We will use the base font
         * and have it display the "unknown" character.
         */

	subFontPtr = &fontPtr->subFontArray[0];
        FontMapInsert(subFontPtr, ch);
    }
    ReleaseDC(fontPtr->hwnd, hdc);
    return subFontPtr;
}

static int CALLBACK
WinFontCanUseProc(
    ENUMLOGFONT *lfPtr,		/* Logical-font data. */
    NEWTEXTMETRIC *tmPtr,	/* Physical-font data (not used). */
    int fontType,		/* Type of font (not used). */
    LPARAM lParam)		/* Result object to hold result. */
{
    int ch;
    HDC hdc;
    WinFont *fontPtr;
    CanUse *canUsePtr;
    char *fallbackName;
    SubFont *subFontPtr;
    Tcl_DString faceString;
    Tcl_DString *nameTriedPtr;

    canUsePtr	    = (CanUse *) lParam;
    ch		    = canUsePtr->ch;
    hdc		    = canUsePtr->hdc;
    fontPtr	    = canUsePtr->fontPtr;
    nameTriedPtr    = canUsePtr->nameTriedPtr;

    fallbackName = lfPtr->elfLogFont.lfFaceName;
    Tcl_ExternalToUtfDString(systemEncoding, fallbackName, -1, &faceString);
    fallbackName = Tcl_DStringValue(&faceString);

    if (SeenName(fallbackName, nameTriedPtr) == 0) {
	subFontPtr = CanUseFallback(hdc, fontPtr, fallbackName, ch);
	if (subFontPtr != NULL) {
	    canUsePtr->subFontPtr = subFontPtr;
	    Tcl_DStringFree(&faceString);
	    return 0;
	}
    }
    Tcl_DStringFree(&faceString);
    return 1;
}

/*
 *-------------------------------------------------------------------------
 *
 * FontMapLookup --
 *
 *	See if the screen font can display the given character.
 *
 * Results:
 *	The return value is 0 if the screen font cannot display the
 *	character, non-zero otherwise.
 *
 * Side effects:
 *	New pages are added to the font mapping cache whenever the
 *	character belongs to a page that hasn't been seen before.
 *	When a page is loaded, information about all the characters on
 *	that page is stored, not just for the single character in
 *	question.
 *
 *-------------------------------------------------------------------------
 */

static int
FontMapLookup(
    SubFont *subFontPtr,	/* Contains font mapping cache to be queried
				 * and possibly updated. */
    int ch)			/* Character to be tested. */
{
    int row, bitOffset;

    row = ch >> FONTMAP_SHIFT;
    if (subFontPtr->fontMap[row] == NULL) {
	FontMapLoadPage(subFontPtr, row);
    }
    bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
    return (subFontPtr->fontMap[row][bitOffset >> 3] >> (bitOffset & 7)) & 1;
}

/*
 *-------------------------------------------------------------------------
 *
 * FontMapInsert --
 *
 *	Tell the font mapping cache that the given screen font should be
 *	used to display the specified character.  This is called when no
 *	font on the system can be be found that can display that 
 *	character; we lie to the font and tell it that it can display
 *	the character, otherwise we would end up re-searching the entire
 *	fallback hierarchy every time that character was seen.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	New pages are added to the font mapping cache whenever the
 *	character belongs to a page that hasn't been seen before.
 *	When a page is loaded, information about all the characters on
 *	that page is stored, not just for the single character in
 *	question.
 *
 *-------------------------------------------------------------------------
 */

static void
FontMapInsert(
    SubFont *subFontPtr,	/* Contains font mapping cache to be 
				 * updated. */
    int ch)			/* Character to be added to cache. */
{
    int row, bitOffset;

    row = ch >> FONTMAP_SHIFT;
    if (subFontPtr->fontMap[row] == NULL) {
	FontMapLoadPage(subFontPtr, row);
    }
    bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
    subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
}

/*
 *-------------------------------------------------------------------------
 *
 * FontMapLoadPage --
 *
 *	Load information about all the characters on a given page.
 *	This information consists of one bit per character that indicates
 *	whether the associated HFONT can (1) or cannot (0) display the
 *	characters on the page.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Mempry allocated.
 *
 *-------------------------------------------------------------------------
 */
static void 
FontMapLoadPage(
    SubFont *subFontPtr,	/* Contains font mapping cache to be 
				 * updated. */
    int row)			/* Index of the page to be loaded into 
				 * the cache. */
{
    FontFamily *familyPtr;
    Tcl_Encoding encoding;
    char src[TCL_UTF_MAX], buf[16];
    USHORT *startCount, *endCount;
    int i, j, bitOffset, end, segCount;

    subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8);
    memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8);

    familyPtr = subFontPtr->familyPtr;
    encoding = familyPtr->encoding;

    if (familyPtr->encoding == unicodeEncoding) {
	/*
	 * Font is Unicode.  Few fonts are going to have all characters, so 
	 * examine the TrueType character existence metrics to determine 
	 * what characters actually exist in this font.
	 */

	segCount    = familyPtr->segCount;
	startCount  = familyPtr->startCount;
	endCount    = familyPtr->endCount;

	j = 0;
	end = (row + 1) << FONTMAP_SHIFT;
	for (i = row << FONTMAP_SHIFT; i < end; i++) {
	    for ( ; j < segCount; j++) {
		if (endCount[j] >= i) {
		    if (startCount[j] <= i) {
			bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
			subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
		    }
		    break;
		}
	    }
	}
    } else if (familyPtr->isSymbolFont) {
	/*
	 * Assume that a symbol font with a known encoding has all the 
	 * characters that its encoding claims it supports.  
	 *	 
	 * The test for "encoding == unicodeEncoding"
	 * must occur before this case, to catch all symbol fonts (such 
	 * as {Comic Sans MS} or Wingdings) for which we don't have 
	 * encoding information; those symbol fonts are treated as if
	 * they were in the Unicode encoding and their symbolic
	 * character existence metrics are treated as if they were Unicode
	 * character existence metrics.  This way, although we don't know
	 * the proper Unicode -> symbol font mapping, we can install the
	 * symbol font as the base font and access its glyphs.
	 */

        end = (row + 1) << FONTMAP_SHIFT;
	for (i = row << FONTMAP_SHIFT; i < end; i++) {
	    if (Tcl_UtfToExternal(NULL, encoding, src, 
		    Tcl_UniCharToUtf(i, src), TCL_ENCODING_STOPONERROR, NULL, 
		    buf, sizeof(buf), NULL, NULL, NULL) != TCL_OK) {
		continue;
	    }
	    bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
	    subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
	}
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * CanUseFallbackWithAliases --
 *
 *	Helper function for FindSubFontForChar.  Determine if the
 *	specified face name (or an alias of the specified face name)
 *	can be used to construct a screen font that can display the
 *	given character.
 *
 * Results:
 *	See CanUseFallback().
 *
 * Side effects:
 *	If the name and/or one of its aliases was rejected, the
 *	rejected string is recorded in nameTriedPtr so that it won't
 *	be tried again.
 *
 *---------------------------------------------------------------------------
 */

static SubFont *
CanUseFallbackWithAliases(
    HDC hdc,			/* HDC in which font can be selected. */
    WinFont *fontPtr,		/* The font object that will own the new
				 * screen font. */
    char *faceName,		/* Desired face name for new screen font. */
    int ch,			/* The Unicode character that the new
				 * screen font must be able to display. */
    Tcl_DString *nameTriedPtr)	/* Records face names that have already
				 * been tried.  It is possible for the same
				 * face name to be queried multiple times when
				 * trying to find a suitable screen font. */
{
    int i;
    char **aliases;
    SubFont *subFontPtr;
    
    if (SeenName(faceName, nameTriedPtr) == 0) {
	subFontPtr = CanUseFallback(hdc, fontPtr, faceName, ch);
	if (subFontPtr != NULL) {
	    return subFontPtr;
	}
    }
    aliases = TkFontGetAliasList(faceName);
    if (aliases != NULL) {
	for (i = 0; aliases[i] != NULL; i++) {
	    if (SeenName(aliases[i], nameTriedPtr) == 0) {
		subFontPtr = CanUseFallback(hdc, fontPtr, aliases[i], ch);
		if (subFontPtr != NULL) {
		    return subFontPtr;
		}
	    }
	}
    }
    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * SeenName --
 *
 *	Used to determine we have already tried and rejected the given
 *	face name when looking for a screen font that can support some
 *	Unicode character.
 *
 * Results:
 *	The return value is 0 if this face name has not already been seen,
 *	non-zero otherwise.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
SeenName(
    CONST char *name,		/* The name to check. */
    Tcl_DString *dsPtr)		/* Contains names that have already been
				 * seen. */
{
    CONST char *seen, *end;

    seen = Tcl_DStringValue(dsPtr);
    end = seen + Tcl_DStringLength(dsPtr);
    while (seen < end) {
	if (strcasecmp(seen, name) == 0) {
	    return 1;
	}
	seen += strlen(seen) + 1;
    }
    Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1));
    return 0;
}

/*
 *-------------------------------------------------------------------------
 *
 * CanUseFallback --
 *
 *	If the specified screen font has not already been loaded into 
 *	the font object, determine if it can display the given character.
 *
 * Results:
 *	The return value is a pointer to a newly allocated SubFont, owned
 *	by the font object.  This SubFont can be used to display the given
 *	character.  The SubFont represents the screen font with the base set 
 *	of font attributes from the font object, but using the specified 
 *	font name.  NULL is returned if the font object already holds
 *	a reference to the specified physical font or if the specified 
 *	physical font cannot display the given character.
 *
 * Side effects:				       
 *	The font object's subFontArray is updated to contain a reference
 *	to the newly allocated SubFont.
 *
 *-------------------------------------------------------------------------
 */

static SubFont *
CanUseFallback(
    HDC hdc,			/* HDC in which font can be selected. */
    WinFont *fontPtr,		/* The font object that will own the new
				 * screen font. */
    char *faceName,		/* Desired face name for new screen font. */
    int ch)			/* The Unicode character that the new
				 * screen font must be able to display. */
{
    int i;
    HFONT hFont;
    SubFont subFont;

    if (FamilyExists(hdc, faceName) == 0) {
	return NULL;
    }

    /* 
     * Skip all fonts we've already used.
     */
     
    for (i = 0; i < fontPtr->numSubFonts; i++) {
	if (faceName == fontPtr->subFontArray[i].familyPtr->faceName) {
	    return NULL;
	}
    }

    /*
     * Load this font and see if it has the desired character.
     */

    hFont = GetScreenFont(&fontPtr->font.fa, faceName, fontPtr->pixelSize);
    InitSubFont(hdc, hFont, 0, &subFont);
    if (((ch < 256) && (subFont.familyPtr->isSymbolFont)) 
	    || (FontMapLookup(&subFont, ch) == 0)) {
	/*
	 * Don't use a symbol font as a fallback font for characters below
	 * 256.
	 */

	ReleaseSubFont(&subFont);
	return NULL;
    }

    if (fontPtr->numSubFonts >= SUBFONT_SPACE) {
	SubFont *newPtr;
    	
    	newPtr = (SubFont *) ckalloc(sizeof(SubFont) 
		* (fontPtr->numSubFonts + 1));
	memcpy((char *) newPtr, fontPtr->subFontArray,
		fontPtr->numSubFonts * sizeof(SubFont));
	if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
	    ckfree((char *) fontPtr->subFontArray);
	}
	fontPtr->subFontArray = newPtr;
    }
    fontPtr->subFontArray[fontPtr->numSubFonts] = subFont;
    fontPtr->numSubFonts++;
    return &fontPtr->subFontArray[fontPtr->numSubFonts - 1];
}

/*
 *---------------------------------------------------------------------------
 *
 * GetScreenFont --
 *
 *	Given the name and other attributes, construct an HFONT.
 *	This is where all the alias and fallback substitution bottoms
 *	out.
 *
 * Results:
 *	The screen font that corresponds to the attributes.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static HFONT 
GetScreenFont(
    CONST TkFontAttributes *faPtr,
				/* Desired font attributes for new HFONT. */
    CONST char *faceName,	/* Overrides font family specified in font
				 * attributes. */
    int pixelSize)		/* Overrides size specified in font 
				 * attributes. */
{
    Tcl_DString ds;
    HFONT hFont;
    LOGFONTW lf;

    lf.lfHeight		= -pixelSize;
    lf.lfWidth		= 0;
    lf.lfEscapement	= 0;
    lf.lfOrientation	= 0;
    lf.lfWeight		= (faPtr->weight == TK_FW_NORMAL) ? FW_NORMAL : FW_BOLD;
    lf.lfItalic		= faPtr->slant;
    lf.lfUnderline	= faPtr->underline;
    lf.lfStrikeOut	= faPtr->overstrike;
    lf.lfCharSet	= DEFAULT_CHARSET;
    lf.lfOutPrecision	= OUT_TT_PRECIS;
    lf.lfClipPrecision	= CLIP_DEFAULT_PRECIS;
    lf.lfQuality	= DEFAULT_QUALITY;
    lf.lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;

    Tcl_UtfToExternalDString(systemEncoding, faceName, -1, &ds);

    if (platformId == VER_PLATFORM_WIN32_NT) {    
	Tcl_UniChar *src, *dst;
	src = (Tcl_UniChar *) Tcl_DStringValue(&ds);
	dst = (Tcl_UniChar *) lf.lfFaceName;
	while (*src != '\0') {
	    *dst++ = *src++;
	}
	*dst = '\0';
	hFont = CreateFontIndirectW(&lf);
    } else {
	strcpy((char *) lf.lfFaceName, Tcl_DStringValue(&ds));
	hFont = CreateFontIndirectA((LOGFONTA *) &lf);
    }
    Tcl_DStringFree(&ds);
    return hFont;
}

/*
 *-------------------------------------------------------------------------
 *
 * FamilyExists, FamilyOrAliasExists, WinFontExistsProc --
 *
 *	Determines if any physical screen font exists on the system with 
 *	the given family name.  If the family exists, then it should be
 *	possible to construct some physical screen font with that family
 *	name.
 *
 * Results:
 *	The return value is 0 if the specified font family does not exist,
 *	non-zero otherwise.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
FamilyExists(
    HDC hdc,			/* HDC in which font family will be used. */
    CONST char *faceName)	/* Font family to query. */
{
    int result;
    Tcl_DString faceString;

    /*
     * Just immediately rule out the following fonts, because they look so
     * ugly on windows.  The caller's fallback mechanism will cause the
     * corresponding appropriate TrueType fonts to be selected.
     */

    if (strcasecmp(faceName, "Courier") == 0) {
	return 0;
    }
    if (strcasecmp(faceName, "Times") == 0) {
	return 0;
    }
    if (strcasecmp(faceName, "Helvetica") == 0) {
	return 0;
    }
    
    Tcl_UtfToExternalDString(systemEncoding, faceName, -1, &faceString);

    /*
     * If the family exists, WinFontExistProc() will be called and 
     * EnumFontFamilies() will return whatever WinFontExistProc() returns.  
     * If the family doesn't exist, EnumFontFamilies() will just return a 
     * non-zero value.
     */

    if (platformId == VER_PLATFORM_WIN32_NT) {
	result = EnumFontFamiliesW(hdc, (WCHAR *) Tcl_DStringValue(&faceString),
		(FONTENUMPROCW) WinFontExistProc, 0);
    } else {
	result = EnumFontFamiliesA(hdc, (char *) Tcl_DStringValue(&faceString),
		(FONTENUMPROCA) WinFontExistProc, 0);
    }
    Tcl_DStringFree(&faceString);
    return (result == 0);
}

static char *
FamilyOrAliasExists(
    HDC hdc, 
    CONST char *faceName)
{
    char **aliases;
    int i;

    if (FamilyExists(hdc, faceName) != 0) {
	return (char *) faceName;
    }
    aliases = TkFontGetAliasList(faceName);
    if (aliases != NULL) {
	for (i = 0; aliases[i] != NULL; i++) {
	    if (FamilyExists(hdc, aliases[i]) != 0) {
		return aliases[i];
	    }
	}
    }
    return NULL;
}

static int CALLBACK
WinFontExistProc(
    ENUMLOGFONT *lfPtr,		/* Logical-font data. */
    NEWTEXTMETRIC *tmPtr,	/* Physical-font data (not used). */
    int fontType,		/* Type of font (not used). */
    LPARAM lParam)		/* EnumFontData to hold result. */
{
    return 0;
}

/*
 * The following data structures are used when querying a TrueType font file
 * to determine which characters the font supports.
 */

#pragma pack(1)			/* Structures are byte aligned in file. */

#define CMAPHEX  0x636d6170	/* Key for character map resource. */

typedef struct CMAPTABLE {
    USHORT version;		/* Table version number (0). */
    USHORT numTables;		/* Number of encoding tables following. */
} CMAPTABLE;

typedef struct ENCODINGTABLE {
    USHORT platform;		/* Platform for which data is targeted.  
				 * 3 means data is for Windows. */
    USHORT encoding;		/* How characters in font are encoded.  
				 * 1 means that the following subtable is 
				 * keyed based on Unicode. */
    ULONG offset;		/* Byte offset from beginning of CMAPTABLE 
				 * to the subtable for this encoding. */
} ENCODINGTABLE;

typedef struct ANYTABLE {
    USHORT format;		/* Format number. */
    USHORT length;		/* The actual length in bytes of this 
				 * subtable. */
    USHORT version;		/* Version number (starts at 0). */
} ANYTABLE;

typedef struct BYTETABLE {
    USHORT format;		/* Format number is set to 0. */
    USHORT length;		/* The actual length in bytes of this 
				 * subtable. */
    USHORT version;		/* Version number (starts at 0). */
    BYTE glyphIdArray[256];	/* Array that maps up to 256 single-byte char
				 * codes to glyph indices. */
} BYTETABLE;

typedef struct SUBHEADER {
    USHORT firstCode;		/* First valid low byte for subHeader. */
    USHORT entryCount;		/* Number valid low bytes for subHeader. */
    SHORT idDelta;		/* Constant adder to get base glyph index. */
    USHORT idRangeOffset;	/* Byte offset from here to appropriate 
				 * glyphIndexArray. */
} SUBHEADER;

typedef struct HIBYTETABLE {
    USHORT format;  		/* Format number is set to 2. */
    USHORT length;		/* The actual length in bytes of this
				 * subtable. */
    USHORT version;		/* Version number (starts at 0). */
    USHORT subHeaderKeys[256];	/* Maps high bytes to subHeaders: value is 
				 * subHeader index * 8. */
#if 0
    SUBHEADER subHeaders[];	/* Variable-length array of SUBHEADERs. */
    USHORT glyphIndexArray[];	/* Variable-length array containing subarrays 
				 * used for mapping the low byte of 2-byte 
				 * characters. */
#endif
} HIBYTETABLE;

typedef struct SEGMENTTABLE {
    USHORT format;		/* Format number is set to 4. */
    USHORT length;		/* The actual length in bytes of this
				 * subtable. */
    USHORT version;		/* Version number (starts at 0). */
    USHORT segCountX2;		/* 2 x segCount. */
    USHORT searchRange;		/* 2 x (2**floor(log2(segCount))). */
    USHORT entrySelector;	/* log2(searchRange/2). */
    USHORT rangeShift;		/* 2 x segCount - searchRange. */
#if 0
    USHORT endCount[segCount]	/* End characterCode for each segment. */
    USHORT reservedPad;		/* Set to 0. */
    USHORT startCount[segCount];/* Start character code for each segment. */
    USHORT idDelta[segCount];	/* Delta for all character in segment. */
    USHORT idRangeOffset[segCount]; /* Offsets into glyphIdArray or 0. */
    USHORT glyphIdArray[]	/* Glyph index array. */
#endif
} SEGMENTTABLE;

typedef struct TRIMMEDTABLE {
    USHORT format;		/* Format number is set to 6. */
    USHORT length;		/* The actual length in bytes of this
				 * subtable. */
    USHORT version;		/* Version number (starts at 0). */
    USHORT firstCode;		/* First character code of subrange. */
    USHORT entryCount;		/* Number of character codes in subrange. */
#if 0
    USHORT glyphIdArray[];	/* Array of glyph index values for 
				        character codes in the range. */
#endif
} TRIMMEDTABLE;

typedef union SUBTABLE {
    ANYTABLE any;
    BYTETABLE byte;
    HIBYTETABLE hiByte;
    SEGMENTTABLE segment;
    TRIMMEDTABLE trimmed;
} SUBTABLE;

#pragma pack()

/*
 *-------------------------------------------------------------------------
 *
 * LoadFontRanges --
 *
 *	Given an HFONT, get the information about the characters that 
 *	this font can display.
 *
 * Results:
 *	If the font has no Unicode character information, the return value
 *	is 0 and *startCountPtr and *endCountPtr are filled with NULL.  
 *	Otherwise, *startCountPtr and *endCountPtr are set to pointers to 
 *	arrays of TrueType character existence information and the return 
 *	value is the length of the arrays (the two arrays are always the 
 *	same length as each other).
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
LoadFontRanges(
    HDC hdc,			/* HDC into which font can be selected. */
    HFONT hFont,		/* HFONT to query. */
    USHORT **startCountPtr,	/* Filled with malloced pointer to 
				 * character range information. */
    USHORT **endCountPtr,	/* Filled with malloced pointer to 
				 * character range information. */
    int *symbolPtr)
 {
    int n, i, swapped, offset, cbData, segCount;
    DWORD cmapKey;
    USHORT *startCount, *endCount;
    CMAPTABLE cmapTable;
    ENCODINGTABLE encTable;
    SUBTABLE subTable;
    char *s;

    segCount = 0;
    startCount = NULL;
    endCount = NULL;
    *symbolPtr = 0;

    hFont = SelectObject(hdc, hFont);

    i = 0;
    s = (char *) &i;
    *s = '\1';
    swapped = 0;

    if (i == 1) {
	swapped = 1;
    }

    cmapKey = CMAPHEX;
    if (swapped) {
	SwapLong(&cmapKey);
    }

    n = GetFontData(hdc, cmapKey, 0, &cmapTable, sizeof(cmapTable));
    if (n != GDI_ERROR) {
	if (swapped) {
	    SwapShort(&cmapTable.numTables);
	}
	for (i = 0; i < cmapTable.numTables; i++) {
	    offset = sizeof(cmapTable) + i * sizeof(encTable);
	    GetFontData(hdc, cmapKey, offset, &encTable, sizeof(encTable));
	    if (swapped) {
		SwapShort(&encTable.platform);
		SwapShort(&encTable.encoding);
		SwapLong(&encTable.offset);
	    }
	    if (encTable.platform != 3) {
		/* 
		 * Not Microsoft encoding.
		 */

		continue;
	    }
	    if (encTable.encoding == 0) {
		*symbolPtr = 1;
	    } else if (encTable.encoding != 1) {
		continue;
	    }

	    GetFontData(hdc, cmapKey, encTable.offset, &subTable, 
		    sizeof(subTable));
	    if (swapped) {
		SwapShort(&subTable.any.format);
	    }
	    if (subTable.any.format == 4) {
		if (swapped) {
		    SwapShort(&subTable.segment.segCountX2);
		}
		segCount = subTable.segment.segCountX2 / 2;
		cbData = segCount * sizeof(USHORT);

		startCount = (USHORT *) ckalloc(cbData);
		endCount = (USHORT *) ckalloc(cbData);

		offset = encTable.offset + sizeof(subTable.segment);
		GetFontData(hdc, cmapKey, offset, endCount, cbData);
		offset += cbData + sizeof(USHORT);
		GetFontData(hdc, cmapKey, offset, startCount, cbData);
		if (swapped) {
		    for (i = 0; i < segCount; i++) {
			SwapShort(&endCount[i]);
			SwapShort(&startCount[i]);
		    }
		}
		if (*symbolPtr != 0) {
		    /*
		     * Empirically determined:  When a symbol font is
		     * loaded, the character existence metrics obtained
		     * from the system are mildly wrong.  If the real range
		     * of the symbol font is from 0020 to 00FE, then the
		     * metrics are reported as F020 to F0FE.  When we load
		     * a symbol font, we must fix the character existence
		     * metrics.
		     */

		    for (i = 0; i < segCount; i++) {
			if ((startCount[i] & 0xff00) == 0xf000) {
			    startCount[i] &= 0xff;
			}
			if ((endCount[i] & 0xff00) == 0xf000) {
			    endCount[i] &= 0xff;
			}
		    }
		}
	    }
	}
    }
    SelectObject(hdc, hFont);

    *startCountPtr = startCount;
    *endCountPtr = endCount;
    return segCount;
}

/*
 *-------------------------------------------------------------------------
 * 
 * SwapShort, SwapLong --
 *
 *	Helper functions to convert the data loaded from TrueType font
 *	files to Intel byte ordering.
 *
 * Results:
 *	Bytes of input value are swapped and stored back in argument.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static void
SwapShort(PUSHORT p)
{
    *p = (SHORT)(HIBYTE(*p) + (LOBYTE(*p) << 8));
}

static void 
SwapLong(PULONG p)
{					     
    ULONG temp;

    temp = (LONG) ((BYTE) *p);
    temp <<= 8;
    *p >>=8;

    temp += (LONG) ((BYTE) *p);
    temp <<= 8;
    *p >>=8;

    temp += (LONG) ((BYTE) *p);
    temp <<= 8;
    *p >>=8;

    temp += (LONG) ((BYTE) *p);
    *p = temp;
}

Changes to win/tkWinImage.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkWinImage.c --
 *
 *	This file contains routines for manipulation full-color images.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinImage.c 1.13 97/07/07 11:19:45
 */

#include "tkWinInt.h"

static int		DestroyImage _ANSI_ARGS_((XImage* data));
static unsigned long	ImageGetPixel _ANSI_ARGS_((XImage *image, int x, int y));
static int		PutPixel _ANSI_ARGS_((XImage *image, int x, int y,










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkWinImage.c --
 *
 *	This file contains routines for manipulation full-color images.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinImage.c,v 1.1.4.1 1998/09/30 02:19:33 stanton Exp $
 */

#include "tkWinInt.h"

static int		DestroyImage _ANSI_ARGS_((XImage* data));
static unsigned long	ImageGetPixel _ANSI_ARGS_((XImage *image, int x, int y));
static int		PutPixel _ANSI_ARGS_((XImage *image, int x, int y,

Changes to win/tkWinInit.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkWinInit.c --
 *
 *	This file contains Windows-specific interpreter initialization
 *	functions.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinInit.c 1.29 97/07/24 14:46:35
 */

#include "tkWinInt.h"

/*
 * The Init script (common to Windows and Unix platforms) is
 * defined in tkInitScript.h











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkWinInit.c --
 *
 *	This file contains Windows-specific interpreter initialization
 *	functions.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinInit.c,v 1.1.4.2 1998/09/30 02:19:34 stanton Exp $
 */

#include "tkWinInt.h"

/*
 * The Init script (common to Windows and Unix platforms) is
 * defined in tkInitScript.h
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 * TkpInit --
 *
 *	Performs Windows-specific interpreter initialization related to the
 *      tk_library variable.
 *
 * Results:
 *	A standard Tcl completion code (TCL_OK or TCL_ERROR).  Also
 *	leaves information in interp->result.
 *
 * Side effects:
 *	Sets "tk_library" Tcl variable, runs "tk.tcl" script.
 *
 *----------------------------------------------------------------------
 */








|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 * TkpInit --
 *
 *	Performs Windows-specific interpreter initialization related to the
 *      tk_library variable.
 *
 * Results:
 *	A standard Tcl completion code (TCL_OK or TCL_ERROR).  Also
 *	leaves information in the interp's result.
 *
 * Side effects:
 *	Sets "tk_library" Tcl variable, runs "tk.tcl" script.
 *
 *----------------------------------------------------------------------
 */

Changes to win/tkWinInt.h.

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
/*
 * tkWinInt.h --
 *
 *	This file contains declarations that are shared among the
 *	Windows-specific parts of Tk, but aren't used by the rest of
 *	Tk.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinInt.h 1.34 97/09/02 13:06:20
 */

#ifndef _TKWININT
#define _TKWININT

#ifndef _TKINT
#include "tkInt.h"
#endif

/*
 * Include platform specific public interfaces.
 */

#ifndef _TKWIN
#include "tkWin.h"
#endif






/*
 * Define constants missing from older Win32 SDK header files.
 */

#ifndef WS_EX_TOOLWINDOW
#define WS_EX_TOOLWINDOW	0x00000080L 







|




|
















>
>
>
>
>







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
/*
 * tkWinInt.h --
 *
 *	This file contains declarations that are shared among the
 *	Windows-specific parts of Tk, but aren't used by the rest of
 *	Tk.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinInt.h,v 1.1.4.5 1999/03/10 07:13:52 stanton Exp $
 */

#ifndef _TKWININT
#define _TKWININT

#ifndef _TKINT
#include "tkInt.h"
#endif

/*
 * Include platform specific public interfaces.
 */

#ifndef _TKWIN
#include "tkWin.h"
#endif

#ifndef _TKPORT
#include "tkPort.h"
#endif


/*
 * Define constants missing from older Win32 SDK header files.
 */

#ifndef WS_EX_TOOLWINDOW
#define WS_EX_TOOLWINDOW	0x00000080L 
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

#define TK_3D_LIGHT2 TK_3D_DARK_GC+1
#define TK_3D_DARK2 TK_3D_DARK_GC+2

/*
 * Internal procedures used by more than one source file.
 */



extern LRESULT CALLBACK	TkWinChildProc _ANSI_ARGS_((HWND hwnd, UINT message,
			    WPARAM wParam, LPARAM lParam));
extern void		TkWinClipboardRender _ANSI_ARGS_((TkDisplay *dispPtr,
			    UINT format));
extern LRESULT		TkWinEmbeddedEventProc _ANSI_ARGS_((HWND hwnd,
			    UINT message, WPARAM wParam, LPARAM lParam));
extern void		TkWinFillRect _ANSI_ARGS_((HDC dc, int x, int y,
			    int width, int height, int pixel));
extern COLORREF		TkWinGetBorderPixels _ANSI_ARGS_((Tk_Window tkwin,
			    Tk_3DBorder border, int which));
extern HDC		TkWinGetDrawableDC _ANSI_ARGS_((Display *display,
			    Drawable d, TkWinDCState* state));
extern int		TkWinGetModifierState _ANSI_ARGS_((void));
extern HPALETTE		TkWinGetSystemPalette _ANSI_ARGS_((void));
extern HWND		TkWinGetWrapperWindow _ANSI_ARGS_((Tk_Window tkwin));
extern int		TkWinHandleMenuEvent _ANSI_ARGS_((HWND *phwnd,
			    UINT *pMessage, WPARAM *pwParam, LPARAM *plParam,
			    LRESULT *plResult));
extern int		TkWinIndexOfColor _ANSI_ARGS_((XColor *colorPtr));
extern void		TkWinPointerDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
extern void		TkWinPointerEvent _ANSI_ARGS_((HWND hwnd, int x,
			    int y));
extern void		TkWinPointerInit _ANSI_ARGS_((void));
extern LRESULT 		TkWinReflectMessage _ANSI_ARGS_((HWND hwnd,
			    UINT message, WPARAM wParam, LPARAM lParam));
extern void		TkWinReleaseDrawableDC _ANSI_ARGS_((Drawable d,
			    HDC hdc, TkWinDCState* state));
extern LRESULT		TkWinResendEvent _ANSI_ARGS_((WNDPROC wndproc,
			    HWND hwnd, XEvent *eventPtr));
extern HPALETTE		TkWinSelectPalette _ANSI_ARGS_((HDC dc,
			    Colormap colormap));
extern void		TkWinSetMenu _ANSI_ARGS_((Tk_Window tkwin,
			    HMENU hMenu));
extern void		TkWinSetWindowPos _ANSI_ARGS_((HWND hwnd,
			    HWND siblingHwnd, int pos));
extern void		TkWinUpdateCursor _ANSI_ARGS_((TkWindow *winPtr));
extern void		TkWinWmCleanup _ANSI_ARGS_((HINSTANCE hInstance));
extern HWND		TkWinWmFindEmbedAssociation _ANSI_ARGS_((
			    TkWindow *winPtr));
extern void		TkWinWmStoreEmbedAssociation _ANSI_ARGS_((
			    TkWindow *winPtr, HWND hwnd));
extern void		TkWinXCleanup _ANSI_ARGS_((HINSTANCE hInstance));
extern void 		TkWinXInit _ANSI_ARGS_((HINSTANCE hInstance));

#endif /* _TKWININT */









>
>


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



146
147
148
149
150
151
152
153
154
155
156
157









































158
159
160

#define TK_3D_LIGHT2 TK_3D_DARK_GC+1
#define TK_3D_DARK2 TK_3D_DARK_GC+2

/*
 * Internal procedures used by more than one source file.
 */

#include "tkIntPlatDecls.h"

extern LRESULT CALLBACK	TkWinChildProc _ANSI_ARGS_((HWND hwnd, UINT message,
			    WPARAM wParam, LPARAM lParam));










































#endif /* _TKWININT */

Changes to win/tkWinKey.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkWinKey.c --
 *
 *	This file contains X emulation routines for keyboard related
 *	functions.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinKey.c 1.9 97/06/20 15:12:39
 */

#include "tkWinInt.h"

typedef struct {
    unsigned int keycode;
    KeySym keysym;











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkWinKey.c --
 *
 *	This file contains X emulation routines for keyboard related
 *	functions.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinKey.c,v 1.1.4.2 1998/09/30 02:19:35 stanton Exp $
 */

#include "tkWinInt.h"

typedef struct {
    unsigned int keycode;
    KeySym keysym;
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
    VK_F20, XK_F20,
    VK_F21, XK_F21,
    VK_F22, XK_F22,
    VK_F23, XK_F23,
    VK_F24, XK_F24,
    VK_NUMLOCK, XK_Num_Lock, 
    VK_SCROLL, XK_Scroll_Lock,










    0, NoSymbol
};


/*
 *----------------------------------------------------------------------
 *
 * XLookupString --
 *
 *	Retrieve the string equivalent for the given keyboard event.
 *
 * Results:
 *	Returns the number of characters stored in buffer_return.
 *
 * Side effects:
 *	Retrieves the characters stored in the event and inserts them
 *	into buffer_return.
 *
 *----------------------------------------------------------------------
 */

int
XLookupString(event_struct, buffer_return, bytes_buffer, keysym_return,
	status_in_out)
    XKeyEvent* event_struct;

    char* buffer_return;
    int bytes_buffer;

    KeySym* keysym_return;
    XComposeStatus* status_in_out;
{
    int i, limit;




    if (event_struct->send_event != -1) {
	/*
	 * This is an event generated from generic code.  It has no
	 * nchars or trans_chars members. 
	 */

	int index;
	KeySym keysym;

	index = 0;
	if (event_struct->state & ShiftMask) {
	    index |= 1;
	}
	if (event_struct->state & Mod1Mask) {
	    index |= 2;
	}
	keysym = XKeycodeToKeysym(event_struct->display, 
		event_struct->keycode, index);
	if (((keysym != NoSymbol) && (keysym > 0) && (keysym < 256)) 
		|| (keysym == XK_Return)
		|| (keysym == XK_Tab)) {

	    buffer_return[0] = (char) keysym;
	    return 1;

	}
	return 0;
    }
    if ((event_struct->nchars <= 0) || (buffer_return == NULL)) {
	return 0;
    }
    limit = (event_struct->nchars < bytes_buffer) ? event_struct->nchars :
	bytes_buffer;

    for (i = 0; i < limit; i++) {
	buffer_return[i] = event_struct->trans_chars[i];
    }

    if (keysym_return != NULL) {
	*keysym_return = NoSymbol;
    }
    return i;
}

/*
 *----------------------------------------------------------------------
 *
 * XKeycodeToKeysym --
 *







>
>
>
>
>
>
>
>
>
>







|

|


|


<
|




<
<
|
|
>
|
|
>
|
<

|
>
>

>
|





<
<
<

|


|


|
|



>
|
<
>

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

|







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
    VK_F20, XK_F20,
    VK_F21, XK_F21,
    VK_F22, XK_F22,
    VK_F23, XK_F23,
    VK_F24, XK_F24,
    VK_NUMLOCK, XK_Num_Lock, 
    VK_SCROLL, XK_Scroll_Lock,

    /*
     * The following support the new keys in the Microsoft keyboard.
     * Win_L and Win_R have the windows logo.  App has the menu.
     */

    VK_LWIN, XK_Win_L,
    VK_RWIN, XK_Win_R,
    VK_APPS, XK_App,

    0, NoSymbol
};


/*
 *----------------------------------------------------------------------
 *
 * TkpGetString --
 *
 *	Retrieve the UTF string equivalent for the given keyboard event.
 *
 * Results:
 *	Returns the UTF string.
 *
 * Side effects:

 *	None.
 *
 *----------------------------------------------------------------------
 */



char *
TkpGetString(winPtr, eventPtr, dsPtr)
    TkWindow *winPtr;		/* Window where event occurred:  needed to
				 * get input context. */
    XEvent *eventPtr;		/* X keyboard event. */
    Tcl_DString *dsPtr;		/* Uninitialized or empty string to hold
				 * result. */

{
    int index;
    KeySym keysym;
    XKeyEvent* keyEv = &eventPtr->xkey;

    Tcl_DStringInit(dsPtr);
    if (eventPtr->xkey.send_event != -1) {
	/*
	 * This is an event generated from generic code.  It has no
	 * nchars or trans_chars members. 
	 */




	index = 0;
	if (eventPtr->xkey.state & ShiftMask) {
	    index |= 1;
	}
	if (eventPtr->xkey.state & Mod1Mask) {
	    index |= 2;
	}
	keysym = XKeycodeToKeysym(eventPtr->xkey.display, 
		eventPtr->xkey.keycode, index);
	if (((keysym != NoSymbol) && (keysym > 0) && (keysym < 256)) 
		|| (keysym == XK_Return)
		|| (keysym == XK_Tab)) {
	    char buf[TCL_UTF_MAX];
	    int len = Tcl_UniCharToUtf((Tcl_UniChar) keysym, buf);

	    Tcl_DStringAppend(dsPtr, buf, len);
	}






    } else if (eventPtr->xkey.nbytes > 0) {
	Tcl_ExternalToUtfDString(NULL, eventPtr->xkey.trans_chars,



		eventPtr->xkey.nbytes, dsPtr);


    }
    return Tcl_DStringValue(dsPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * XKeycodeToKeysym --
 *
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
    result = ToAscii(keycode, scancode, keys, (LPWORD) buf, 0);

    /*
     * Keycode mapped to a valid Latin-1 character.  Since the keysyms
     * for alphanumeric characters map onto Latin-1, we just return it.
     */

    if (result == 1 && buf[0] >= 0x20) {
	return (KeySym) buf[0];
    }

    /*
     * Keycode is a non-alphanumeric key, so we have to do the lookup.
     */

    for (key = keymap; key->keycode != 0; key++) {







|
|







183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
    result = ToAscii(keycode, scancode, keys, (LPWORD) buf, 0);

    /*
     * Keycode mapped to a valid Latin-1 character.  Since the keysyms
     * for alphanumeric characters map onto Latin-1, we just return it.
     */

    if (result == 1 && UCHAR(buf[0]) >= 0x20) {
	return (KeySym) UCHAR(buf[0]);
    }

    /*
     * Keycode is a non-alphanumeric key, so we have to do the lookup.
     */

    for (key = keymap; key->keycode != 0; key++) {

Changes to win/tkWinMenu.c.

1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
24
/* 
 * tkWinMenu.c --
 *
 *	This module implements the Mac-platform specific features of menus.
 *
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinMenu.c 1.102 97/10/28 13:56:58
 */

#define OEMRESOURCE
#include <string.h>
#include "tkMenu.h"

#include "tkWinInt.h"

/*
 * The class of the window for popup menus.
 */

#define MENU_CLASS_NAME "MenuWindowClass"




|

|
>




|



|

>
|







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
/* 
 * tkWinMenu.c --
 *
 *	This module implements the Windows platform-specific features of menus.
 *
 * Copyright (c) 1996-1998 by Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinMenu.c,v 1.1.4.11 1999/03/30 04:13:01 stanton Exp $
 */

#define OEMRESOURCE
#include "tkWinInt.h"
#include "tkMenu.h"

#include <string.h>

/*
 * The class of the window for popup menus.
 */

#define MENU_CLASS_NAME "MenuWindowClass"

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
#define MENU_SYSTEM_MENU	    MENU_PLATFORM_FLAG1
#define MENU_RECONFIGURE_PENDING    MENU_PLATFORM_FLAG2

static int indicatorDimensions[2];
				/* The dimensions of the indicator space
				 * in a menu entry. Calculated at init
				 * time to save time. */


static Tcl_HashTable commandTable;
				/* A map of command ids to menu entries */
static int inPostMenu;		/* We cannot be re-entrant like X Windows. */
static WORD lastCommandID;	/* The last command ID we allocated. */
static HWND menuHWND;		/* A window to service popup-menu messages
				 * in. */
static int oldServiceMode;	/* Used while processing a menu; we need
				 * to set the event mode specially when we
				 * enter the menu processing modal loop
				 * and reset it when menus go away. */
static TkMenu *modalMenuPtr;	/* The menu we are processing inside the modal
				 * loop. We need this to reset all of the 
				 * active items when menus go away since
				 * Windows does not see fit to give this
				 * to us when it sends its WM_MENUSELECT. */





static OSVERSIONINFO versionInfo;
				/* So we don't have to keep doing this */
static Tcl_HashTable winMenuTable;
				/* Need this to map HMENUs back to menuPtrs */

/*
 * The following are default menu value strings.
 */

static char borderString[5];	/* The string indicating how big the border is */
static Tcl_DString menuFontDString;
				/* A buffer to store the default menu font
				 * string. */


/*
 * Forward declarations for procedures defined later in this file:
 */

static void		DrawMenuEntryAccelerator _ANSI_ARGS_((
			    TkMenu *menuPtr, TkMenuEntry *mePtr, 







>
>
|

|
|
|

|



|




>
>
>
>
>


<
<





|



>







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
#define MENU_SYSTEM_MENU	    MENU_PLATFORM_FLAG1
#define MENU_RECONFIGURE_PENDING    MENU_PLATFORM_FLAG2

static int indicatorDimensions[2];
				/* The dimensions of the indicator space
				 * in a menu entry. Calculated at init
				 * time to save time. */

typedef struct ThreadSpecificData {
    Tcl_HashTable commandTable;
				/* A map of command ids to menu entries */
    int inPostMenu;		/* We cannot be re-entrant like X Windows. */
    WORD lastCommandID;	        /* The last command ID we allocated. */
    HWND menuHWND;		/* A window to service popup-menu messages
				 * in. */
    int oldServiceMode;	        /* Used while processing a menu; we need
				 * to set the event mode specially when we
				 * enter the menu processing modal loop
				 * and reset it when menus go away. */
    TkMenu *modalMenuPtr;	/* The menu we are processing inside the modal
				 * loop. We need this to reset all of the 
				 * active items when menus go away since
				 * Windows does not see fit to give this
				 * to us when it sends its WM_MENUSELECT. */
    Tcl_HashTable winMenuTable;
				/* Need this to map HMENUs back to menuPtrs */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

static OSVERSIONINFO versionInfo;
				/* So we don't have to keep doing this */



/*
 * The following are default menu value strings.
 */

static int defaultBorderWidth;	/* The windows default border width. */
static Tcl_DString menuFontDString;
				/* A buffer to store the default menu font
				 * string. */
TCL_DECLARE_MUTEX(winMenuMutex)

/*
 * Forward declarations for procedures defined later in this file:
 */

static void		DrawMenuEntryAccelerator _ANSI_ARGS_((
			    TkMenu *menuPtr, TkMenuEntry *mePtr, 
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
			    Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int x,
			    int y, int width, int height));
static void		DrawWindowsSystemBitmap _ANSI_ARGS_((
			    Display *display, Drawable drawable, 
			    GC gc, CONST RECT *rectPtr, int bitmapID,
			    int alignFlags));
static void		FreeID _ANSI_ARGS_((int commandID));
static char *		GetEntryText _ANSI_ARGS_((TkMenuEntry *mePtr));
static void		GetMenuAccelGeometry _ANSI_ARGS_((TkMenu *menuPtr,
			    TkMenuEntry *mePtr, Tk_Font tkfont,
			    CONST Tk_FontMetrics *fmPtr, int *widthPtr,
			    int *heightPtr));
static void		GetMenuLabelGeometry _ANSI_ARGS_((TkMenuEntry *mePtr,
			    Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
			    int *widthPtr, int *heightPtr));







|







126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
			    Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr, int x,
			    int y, int width, int height));
static void		DrawWindowsSystemBitmap _ANSI_ARGS_((
			    Display *display, Drawable drawable, 
			    GC gc, CONST RECT *rectPtr, int bitmapID,
			    int alignFlags));
static void		FreeID _ANSI_ARGS_((int commandID));
static TCHAR *		GetEntryText _ANSI_ARGS_((TkMenuEntry *mePtr));
static void		GetMenuAccelGeometry _ANSI_ARGS_((TkMenu *menuPtr,
			    TkMenuEntry *mePtr, Tk_Font tkfont,
			    CONST Tk_FontMetrics *fmPtr, int *widthPtr,
			    int *heightPtr));
static void		GetMenuLabelGeometry _ANSI_ARGS_((TkMenuEntry *mePtr,
			    Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
			    int *widthPtr, int *heightPtr));
150
151
152
153
154
155
156

157
158
159
160
161
162
163
			    Tcl_Interp *interp, XEvent *eventPtr,
			    Tk_Window tkwin, KeySym keySym));
static void		MenuSelectEvent _ANSI_ARGS_((TkMenu *menuPtr));
static void		ReconfigureWindowsMenu _ANSI_ARGS_((
			    ClientData clientData));
static void		RecursivelyClearActiveMenu _ANSI_ARGS_((
			    TkMenu *menuPtr));

static LRESULT CALLBACK	TkWinMenuProc _ANSI_ARGS_((HWND hwnd,
			    UINT message, WPARAM wParam,
			    LPARAM lParam));



/*







>







158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
			    Tcl_Interp *interp, XEvent *eventPtr,
			    Tk_Window tkwin, KeySym keySym));
static void		MenuSelectEvent _ANSI_ARGS_((TkMenu *menuPtr));
static void		ReconfigureWindowsMenu _ANSI_ARGS_((
			    ClientData clientData));
static void		RecursivelyClearActiveMenu _ANSI_ARGS_((
			    TkMenu *menuPtr));
static void		SetDefaults _ANSI_ARGS_((int firstTime));
static LRESULT CALLBACK	TkWinMenuProc _ANSI_ARGS_((HWND hwnd,
			    UINT message, WPARAM wParam,
			    LPARAM lParam));



/*
185
186
187
188
189
190
191


192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
    TkMenuEntry *mePtr;		/* The menu we are working with */
    int *menuIDPtr;		/* The resulting id */
{
    int found = 0;
    int newEntry;
    Tcl_HashEntry *commandEntryPtr;
    WORD returnID;



    WORD curID = lastCommandID + 1;

    /*
     * The following code relies on WORD wrapping when the highest value is
     * incremented.
     */
    
    while (curID != lastCommandID) {
    	commandEntryPtr = Tcl_CreateHashEntry(&commandTable,
		(char *) curID, &newEntry);
    	if (newEntry == 1) {
    	    found = 1;
    	    returnID = curID;
    	    break;
    	}
    	curID++;
    }

    if (found) {
    	Tcl_SetHashValue(commandEntryPtr, (char *) mePtr);
    	*menuIDPtr = (int) returnID;
    	lastCommandID = returnID;
    	return TCL_OK;
    } else {
    	return TCL_ERROR;
    }
}

/*







>
>

|






|
|












|







194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
    TkMenuEntry *mePtr;		/* The menu we are working with */
    int *menuIDPtr;		/* The resulting id */
{
    int found = 0;
    int newEntry;
    Tcl_HashEntry *commandEntryPtr;
    WORD returnID;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    WORD curID = tsdPtr->lastCommandID + 1;

    /*
     * The following code relies on WORD wrapping when the highest value is
     * incremented.
     */
    
    while (curID != tsdPtr->lastCommandID) {
    	commandEntryPtr = Tcl_CreateHashEntry(&tsdPtr->commandTable,
		(char *) curID, &newEntry);
    	if (newEntry == 1) {
    	    found = 1;
    	    returnID = curID;
    	    break;
    	}
    	curID++;
    }

    if (found) {
    	Tcl_SetHashValue(commandEntryPtr, (char *) mePtr);
    	*menuIDPtr = (int) returnID;
    	tsdPtr->lastCommandID = returnID;
    	return TCL_OK;
    } else {
    	return TCL_ERROR;
    }
}

/*
234
235
236
237
238
239
240



241
242
243
244
245
246
247
248
 *----------------------------------------------------------------------
 */

static void
FreeID(commandID)
    int commandID;
{



    Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&commandTable,
	    (char *) commandID);
    
    if (entryPtr != NULL) {
    	 Tcl_DeleteHashEntry(entryPtr);
    }
}








>
>
>
|







245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
 *----------------------------------------------------------------------
 */

static void
FreeID(commandID)
    int commandID;
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable,
	    (char *) commandID);
    
    if (entryPtr != NULL) {
    	 Tcl_DeleteHashEntry(entryPtr);
    }
}

268
269
270
271
272
273
274


275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
TkpNewMenu(menuPtr)
    TkMenu *menuPtr;	/* The common structure we are making the
			 * platform structure for. */
{
    HMENU winMenuHdl;
    Tcl_HashEntry *hashEntryPtr;
    int newEntry;



    winMenuHdl = CreatePopupMenu();
    
    if (winMenuHdl == NULL) {
    	Tcl_AppendResult(menuPtr->interp, "No more menus can be allocated.",
    		(char *) NULL);
    	return TCL_ERROR;
    }

    /*
     * We hash all of the HMENU's so that we can get their menu ptrs
     * back when dispatch messages.
     */

    hashEntryPtr = Tcl_CreateHashEntry(&winMenuTable, (char *) winMenuHdl,
	    &newEntry);
    Tcl_SetHashValue(hashEntryPtr, (char *) menuPtr);

    menuPtr->platformData = (TkMenuPlatformData) winMenuHdl;
    return TCL_OK;
}








>
>














|







282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
TkpNewMenu(menuPtr)
    TkMenu *menuPtr;	/* The common structure we are making the
			 * platform structure for. */
{
    HMENU winMenuHdl;
    Tcl_HashEntry *hashEntryPtr;
    int newEntry;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    winMenuHdl = CreatePopupMenu();
    
    if (winMenuHdl == NULL) {
    	Tcl_AppendResult(menuPtr->interp, "No more menus can be allocated.",
    		(char *) NULL);
    	return TCL_ERROR;
    }

    /*
     * We hash all of the HMENU's so that we can get their menu ptrs
     * back when dispatch messages.
     */

    hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->winMenuTable, (char *) winMenuHdl,
	    &newEntry);
    Tcl_SetHashValue(hashEntryPtr, (char *) menuPtr);

    menuPtr->platformData = (TkMenuPlatformData) winMenuHdl;
    return TCL_OK;
}

311
312
313
314
315
316
317



318
319
320
321
322
323



324
325
326
327
328
329






330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345











346
347
348



349
350
351
352
353
354
355
 */

void
TkpDestroyMenu(menuPtr)
    TkMenu *menuPtr;	    /* The common menu structure */
{
    HMENU winMenuHdl = (HMENU) menuPtr->platformData;




    if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
	Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr);
    }
    
    if (NULL != winMenuHdl) {



	if (menuPtr->menuFlags & MENU_SYSTEM_MENU) {
	    TkMenuEntry *searchEntryPtr;
	    Tcl_HashTable *tablePtr = TkGetMenuHashTable(menuPtr->interp);
	    char *menuName = Tcl_GetHashKey(tablePtr, 
		    menuPtr->menuRefPtr->hashEntryPtr);







	    for (searchEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
		    searchEntryPtr != NULL;
		    searchEntryPtr = searchEntryPtr->nextCascadePtr) {
		if (strcmp(searchEntryPtr->name,
			menuName) == 0) {
		    Tk_Window parentTopLevelPtr = searchEntryPtr
			    ->menuPtr->parentTopLevelPtr;

		    if (parentTopLevelPtr != NULL) {
			GetSystemMenu(TkWinGetWrapperWindow(parentTopLevelPtr),
				TRUE);
		    }
		    break;
		}
	    }
	} else {











    	    DestroyMenu(winMenuHdl);
	}
    	menuPtr->platformData = NULL;



    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkpDestroyMenuEntry --







>
>
>





|
>
>
>
|
|
|
|
|

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

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







327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
 */

void
TkpDestroyMenu(menuPtr)
    TkMenu *menuPtr;	    /* The common menu structure */
{
    HMENU winMenuHdl = (HMENU) menuPtr->platformData;
    char *searchName;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
	Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr);
    }
    
    if (winMenuHdl == NULL) {
	return;
    }

    if (menuPtr->menuFlags & MENU_SYSTEM_MENU) {
	TkMenuEntry *searchEntryPtr;
	Tcl_HashTable *tablePtr = TkGetMenuHashTable(menuPtr->interp);
	char *menuName = Tcl_GetHashKey(tablePtr, 
		menuPtr->menuRefPtr->hashEntryPtr);

	/*
	 * Search for the menu in the menubar, if it is present, get the
	 * wrapper window associated with the toplevel and reset its
	 * system menu to the default menu.
	 */

	for (searchEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
	     searchEntryPtr != NULL;
	     searchEntryPtr = searchEntryPtr->nextCascadePtr) {
	    searchName = Tcl_GetStringFromObj(searchEntryPtr->namePtr, NULL);
	    if (strcmp(searchName, menuName) == 0) {
		Tk_Window parentTopLevelPtr = searchEntryPtr
		    ->menuPtr->parentTopLevelPtr;

		if (parentTopLevelPtr != NULL) {
		    GetSystemMenu(TkWinGetWrapperWindow(parentTopLevelPtr),
			    TRUE);
		}
		break;
	    }
	}
    } else {
	Tcl_HashEntry *hashEntryPtr;
 
	/*
	 * Remove the menu from the menu hash table, then destroy the handle.
	 */

	hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, 
                (char *) winMenuHdl);
	if (hashEntryPtr != NULL) {
	    Tcl_DeleteHashEntry(hashEntryPtr);
	}
 	DestroyMenu(winMenuHdl);
    }
    menuPtr->platformData = NULL;

    if (menuPtr == tsdPtr->modalMenuPtr) {
	tsdPtr->modalMenuPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkpDestroyMenuEntry --
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
    TkMenuEntry *mePtr;		/* A pointer to the menu entry. */
{
    char *itemText;

    if (mePtr->type == TEAROFF_ENTRY) {
	itemText = ckalloc(sizeof("(Tear-off)"));
	strcpy(itemText, "(Tear-off)");
    } else if (mePtr->imageString != NULL) {
	itemText = ckalloc(sizeof("(Image)"));
	strcpy(itemText, "(Image)");
    } else if (mePtr->bitmap != None) {
	itemText = ckalloc(sizeof("(Pixmap)"));
	strcpy(itemText, "(Pixmap)");
    } else if (mePtr->label == NULL || mePtr->labelLength == 0) {
	itemText = ckalloc(sizeof("( )"));
	strcpy(itemText, "( )");
    } else {
	int size = mePtr->labelLength + 1;
	int i, j;







	/*
	 * We have to construct the string with an ampersand
	 * preceeding the underline character, and a tab seperating
	 * the text and the accel text. We have to be careful with
	 * ampersands in the string.
	 */

	for (i = 0; i < mePtr->labelLength; i++) {
	    if (mePtr->label[i] == '&') {
		size++;
	    }
	}

	if (mePtr->underline >= 0) {
	    size++;
	    if (mePtr->label[mePtr->underline] == '&') {
		size++;
	    }
	}

	if (mePtr->accelLength > 0) {
	    size += mePtr->accelLength + 1;
	}

	for (i = 0; i < mePtr->accelLength; i++) {
	    if (mePtr->accel[i] == '&') {
		size++;

	    }
	}

	itemText = ckalloc(size);
	
	if (mePtr->labelLength == 0) {
	    itemText[0] = 0;
	} else {
	    for (i = 0, j = 0; i < mePtr->labelLength; i++, j++) {
		if (mePtr->label[i] == '&') {
		    itemText[j++] = '&';
		}
		if (i == mePtr->underline) {
		    itemText[j++] = '&';

		}
		itemText[j] = mePtr->label[i];
	    }
	    itemText[j] = '\0';
	}

	if (mePtr->accelLength > 0) {
	    strcat(itemText, "\t");
	    for (i = 0, j = strlen(itemText); i < mePtr->accelLength;
		    i++, j++) {
		if (mePtr->accel[i] == '&') {
		    itemText[j++] = '&';
		}
		itemText[j] = mePtr->accel[i];
	    }
	    itemText[j] = '\0';
	}
    }
    return itemText;
}

/*
 *----------------------------------------------------------------------
 *







|


|


|



<
|
>
>
>
>
>
>








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

<
|
|
|
|
|
<
|
|
|

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







448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464

465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480


481

482
483





484


485


486

487
488

489
490
491
492
493

494
495
496
497

498
499
500

501

502
503

504



505





506
507
508
509
510
511
512
    TkMenuEntry *mePtr;		/* A pointer to the menu entry. */
{
    char *itemText;

    if (mePtr->type == TEAROFF_ENTRY) {
	itemText = ckalloc(sizeof("(Tear-off)"));
	strcpy(itemText, "(Tear-off)");
    } else if (mePtr->imagePtr != NULL) {
	itemText = ckalloc(sizeof("(Image)"));
	strcpy(itemText, "(Image)");
    } else if (mePtr->bitmapPtr != NULL) {
	itemText = ckalloc(sizeof("(Pixmap)"));
	strcpy(itemText, "(Pixmap)");
    } else if (mePtr->labelPtr == NULL || mePtr->labelLength == 0) {
	itemText = ckalloc(sizeof("( )"));
	strcpy(itemText, "( )");
    } else {

	int i;
	char *label = (mePtr->labelPtr == NULL) ? "" 
		: Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
	char *accel = (mePtr->accelPtr == NULL) ? "" 
		: Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
	char *p, *next;
	Tcl_DString itemString;

	/*
	 * We have to construct the string with an ampersand
	 * preceeding the underline character, and a tab seperating
	 * the text and the accel text. We have to be careful with
	 * ampersands in the string.
	 */

	Tcl_DStringInit(&itemString);




	for (p = label, i = 0; *p != '\0'; i++, p = next) {
	    if (i == mePtr->underline) {





		Tcl_DStringAppend(&itemString, "&", 1);


	    }


	    if (*p == '&') {

		Tcl_DStringAppend(&itemString, "&", 1);
	    }

	    next = Tcl_UtfNext(p);
	    Tcl_DStringAppend(&itemString, p, next - p);
	}
        if (mePtr->accelLength > 0) {
	    Tcl_DStringAppend(&itemString, "\t", 1);

	    for (p = accel, i = 0; *p != '\0'; i++, p = next) {
		if (*p == '&') {
		    Tcl_DStringAppend(&itemString, "&", 1);
		}

		next = Tcl_UtfNext(p);
		Tcl_DStringAppend(&itemString, p, next - p);
	    }

	} 	    


	itemText = ckalloc(Tcl_DStringLength(&itemString) + 1);

	strcpy(itemText, Tcl_DStringValue(&itemString));



	Tcl_DStringFree(&itemString);





    }
    return itemText;
}

/*
 *----------------------------------------------------------------------
 *
505
506
507
508
509
510
511
512
513
514
515
516
517

518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546

547
548
549
550
551
552
553
554
555
556
557

558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599

600
601
602
603


604
605
606
607
608
609
610

611


612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648

649
650
651
652
653
654
655
static void
ReconfigureWindowsMenu(
    ClientData clientData)	    /* The menu we are rebuilding */
{
    TkMenu *menuPtr = (TkMenu *) clientData;
    TkMenuEntry *mePtr;
    HMENU winMenuHdl = (HMENU) menuPtr->platformData;
    char *itemText = NULL;
    LPCTSTR lpNewItem;
    UINT flags;
    UINT itemID;
    int i, count, systemMenu = 0, base;
    int width, height;


    if (NULL == winMenuHdl) {
    	return;
    }

    /*
     * Reconstruct the entire menu. Takes care of nasty system menu and index
     * problem.
     *
     */

    if ((menuPtr->menuType == MENUBAR)
	    && (menuPtr->parentTopLevelPtr != NULL)) {
	width = Tk_Width(menuPtr->parentTopLevelPtr);
	height = Tk_Width(menuPtr->parentTopLevelPtr);
    }

    base = (menuPtr->menuFlags & MENU_SYSTEM_MENU) ? 7 : 0;
    count = GetMenuItemCount(winMenuHdl);
    for (i = base; i < count; i++) {
	RemoveMenu(winMenuHdl, base, MF_BYPOSITION);
    }

    count = menuPtr->numEntries;
    for (i = 0; i < count; i++) {
	mePtr = menuPtr->entries[i];
	lpNewItem = NULL;
	flags = MF_BYPOSITION;
	itemID = 0;


	if ((menuPtr->menuType == MENUBAR) && (mePtr->type == TEAROFF_ENTRY)) {
	    continue;
	}

	if (mePtr->type == SEPARATOR_ENTRY) {
	    flags |= MF_SEPARATOR;
	} else {
	    itemText = GetEntryText(mePtr);
	    if ((menuPtr->menuType == MENUBAR)
		    || (menuPtr->menuFlags & MENU_SYSTEM_MENU)) {

		lpNewItem = itemText;
	    } else {
		lpNewItem = (LPCTSTR) mePtr;
		flags |= MF_OWNERDRAW;
	    }

    	    /*
    	     * Set enabling and disabling correctly.
    	     */

	    if (mePtr->state == tkDisabledUid) {
		flags |= MF_DISABLED;
	    }
    	    
    	    /*
    	     * Set the check mark for check entries and radio entries.
    	     */
	    
	    if (((mePtr->type == CHECK_BUTTON_ENTRY)
		    || (mePtr->type == RADIO_BUTTON_ENTRY))
		    && (mePtr->entryFlags & ENTRY_SELECTED)) {
		flags |= MF_CHECKED;
	    }

	    if (mePtr->columnBreak) {
		flags |= MF_MENUBREAK;
	    }

	    itemID = (int) mePtr->platformEntryData;
	    if (mePtr->type == CASCADE_ENTRY) {
		if ((mePtr->childMenuRefPtr != NULL)
			&& (mePtr->childMenuRefPtr->menuPtr != NULL)) {
		    HMENU childMenuHdl = 
			    (HMENU) mePtr->childMenuRefPtr->menuPtr
			    ->platformData;
		    if (childMenuHdl != NULL) {
			itemID = (UINT) childMenuHdl;
			flags |= MF_POPUP;
		    }
		    if ((menuPtr->menuType == MENUBAR) 
			    && !(mePtr->childMenuRefPtr->menuPtr->menuFlags
			    & MENU_SYSTEM_MENU)) {

			TkMenuReferences *menuRefPtr;
			TkMenu *systemMenuPtr = mePtr->childMenuRefPtr
				->menuPtr;
			char *systemMenuName = ckalloc(strlen(


				Tk_PathName(menuPtr->masterMenuPtr->tkwin))
				+ strlen(".system") + 1);

			strcpy(systemMenuName, 
				Tk_PathName(menuPtr->masterMenuPtr->tkwin));
			strcat(systemMenuName, ".system");
			menuRefPtr = TkFindMenuReferences(menuPtr->interp,

				systemMenuName);


			if ((menuRefPtr != NULL) 
				&& (menuRefPtr->menuPtr != NULL)
				&& (menuPtr->parentTopLevelPtr != NULL)
				&& (systemMenuPtr->masterMenuPtr
				== menuRefPtr->menuPtr)) {
			    HMENU systemMenuHdl = 
				    (HMENU) systemMenuPtr->platformData;
			    HWND wrapper = TkWinGetWrapperWindow(menuPtr
				    ->parentTopLevelPtr);
			    if (wrapper != NULL) {
				DestroyMenu(systemMenuHdl);
				systemMenuHdl = GetSystemMenu(
				    wrapper, FALSE);
				systemMenuPtr->menuFlags |= MENU_SYSTEM_MENU;
				systemMenuPtr->platformData = 
					(TkMenuPlatformData) systemMenuHdl;
				if (!(systemMenuPtr->menuFlags 
					& MENU_RECONFIGURE_PENDING)) {
				    systemMenuPtr->menuFlags 
					    |= MENU_RECONFIGURE_PENDING;
				    Tcl_DoWhenIdle(ReconfigureWindowsMenu,
					    (ClientData) systemMenuPtr);
				}
			    }
			}
			ckfree(systemMenuName);
		    }
		    if (mePtr->childMenuRefPtr->menuPtr->menuFlags 
			    & MENU_SYSTEM_MENU) {
			systemMenu++;
		    }
		}
	    }
	}
	if (!systemMenu) {
	    InsertMenu(winMenuHdl, 0xFFFFFFFF, flags, itemID, lpNewItem);
	}

	if (itemText != NULL) {
	    ckfree(itemText);
	    itemText = NULL;
	}
    }









|
|




>
|













|














>











>
|









|


















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

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






>







527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614

615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633



634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650

651
652
653
654
655
656
657
658
659
660
661
662

663
664
665
666

667
668
669
670
671
672
673
674
675
676
677
678
679
680
static void
ReconfigureWindowsMenu(
    ClientData clientData)	    /* The menu we are rebuilding */
{
    TkMenu *menuPtr = (TkMenu *) clientData;
    TkMenuEntry *mePtr;
    HMENU winMenuHdl = (HMENU) menuPtr->platformData;
    TCHAR *itemText = NULL;
    const TCHAR *lpNewItem;
    UINT flags;
    UINT itemID;
    int i, count, systemMenu = 0, base;
    int width, height;
    Tcl_DString translatedText;
  
    if (NULL == winMenuHdl) {
    	return;
    }

    /*
     * Reconstruct the entire menu. Takes care of nasty system menu and index
     * problem.
     *
     */

    if ((menuPtr->menuType == MENUBAR)
	    && (menuPtr->parentTopLevelPtr != NULL)) {
	width = Tk_Width(menuPtr->parentTopLevelPtr);
	height = Tk_Height(menuPtr->parentTopLevelPtr);
    }

    base = (menuPtr->menuFlags & MENU_SYSTEM_MENU) ? 7 : 0;
    count = GetMenuItemCount(winMenuHdl);
    for (i = base; i < count; i++) {
	RemoveMenu(winMenuHdl, base, MF_BYPOSITION);
    }

    count = menuPtr->numEntries;
    for (i = 0; i < count; i++) {
	mePtr = menuPtr->entries[i];
	lpNewItem = NULL;
	flags = MF_BYPOSITION;
	itemID = 0;
	Tcl_DStringInit(&translatedText);

	if ((menuPtr->menuType == MENUBAR) && (mePtr->type == TEAROFF_ENTRY)) {
	    continue;
	}

	if (mePtr->type == SEPARATOR_ENTRY) {
	    flags |= MF_SEPARATOR;
	} else {
	    itemText = GetEntryText(mePtr);
	    if ((menuPtr->menuType == MENUBAR)
		    || (menuPtr->menuFlags & MENU_SYSTEM_MENU)) {
		Tcl_UtfToExternalDString(NULL, itemText, -1, &translatedText);
		lpNewItem = Tcl_DStringValue(&translatedText);
	    } else {
		lpNewItem = (LPCTSTR) mePtr;
		flags |= MF_OWNERDRAW;
	    }

    	    /*
    	     * Set enabling and disabling correctly.
    	     */

	    if (mePtr->state == ENTRY_DISABLED) {
		flags |= MF_DISABLED;
	    }
    	    
    	    /*
    	     * Set the check mark for check entries and radio entries.
    	     */
	    
	    if (((mePtr->type == CHECK_BUTTON_ENTRY)
		    || (mePtr->type == RADIO_BUTTON_ENTRY))
		    && (mePtr->entryFlags & ENTRY_SELECTED)) {
		flags |= MF_CHECKED;
	    }

	    if (mePtr->columnBreak) {
		flags |= MF_MENUBREAK;
	    }

	    itemID = (int) mePtr->platformEntryData;
	    if ((mePtr->type == CASCADE_ENTRY)
		    && (mePtr->childMenuRefPtr != NULL)
		    && (mePtr->childMenuRefPtr->menuPtr != NULL)) {

		HMENU childMenuHdl = (HMENU) mePtr->childMenuRefPtr->menuPtr
		    ->platformData;
		if (childMenuHdl != NULL) {
		    itemID = (UINT) childMenuHdl;
		    flags |= MF_POPUP;
		}
		if ((menuPtr->menuType == MENUBAR) 
			&& !(mePtr->childMenuRefPtr->menuPtr->menuFlags
				& MENU_SYSTEM_MENU)) {
		    Tcl_DString ds;
		    TkMenuReferences *menuRefPtr;
		    TkMenu *systemMenuPtr = mePtr->childMenuRefPtr
			->menuPtr;

		    Tcl_DStringInit(&ds);
		    Tcl_DStringAppend(&ds,
			    Tk_PathName(menuPtr->masterMenuPtr->tkwin), -1);
		    Tcl_DStringAppend(&ds, ".system", 7);




		    menuRefPtr = TkFindMenuReferences(menuPtr->interp,
			    Tcl_DStringValue(&ds));
		    
		    Tcl_DStringFree(&ds);

		    if ((menuRefPtr != NULL) 
			    && (menuRefPtr->menuPtr != NULL)
			    && (menuPtr->parentTopLevelPtr != NULL)
			    && (systemMenuPtr->masterMenuPtr
				    == menuRefPtr->menuPtr)) {
			HMENU systemMenuHdl = 
			    (HMENU) systemMenuPtr->platformData;
			HWND wrapper = TkWinGetWrapperWindow(menuPtr
				->parentTopLevelPtr);
			if (wrapper != NULL) {
			    DestroyMenu(systemMenuHdl);
			    systemMenuHdl = GetSystemMenu(wrapper, FALSE);

			    systemMenuPtr->menuFlags |= MENU_SYSTEM_MENU;
			    systemMenuPtr->platformData = 
				(TkMenuPlatformData) systemMenuHdl;
			    if (!(systemMenuPtr->menuFlags 
				    & MENU_RECONFIGURE_PENDING)) {
				systemMenuPtr->menuFlags 
				    |= MENU_RECONFIGURE_PENDING;
				Tcl_DoWhenIdle(ReconfigureWindowsMenu,
					(ClientData) systemMenuPtr);
			    }
			}
		    }

		}
		if (mePtr->childMenuRefPtr->menuPtr->menuFlags 
			& MENU_SYSTEM_MENU) {
		    systemMenu++;

		}
	    }
	}
	if (!systemMenu) {
	    InsertMenu(winMenuHdl, 0xFFFFFFFF, flags, itemID, lpNewItem);
	}
	Tcl_DStringFree(&translatedText);
	if (itemText != NULL) {
	    ckfree(itemText);
	    itemText = NULL;
	}
    }


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
{
    HMENU winMenuHdl = (HMENU) menuPtr->platformData;
    int result, flags;
    RECT noGoawayRect;
    POINT point;
    Tk_Window parentWindow = Tk_Parent(menuPtr->tkwin);
    int oldServiceMode = Tcl_GetServiceMode();



    inPostMenu++;

    if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
	Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr);
	ReconfigureWindowsMenu((ClientData) menuPtr);
    }

    result = TkPreprocessMenu(menuPtr);
    if (result != TCL_OK) {
	inPostMenu--;
	return result;
    }

    /*
     * The post commands could have deleted the menu, which means
     * we are dead and should go away.
     */
    
    if (menuPtr->tkwin == NULL) {
	inPostMenu--;
    	return TCL_OK;
    }

    if (NULL == parentWindow) {
	noGoawayRect.top = y - 50;
	noGoawayRect.bottom = y + 50;
	noGoawayRect.left = x - 50;







>
>

|








|









|







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
{
    HMENU winMenuHdl = (HMENU) menuPtr->platformData;
    int result, flags;
    RECT noGoawayRect;
    POINT point;
    Tk_Window parentWindow = Tk_Parent(menuPtr->tkwin);
    int oldServiceMode = Tcl_GetServiceMode();
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    tsdPtr->inPostMenu++;

    if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
	Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr);
	ReconfigureWindowsMenu((ClientData) menuPtr);
    }

    result = TkPreprocessMenu(menuPtr);
    if (result != TCL_OK) {
	tsdPtr->inPostMenu--;
	return result;
    }

    /*
     * The post commands could have deleted the menu, which means
     * we are dead and should go away.
     */
    
    if (menuPtr->tkwin == NULL) {
	tsdPtr->inPostMenu--;
    	return TCL_OK;
    }

    if (NULL == parentWindow) {
	noGoawayRect.top = y - 50;
	noGoawayRect.bottom = y + 50;
	noGoawayRect.left = x - 50;
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
	    flags |= TPM_RIGHTBUTTON;
	} else {
	    flags |= TPM_LEFTBUTTON;
	}
    }

    TrackPopupMenu(winMenuHdl, flags, x, y, 0, 
	    menuHWND, &noGoawayRect);
    Tcl_SetServiceMode(oldServiceMode);

    GetCursorPos(&point);
    Tk_PointerEvent(NULL, point.x, point.y);

    if (inPostMenu) {
	inPostMenu = 0;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|





|
|







775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
	    flags |= TPM_RIGHTBUTTON;
	} else {
	    flags |= TPM_LEFTBUTTON;
	}
    }

    TrackPopupMenu(winMenuHdl, flags, x, y, 0, 
	    tsdPtr->menuHWND, &noGoawayRect);
    Tcl_SetServiceMode(oldServiceMode);

    GetCursorPos(&point);
    Tk_PointerEvent(NULL, point.x, point.y);

    if (tsdPtr->inPostMenu) {
	tsdPtr->inPostMenu = 0;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
864
865
866
867
868
869
870


871
872
873
874
875

876
877
878
879
880
881
882
883
884
885





886






887
888
889
890
891
892
893
894
895
896
897
898
899


900
901
902


903
904
905
906


907
908
909
910
911
912
913
914
915
916
917
918


919

920
921
922
923
924
925
926




927
928
929
930
931
932
933
934
935
936
937

938




939


940
941
942
943
944
945
946
947
948
949
950

951
952
953
954
955
956



957




958
959
960
961
962
963

964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984





985
986
987
988
989
990
991
992
993
994
995
996
997
998


999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012

1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053

1054
1055
1056

1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
    LPARAM *plParam;
    LRESULT *plResult;
{
    Tcl_HashEntry *hashEntryPtr;
    int returnResult = 0;
    TkMenu *menuPtr;
    TkMenuEntry *mePtr;



    switch (*pMessage) {
	case WM_INITMENU:
	    TkMenuInit();
	    hashEntryPtr = Tcl_FindHashEntry(&winMenuTable, (char *) *pwParam);

	    if (hashEntryPtr != NULL) {
		oldServiceMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
		menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
		modalMenuPtr = menuPtr;
		if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
		    Tcl_CancelIdleCall(ReconfigureWindowsMenu, 
			    (ClientData) menuPtr);
		    ReconfigureWindowsMenu((ClientData) menuPtr);
		}
		if (!inPostMenu) {





		    TkPreprocessMenu(menuPtr);






		}
		TkActivateMenuEntry(menuPtr, -1);
		*plResult = 0;
		returnResult = 1;
	    } else {
		modalMenuPtr = NULL;
	    }
	    break;

	case WM_SYSCOMMAND:
	case WM_COMMAND: {
	    TkMenuInit();
	    if (HIWORD(*pwParam) == 0) {


		hashEntryPtr = Tcl_FindHashEntry(&commandTable,
			(char *)LOWORD(*pwParam));
		if (hashEntryPtr != NULL) {


		    mePtr = (TkMenuEntry *) Tcl_GetHashValue(hashEntryPtr);
		    if (mePtr != NULL) {
			TkMenuReferences *menuRefPtr;
			TkMenuEntry *parentEntryPtr;



			/*
			 * We have to set the parent of this menu to be active
			 * if this is a submenu so that tearoffs will get the
			 * correct title.
			 */

			menuPtr = mePtr->menuPtr;
    			menuRefPtr = TkFindMenuReferences(menuPtr->interp,
    	    			Tk_PathName(menuPtr->tkwin));
    			if ((menuRefPtr != NULL) && (menuRefPtr->parentEntryPtr 
				!= NULL)) {


    	    		    for (parentEntryPtr = menuRefPtr->parentEntryPtr;

    	    	    		    strcmp(parentEntryPtr->name, 
				    Tk_PathName(menuPtr->tkwin)) != 0; 
				    parentEntryPtr = parentEntryPtr->nextCascadePtr) {

				/*
				 * Empty loop body.
				 */





    	    		    }
    	    		    if (parentEntryPtr->menuPtr
    	    		    	    ->entries[parentEntryPtr->index]->state
    	    		    	    != tkDisabledUid) {
			    	TkActivateMenuEntry(parentEntryPtr->menuPtr, 
				    	parentEntryPtr->index);
			    }
    			}

		    	TkInvokeMenu(mePtr->menuPtr->interp,

				menuPtr, mePtr->index);




		    }


		    *plResult = 0;
		    returnResult = 1;
		}
	    }
	    break;
	}


	case WM_MENUCHAR: {
	    unsigned char menuChar = (unsigned char) LOWORD(*pwParam);
	    hashEntryPtr = Tcl_FindHashEntry(&winMenuTable, (char *) *plParam);

	    if (hashEntryPtr != NULL) {
		int i;

		*plResult = 0;
		menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
		for (i = 0; i < menuPtr->numEntries; i++) {



		    int underline = menuPtr->entries[i]->underline;




		    if ((-1 != underline) 
			    && (NULL != menuPtr->entries[i]->label)
			    && (CharUpper((LPTSTR) menuChar) 
			    == CharUpper((LPTSTR) (unsigned char) menuPtr
			    ->entries[i]->label[underline]))) {
			*plResult = (2 << 16) | i;

			break;
		    }
		}
		returnResult = 1;
	    }
	    break;
	}

	case WM_MEASUREITEM: {
	    LPMEASUREITEMSTRUCT itemPtr = (LPMEASUREITEMSTRUCT) *plParam;
    
	    if (itemPtr != NULL) {
		mePtr = (TkMenuEntry *) itemPtr->itemData;
		menuPtr = mePtr->menuPtr;

		TkRecomputeMenu(menuPtr);
		itemPtr->itemHeight = mePtr->height;
		itemPtr->itemWidth = mePtr->width;
		if (mePtr->hideMargin) {
		    itemPtr->itemWidth += 2 - indicatorDimensions[0];
		} else {





		    itemPtr->itemWidth += 2 * menuPtr->activeBorderWidth;
		}
		*plResult = 1;
		returnResult = 1;
	    }
	    break;
	}
	
	case WM_DRAWITEM: {
	    TkWinDrawable *twdPtr;
	    LPDRAWITEMSTRUCT itemPtr = (LPDRAWITEMSTRUCT) *plParam;
	    Tk_FontMetrics fontMetrics;

	    if (itemPtr != NULL) {


		mePtr = (TkMenuEntry *) itemPtr->itemData;
		menuPtr = mePtr->menuPtr;
		twdPtr = (TkWinDrawable *) ckalloc(sizeof(TkWinDrawable));
		twdPtr->type = TWD_WINDC;
		twdPtr->winDC.hdc = itemPtr->hDC;

		if (mePtr->state != tkDisabledUid) {
		    if (itemPtr->itemState & ODS_SELECTED) {
			TkActivateMenuEntry(menuPtr, mePtr->index);
		    } else {
			TkActivateMenuEntry(menuPtr, -1);
		    }
		}


		Tk_GetFontMetrics(menuPtr->tkfont, &fontMetrics);
		TkpDrawMenuEntry(mePtr, (Drawable) twdPtr, menuPtr->tkfont,
			&fontMetrics, itemPtr->rcItem.left,
			itemPtr->rcItem.top, itemPtr->rcItem.right
			- itemPtr->rcItem.left, itemPtr->rcItem.bottom
			- itemPtr->rcItem.top, 0, 0);

		ckfree((char *) twdPtr);
		*plResult = 1;
		returnResult = 1;
	    }
	    break;
	}

	case WM_MENUSELECT: {
	    UINT flags = HIWORD(*pwParam);

	    TkMenuInit();

	    if ((flags == 0xFFFF) && (*plParam == 0)) {
		Tcl_SetServiceMode(oldServiceMode);
		if (modalMenuPtr != NULL) {
		    RecursivelyClearActiveMenu(modalMenuPtr);
		}
	    } else {
		menuPtr = NULL;
		if (*plParam != 0) {
		    hashEntryPtr = Tcl_FindHashEntry(&winMenuTable,
			    (char *) *plParam);
		    if (hashEntryPtr != NULL) {
			menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
		    }
		}

		if (menuPtr != NULL) {
	    	    mePtr = NULL;
		    if (flags != 0xFFFF) {
			if (flags & MF_POPUP) {
			    mePtr = menuPtr->entries[LOWORD(*pwParam)];
			} else {
			    hashEntryPtr = Tcl_FindHashEntry(&commandTable,

				    (char *) LOWORD(*pwParam));
			    if (hashEntryPtr != NULL) {
				mePtr = (TkMenuEntry *) Tcl_GetHashValue(hashEntryPtr);

			    }
			}
		    }	 

		    if ((mePtr == NULL) || (mePtr->state == tkDisabledUid)) {
			TkActivateMenuEntry(menuPtr, -1);
		    } else {
			TkActivateMenuEntry(menuPtr, mePtr->index);
		    }
		    MenuSelectEvent(menuPtr);
		    Tcl_ServiceAll();
		}







>
>




|
>

|

|





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





|






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

|
|
|
|
|

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

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






|
>






>
>
>
|
>
>
>
>

|

|
|

>



<















|

>
>
>
>
>
|













>
>






|







>
|
|


















|
|
|



|
|












|
>


|
>




|







891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970

971
972



973
974
975
976
977
978
979
980

981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997


998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029

1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
    LPARAM *plParam;
    LRESULT *plResult;
{
    Tcl_HashEntry *hashEntryPtr;
    int returnResult = 0;
    TkMenu *menuPtr;
    TkMenuEntry *mePtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    switch (*pMessage) {
	case WM_INITMENU:
	    TkMenuInit();
	    hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, 
                    (char *) *pwParam);
	    if (hashEntryPtr != NULL) {
		tsdPtr->oldServiceMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
		menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
		tsdPtr->modalMenuPtr = menuPtr;
		if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
		    Tcl_CancelIdleCall(ReconfigureWindowsMenu, 
			    (ClientData) menuPtr);
		    ReconfigureWindowsMenu((ClientData) menuPtr);
		}
		if (!tsdPtr->inPostMenu) {
		    Tcl_Interp *interp;
		    int code;

		    interp = menuPtr->interp;
		    Tcl_Preserve((ClientData)interp);
		    code = TkPreprocessMenu(menuPtr);
		    if ((code != TCL_OK) && (code != TCL_CONTINUE)
			    && (code != TCL_BREAK)) {
			Tcl_AddErrorInfo(interp, "\n    (menu preprocess)");
			Tcl_BackgroundError(interp);
		    }
		    Tcl_Release((ClientData)interp);
		}
		TkActivateMenuEntry(menuPtr, -1);
		*plResult = 0;
		returnResult = 1;
	    } else {
		tsdPtr->modalMenuPtr = NULL;
	    }
	    break;

	case WM_SYSCOMMAND:
	case WM_COMMAND: {
	    TkMenuInit();
	    if (HIWORD(*pwParam) != 0) {
		break;
	    }
	    hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable,
		    (char *)LOWORD(*pwParam));
	    if (hashEntryPtr == NULL) {
		break;
	    }
	    mePtr = (TkMenuEntry *) Tcl_GetHashValue(hashEntryPtr);
	    if (mePtr != NULL) {
		TkMenuReferences *menuRefPtr;
		TkMenuEntry *parentEntryPtr;
		Tcl_Interp *interp;
		int code;

		/*
		 * We have to set the parent of this menu to be active
		 * if this is a submenu so that tearoffs will get the
		 * correct title.
		 */

		menuPtr = mePtr->menuPtr;
		menuRefPtr = TkFindMenuReferences(menuPtr->interp,
			Tk_PathName(menuPtr->tkwin));
		if ((menuRefPtr != NULL)
			&& (menuRefPtr->parentEntryPtr != NULL)) {
		    char *name;

		    for (parentEntryPtr = menuRefPtr->parentEntryPtr;
			 ; 
			 parentEntryPtr = 

			     parentEntryPtr->nextCascadePtr) {
			name = Tcl_GetStringFromObj(



			    parentEntryPtr->namePtr, NULL);
			if (strcmp(name, Tk_PathName(menuPtr->tkwin))
				== 0) {
			    break;
			}
		    }
		    if (parentEntryPtr->menuPtr->entries[parentEntryPtr->index]
			    ->state != ENTRY_DISABLED) {

			TkActivateMenuEntry(parentEntryPtr->menuPtr, 
				parentEntryPtr->index);
		    }
		}

		interp = menuPtr->interp;
		Tcl_Preserve((ClientData)interp);
		code = TkInvokeMenu(interp, menuPtr, mePtr->index);
		if (code != TCL_OK && code != TCL_CONTINUE
			&& code != TCL_BREAK) {
		    Tcl_AddErrorInfo(interp, "\n    (menu invoke)");
		    Tcl_BackgroundError(interp);
		}
		Tcl_Release((ClientData)interp);
	    }
	    *plResult = 0;
	    returnResult = 1;


	    break;
	}


	case WM_MENUCHAR: {
	    unsigned char menuChar = (unsigned char) LOWORD(*pwParam);
	    hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, 
                    (char *) *plParam);
	    if (hashEntryPtr != NULL) {
		int i;

		*plResult = 0;
		menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
		for (i = 0; i < menuPtr->numEntries; i++) {
		    int underline;
		    char *label;

		    underline = menuPtr->entries[i]->underline;
		    if (menuPtr->entries[i]->labelPtr != NULL) {
			label = Tcl_GetStringFromObj(
				menuPtr->entries[i]->labelPtr, NULL);
		    }
		    if ((-1 != underline) 
			    && (NULL != menuPtr->entries[i]->labelPtr)
			    && (CharUpper((LPTSTR) menuChar) 
			    == CharUpper((LPTSTR) (unsigned char) 
			    label[underline]))) {
			*plResult = (2 << 16) | i;
			returnResult = 1;
			break;
		    }
		}

	    }
	    break;
	}

	case WM_MEASUREITEM: {
	    LPMEASUREITEMSTRUCT itemPtr = (LPMEASUREITEMSTRUCT) *plParam;
    
	    if (itemPtr != NULL) {
		mePtr = (TkMenuEntry *) itemPtr->itemData;
		menuPtr = mePtr->menuPtr;

		TkRecomputeMenu(menuPtr);
		itemPtr->itemHeight = mePtr->height;
		itemPtr->itemWidth = mePtr->width;
		if (mePtr->hideMargin) {
		    itemPtr->itemWidth += 2 - indicatorDimensions[1];
		} else {
		    int activeBorderWidth;
		    
		    Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
			    menuPtr->activeBorderWidthPtr, 
			    &activeBorderWidth);
		    itemPtr->itemWidth += 2 * activeBorderWidth;
		}
		*plResult = 1;
		returnResult = 1;
	    }
	    break;
	}
	
	case WM_DRAWITEM: {
	    TkWinDrawable *twdPtr;
	    LPDRAWITEMSTRUCT itemPtr = (LPDRAWITEMSTRUCT) *plParam;
	    Tk_FontMetrics fontMetrics;

	    if (itemPtr != NULL) {
		Tk_Font tkfont;

		mePtr = (TkMenuEntry *) itemPtr->itemData;
		menuPtr = mePtr->menuPtr;
		twdPtr = (TkWinDrawable *) ckalloc(sizeof(TkWinDrawable));
		twdPtr->type = TWD_WINDC;
		twdPtr->winDC.hdc = itemPtr->hDC;

		if (mePtr->state != ENTRY_DISABLED) {
		    if (itemPtr->itemState & ODS_SELECTED) {
			TkActivateMenuEntry(menuPtr, mePtr->index);
		    } else {
			TkActivateMenuEntry(menuPtr, -1);
		    }
		}

		tkfont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
		Tk_GetFontMetrics(tkfont, &fontMetrics);
		TkpDrawMenuEntry(mePtr, (Drawable) twdPtr, tkfont,
			&fontMetrics, itemPtr->rcItem.left,
			itemPtr->rcItem.top, itemPtr->rcItem.right
			- itemPtr->rcItem.left, itemPtr->rcItem.bottom
			- itemPtr->rcItem.top, 0, 0);

		ckfree((char *) twdPtr);
		*plResult = 1;
		returnResult = 1;
	    }
	    break;
	}

	case WM_MENUSELECT: {
	    UINT flags = HIWORD(*pwParam);

	    TkMenuInit();

	    if ((flags == 0xFFFF) && (*plParam == 0)) {
		Tcl_SetServiceMode(tsdPtr->oldServiceMode);
		if (tsdPtr->modalMenuPtr != NULL) {
		    RecursivelyClearActiveMenu(tsdPtr->modalMenuPtr);
		}
	    } else {
		menuPtr = NULL;
 		if (*plParam != 0) {
		    hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
			    (char *) *plParam);
		    if (hashEntryPtr != NULL) {
			menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
		    }
		}

		if (menuPtr != NULL) {
	    	    mePtr = NULL;
		    if (flags != 0xFFFF) {
			if (flags & MF_POPUP) {
			    mePtr = menuPtr->entries[LOWORD(*pwParam)];
			} else {
			    hashEntryPtr = Tcl_FindHashEntry(
                                    &tsdPtr->commandTable,
				    (char *) LOWORD(*pwParam));
			    if (hashEntryPtr != NULL) {
				mePtr = (TkMenuEntry *) 
					Tcl_GetHashValue(hashEntryPtr);
			    }
			}
		    }	 

		    if ((mePtr == NULL) || (mePtr->state == ENTRY_DISABLED)) {
			TkActivateMenuEntry(menuPtr, -1);
		    } else {
			TkActivateMenuEntry(menuPtr, mePtr->index);
		    }
		    MenuSelectEvent(menuPtr);
		    Tcl_ServiceAll();
		}
1127
1128
1129
1130
1131
1132
1133


1134
1135
1136
1137
1138
1139
1140

1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152

void
TkpSetWindowMenuBar(tkwin, menuPtr)
    Tk_Window tkwin;	    /* The window we are putting the menubar into.*/
    TkMenu *menuPtr;	    /* The menu we are inserting */
{
    HMENU winMenuHdl;



    if (menuPtr != NULL) {
	Tcl_HashEntry *hashEntryPtr;
	int newEntry;

	winMenuHdl = (HMENU) menuPtr->platformData;
	hashEntryPtr = Tcl_FindHashEntry(&winMenuTable, (char *) winMenuHdl);

	Tcl_DeleteHashEntry(hashEntryPtr);
	DestroyMenu(winMenuHdl);
	winMenuHdl = CreateMenu();
	hashEntryPtr = Tcl_CreateHashEntry(&winMenuTable, (char *) winMenuHdl,
		&newEntry);
	Tcl_SetHashValue(hashEntryPtr, (char *) menuPtr);
	menuPtr->platformData = (TkMenuPlatformData) winMenuHdl;
	TkWinSetMenu(tkwin, winMenuHdl);
	if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
	    Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr);
	    menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
	}







>
>






|
>



|
|







1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227

void
TkpSetWindowMenuBar(tkwin, menuPtr)
    Tk_Window tkwin;	    /* The window we are putting the menubar into.*/
    TkMenu *menuPtr;	    /* The menu we are inserting */
{
    HMENU winMenuHdl;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (menuPtr != NULL) {
	Tcl_HashEntry *hashEntryPtr;
	int newEntry;

	winMenuHdl = (HMENU) menuPtr->platformData;
	hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable, 
                (char *) winMenuHdl);
	Tcl_DeleteHashEntry(hashEntryPtr);
	DestroyMenu(winMenuHdl);
	winMenuHdl = CreateMenu();
	hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->winMenuTable, 
                (char *) winMenuHdl, &newEntry);
	Tcl_SetHashValue(hashEntryPtr, (char *) menuPtr);
	menuPtr->platformData = (TkMenuPlatformData) winMenuHdl;
	TkWinSetMenu(tkwin, winMenuHdl);
	if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
	    Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr);
	    menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
	}
1210
1211
1212
1213
1214
1215
1216




1217
1218
1219
1220
1221
1222
1223
1224
    int *widthPtr,			/* The resulting width */
    int *heightPtr)			/* The resulting height */
{
    *heightPtr = indicatorDimensions[0];
    if (mePtr->hideMargin) {
	*widthPtr = 0;
    } else {




	*widthPtr = indicatorDimensions[1] - menuPtr->borderWidth;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * GetMenuAccelGeometry --







>
>
>
>
|







1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
    int *widthPtr,			/* The resulting width */
    int *heightPtr)			/* The resulting height */
{
    *heightPtr = indicatorDimensions[0];
    if (mePtr->hideMargin) {
	*widthPtr = 0;
    } else {
	int borderWidth;

	Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
		menuPtr->borderWidthPtr, &borderWidth);
	*widthPtr = indicatorDimensions[1] - borderWidth;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * GetMenuAccelGeometry --
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251

1252
1253
1254
1255
1256
1257
1258
1259
    CONST Tk_FontMetrics *fmPtr,	/* The precalculated font metrics */
    int *widthPtr,			/* The resulting width */
    int *heightPtr)			/* The resulting height */
{
    *heightPtr = fmPtr->linespace;
    if (mePtr->type == CASCADE_ENTRY) {
	*widthPtr = 0;
    } else if (mePtr->accel == NULL) {
	*widthPtr = 0;
    } else {

	*widthPtr = Tk_TextWidth(tkfont, mePtr->accel, mePtr->accelLength);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * GetTearoffEntryGeometry --







|


>
|







1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
    CONST Tk_FontMetrics *fmPtr,	/* The precalculated font metrics */
    int *widthPtr,			/* The resulting width */
    int *heightPtr)			/* The resulting height */
{
    *heightPtr = fmPtr->linespace;
    if (mePtr->type == CASCADE_ENTRY) {
	*widthPtr = 0;
    } else if (mePtr->accelPtr == NULL) {
	*widthPtr = 0;
    } else {
	char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
	*widthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * GetTearoffEntryGeometry --
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
 */

static void
DrawWindowsSystemBitmap(display, drawable, gc, rectPtr, bitmapID, alignFlags)
    Display *display;			/* The display we are drawing into */
    Drawable drawable;			/* The drawable we are working with */
    GC gc;				/* The GC to draw with */
    CONST RECT *rectPtr;		/* The rectangle to draw into */			
    int bitmapID;			/* The windows id of the system
					 * bitmap to draw. */
    int alignFlags;			/* How to align the bitmap inside the
					 * rectangle. */
{
    TkWinDCState state;
    HDC hdc = TkWinGetDrawableDC(display, drawable, &state);







|







1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
 */

static void
DrawWindowsSystemBitmap(display, drawable, gc, rectPtr, bitmapID, alignFlags)
    Display *display;			/* The display we are drawing into */
    Drawable drawable;			/* The drawable we are working with */
    GC gc;				/* The GC to draw with */
    CONST RECT *rectPtr;		/* The rectangle to draw into */
    int bitmapID;			/* The windows id of the system
					 * bitmap to draw. */
    int alignFlags;			/* How to align the bitmap inside the
					 * rectangle. */
{
    TkWinDCState state;
    HDC hdc = TkWinGetDrawableDC(display, drawable, &state);
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442



1443

1444
1445
1446

1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468

1469
1470
1471
1472
1473
1474
1475
    Tk_Font tkfont;		    /* The precalculated font */
    CONST Tk_FontMetrics *fmPtr;    /* The precalculated font metrics */
    int x;			    /* Left edge */
    int y;			    /* Top edge */
    int width;
    int height;
{
    if ((mePtr->type == CHECK_BUTTON_ENTRY || 
    	    mePtr->type == RADIO_BUTTON_ENTRY) 
    	    && mePtr->indicatorOn
	    && mePtr->entryFlags & ENTRY_SELECTED) {
	RECT rect;
	GC whichGC;

	if (mePtr->state != tkNormalUid) {
	    whichGC = gc;
	} else {
	    whichGC = indicatorGC;
	}

	rect.top = y;
	rect.bottom = y + mePtr->height;



	rect.left = menuPtr->borderWidth + menuPtr->activeBorderWidth + x;

	rect.right = mePtr->indicatorSpace + x;

	if ((mePtr->state == tkDisabledUid) && (menuPtr->disabledFg != NULL)

		&& (versionInfo.dwMajorVersion >= 4)) {
	    RECT hilightRect;
	    COLORREF oldFgColor = whichGC->foreground;
	
	    whichGC->foreground = GetSysColor(COLOR_3DHILIGHT);
	    hilightRect.top = rect.top + 1;
	    hilightRect.bottom = rect.bottom + 1;
	    hilightRect.left = rect.left + 1;
	    hilightRect.right = rect.right + 1;
	    DrawWindowsSystemBitmap(menuPtr->display, d, whichGC, 
		    &hilightRect, OBM_CHECK, 0);
	    whichGC->foreground = oldFgColor;
	}

	DrawWindowsSystemBitmap(menuPtr->display, d, whichGC, &rect, 
		OBM_CHECK, 0);

	if ((mePtr->state == tkDisabledUid) 
		&& (menuPtr->disabledImageGC != None)
		&& (versionInfo.dwMajorVersion < 4)) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
		    rect.left, rect.top, rect.right, rect.bottom);

	}
    }    
}

/*
 *----------------------------------------------------------------------
 *







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

|
|
>
>
>
|
>
|

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

|
|

|
|
|
|
|
>







1501
1502
1503
1504
1505
1506
1507
1508
1509

1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
    Tk_Font tkfont;		    /* The precalculated font */
    CONST Tk_FontMetrics *fmPtr;    /* The precalculated font metrics */
    int x;			    /* Left edge */
    int y;			    /* Top edge */
    int width;
    int height;
{
    if ((mePtr->type == CHECK_BUTTON_ENTRY) 
	    || (mePtr->type == RADIO_BUTTON_ENTRY)) {

    	if (mePtr->indicatorOn && (mePtr->entryFlags & ENTRY_SELECTED)) {
	    RECT rect;
	    GC whichGC;
	    int borderWidth, activeBorderWidth;
	    if (mePtr->state != ENTRY_NORMAL) {
		whichGC = gc;
	    } else {
		whichGC = indicatorGC;
	    }

	    rect.top = y;
	    rect.bottom = y + mePtr->height;
	    Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
		    menuPtr->borderWidthPtr, &borderWidth);
	    Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
		    menuPtr->activeBorderWidthPtr, &activeBorderWidth);
	    rect.left = borderWidth + activeBorderWidth + x;
	    rect.right = mePtr->indicatorSpace + x;

	    if ((mePtr->state == ENTRY_DISABLED)
		    && (menuPtr->disabledFgPtr != NULL)
		    && (versionInfo.dwMajorVersion >= 4)) {
		RECT hilightRect;
		COLORREF oldFgColor = whichGC->foreground;
	    
		whichGC->foreground = GetSysColor(COLOR_3DHILIGHT);
		hilightRect.top = rect.top + 1;
		hilightRect.bottom = rect.bottom + 1;
		hilightRect.left = rect.left + 1;
		hilightRect.right = rect.right + 1;
		DrawWindowsSystemBitmap(menuPtr->display, d, whichGC, 
			&hilightRect, OBM_CHECK, 0);
		whichGC->foreground = oldFgColor;
	    }

	    DrawWindowsSystemBitmap(menuPtr->display, d, whichGC, &rect, 
		    OBM_CHECK, 0);

	    if ((mePtr->state == ENTRY_DISABLED) 
		    && (menuPtr->disabledImageGC != None)
		    && (versionInfo.dwMajorVersion < 4)) {
		XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
			rect.left, rect.top, rect.right, rect.bottom);
	    }
	}
    }    
}

/*
 *----------------------------------------------------------------------
 *
1506
1507
1508
1509
1510
1511
1512





1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
    int drawArrow;			/* For cascade menus, whether of not
					 * to draw the arraw. I cannot figure
					 * out Windows' algorithm for where
					 * to draw this. */
{
    int baseline;
    int leftEdge = x + mePtr->indicatorSpace + mePtr->labelWidth;






    baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;

    if ((mePtr->state == tkDisabledUid) && (menuPtr->disabledFg != NULL)
	    && ((mePtr->accel != NULL)
	    || ((mePtr->type == CASCADE_ENTRY) && drawArrow))) {
	if (versionInfo.dwMajorVersion >= 4) {
	    COLORREF oldFgColor = gc->foreground;
	    
	    gc->foreground = GetSysColor(COLOR_3DHILIGHT);
	    if (mePtr->accel != NULL) {
		Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel,
			mePtr->accelLength, leftEdge + 1, baseline + 1);
	    }

	    if (mePtr->type == CASCADE_ENTRY) {
		RECT rect;

		rect.top = y + GetSystemMetrics(SM_CYBORDER) + 1;
		rect.bottom = y + height - GetSystemMetrics(SM_CYBORDER) + 1;
		rect.left = x + mePtr->indicatorSpace + mePtr->labelWidth + 1;
		rect.right = x + width;
		DrawWindowsSystemBitmap(menuPtr->display, d, gc, &rect, 
			OBM_MNARROW, ALIGN_BITMAP_RIGHT);
	    }
	    gc->foreground = oldFgColor;
	}
    }

    if (mePtr->accel != NULL) {
	Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel, 
		mePtr->accelLength, leftEdge, baseline);
    }

    if ((mePtr->state == tkDisabledUid) 
	    && (menuPtr->disabledImageGC != None)
	    && (versionInfo.dwMajorVersion < 4)) {
	XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
		leftEdge, y, width - mePtr->labelWidth 
		- mePtr->indicatorSpace, height);
    }

    if ((mePtr->type == CASCADE_ENTRY) && drawArrow) {
	RECT rect;

	rect.top = y + GetSystemMetrics(SM_CYBORDER);
	rect.bottom = y + height - GetSystemMetrics(SM_CYBORDER);
	rect.left = x + mePtr->indicatorSpace + mePtr->labelWidth;
	rect.right = x + width - 1;
	DrawWindowsSystemBitmap(menuPtr->display, d, gc, &rect, OBM_MNARROW, 
		ALIGN_BITMAP_RIGHT);
	if ((mePtr->state == tkDisabledUid) 
		&& (menuPtr->disabledImageGC != None)
		&& (versionInfo.dwMajorVersion < 4)) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
		    rect.left, rect.top, rect.right, rect.bottom);
	}
    }
}







>
>
>
>
>



|
|





|
|

















|
|



|
















|







1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
    int drawArrow;			/* For cascade menus, whether of not
					 * to draw the arraw. I cannot figure
					 * out Windows' algorithm for where
					 * to draw this. */
{
    int baseline;
    int leftEdge = x + mePtr->indicatorSpace + mePtr->labelWidth;
    char *accel;
    
    if (mePtr->accelPtr != NULL) {
	accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
    }

    baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;

    if ((mePtr->state == ENTRY_DISABLED) && (menuPtr->disabledFgPtr != NULL)
	    && ((mePtr->accelPtr != NULL)
	    || ((mePtr->type == CASCADE_ENTRY) && drawArrow))) {
	if (versionInfo.dwMajorVersion >= 4) {
	    COLORREF oldFgColor = gc->foreground;
	    
	    gc->foreground = GetSysColor(COLOR_3DHILIGHT);
	    if (mePtr->accelPtr != NULL) {
		Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
			mePtr->accelLength, leftEdge + 1, baseline + 1);
	    }

	    if (mePtr->type == CASCADE_ENTRY) {
		RECT rect;

		rect.top = y + GetSystemMetrics(SM_CYBORDER) + 1;
		rect.bottom = y + height - GetSystemMetrics(SM_CYBORDER) + 1;
		rect.left = x + mePtr->indicatorSpace + mePtr->labelWidth + 1;
		rect.right = x + width;
		DrawWindowsSystemBitmap(menuPtr->display, d, gc, &rect, 
			OBM_MNARROW, ALIGN_BITMAP_RIGHT);
	    }
	    gc->foreground = oldFgColor;
	}
    }

    if (mePtr->accelPtr != NULL) {
	Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel, 
		mePtr->accelLength, leftEdge, baseline);
    }

    if ((mePtr->state == ENTRY_DISABLED) 
	    && (menuPtr->disabledImageGC != None)
	    && (versionInfo.dwMajorVersion < 4)) {
	XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
		leftEdge, y, width - mePtr->labelWidth 
		- mePtr->indicatorSpace, height);
    }

    if ((mePtr->type == CASCADE_ENTRY) && drawArrow) {
	RECT rect;

	rect.top = y + GetSystemMetrics(SM_CYBORDER);
	rect.bottom = y + height - GetSystemMetrics(SM_CYBORDER);
	rect.left = x + mePtr->indicatorSpace + mePtr->labelWidth;
	rect.right = x + width - 1;
	DrawWindowsSystemBitmap(menuPtr->display, d, gc, &rect, OBM_MNARROW, 
		ALIGN_BITMAP_RIGHT);
	if ((mePtr->state == ENTRY_DISABLED) 
		&& (menuPtr->disabledImageGC != None)
		&& (versionInfo.dwMajorVersion < 4)) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
		    rect.left, rect.top, rect.right, rect.bottom);
	}
    }
}
1596
1597
1598
1599
1600
1601
1602

1603
1604
1605
1606
1607

1608
1609
1610
1611
1612
1613
1614
1615
1616
    CONST Tk_FontMetrics *fmPtr;	/* The precalculated font metrics */
    int x;				/* left edge */
    int y;				/* top edge */
    int width;				/* width of item */
    int height;				/* height of item */
{
    XPoint points[2];


    points[0].x = x;
    points[0].y = y + height / 2;
    points[1].x = x + width - 1;
    points[1].y = points[0].y;

    Tk_Draw3DPolygon(menuPtr->tkwin, d,
	    menuPtr->border, points, 2, 1, TK_RELIEF_RAISED);
}

/*
 *----------------------------------------------------------------------
 *
 * DrawMenuUnderline --
 *







>





>
|
|







1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
    CONST Tk_FontMetrics *fmPtr;	/* The precalculated font metrics */
    int x;				/* left edge */
    int y;				/* top edge */
    int width;				/* width of item */
    int height;				/* height of item */
{
    XPoint points[2];
    Tk_3DBorder border;

    points[0].x = x;
    points[0].y = y + height / 2;
    points[1].x = x + width - 1;
    points[1].y = points[0].y;
    border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
    Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1, 
	    TK_RELIEF_RAISED);
}

/*
 *----------------------------------------------------------------------
 *
 * DrawMenuUnderline --
 *
1636
1637
1638
1639
1640
1641
1642




1643
1644
1645
1646

1647
1648
1649
1650
1651
1652
1653
    CONST Tk_FontMetrics *fmPtr,	/* The precalculated font metrics */
    int x,				/* Left Edge */
    int y,				/* Top Edge */
    int width,				/* Width of entry */
    int height)				/* Height of entry */
{
    if (mePtr->underline >= 0) {




    	Tk_UnderlineChars(menuPtr->display, d,
    		gc, tkfont, mePtr->label, x + mePtr->indicatorSpace,
    		y + (height + fmPtr->ascent - fmPtr->descent) / 2, 
		mePtr->underline, mePtr->underline + 1);

    }		
}

/*
 *--------------------------------------------------------------
 *
 * MenuKeyBindProc --







>
>
>
>

|

<
>







1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741

1742
1743
1744
1745
1746
1747
1748
1749
    CONST Tk_FontMetrics *fmPtr,	/* The precalculated font metrics */
    int x,				/* Left Edge */
    int y,				/* Top Edge */
    int width,				/* Width of entry */
    int height)				/* Height of entry */
{
    if (mePtr->underline >= 0) {
	char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
	char *start = Tcl_UtfAtIndex(label, mePtr->underline);
	char *end = Tcl_UtfNext(start);

    	Tk_UnderlineChars(menuPtr->display, d,
    		gc, tkfont, label, x + mePtr->indicatorSpace,
    		y + (height + fmPtr->ascent - fmPtr->descent) / 2, 

		start - label, end - label);
    }		
}

/*
 *--------------------------------------------------------------
 *
 * MenuKeyBindProc --
1673
1674
1675
1676
1677
1678
1679

1680
1681
1682
1683
1684
1685
1686
    XEvent *eventPtr;		/* The XEvent to process */
    Tk_Window tkwin;		/* The window receiving the event */
    KeySym keySym;		/* The key sym that is produced. */
{
    UINT scanCode;
    UINT virtualKey;
    TkWindow *winPtr = (TkWindow *)tkwin;


    if (eventPtr->type == KeyPress) {
	switch (keySym) {
	case XK_Alt_L:
	    scanCode = MapVirtualKey(VK_LMENU, 0);
	    CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
		    WM_SYSKEYDOWN, VK_MENU, (scanCode << 16)







>







1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
    XEvent *eventPtr;		/* The XEvent to process */
    Tk_Window tkwin;		/* The window receiving the event */
    KeySym keySym;		/* The key sym that is produced. */
{
    UINT scanCode;
    UINT virtualKey;
    TkWindow *winPtr = (TkWindow *)tkwin;
    int i;

    if (eventPtr->type == KeyPress) {
	switch (keySym) {
	case XK_Alt_L:
	    scanCode = MapVirtualKey(VK_LMENU, 0);
	    CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
		    WM_SYSKEYDOWN, VK_MENU, (scanCode << 16)
1700
1701
1702
1703
1704
1705
1706









1707
1708
1709
1710
1711
1712
1713
	default:
	    virtualKey = XKeysymToKeycode(winPtr->display, keySym);
	    scanCode = MapVirtualKey(virtualKey, 0);
	    if (0 != scanCode) {
		CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
			WM_SYSKEYDOWN, virtualKey, ((scanCode << 16)
			| (1 << 29)));









	    }
	}
    } else if (eventPtr->type == KeyRelease) {
	switch (keySym) {
	case XK_Alt_L:
	    scanCode = MapVirtualKey(VK_LMENU, 0);
	    CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),







>
>
>
>
>
>
>
>
>







1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
	default:
	    virtualKey = XKeysymToKeycode(winPtr->display, keySym);
	    scanCode = MapVirtualKey(virtualKey, 0);
	    if (0 != scanCode) {
		CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
			WM_SYSKEYDOWN, virtualKey, ((scanCode << 16)
			| (1 << 29)));
		if (eventPtr->xkey.nbytes > 0) {
		    for (i = 0; i < eventPtr->xkey.nbytes; i++) {
			CallWindowProc(DefWindowProc,
				Tk_GetHWND(Tk_WindowId(tkwin)),
				WM_SYSCHAR,
				eventPtr->xkey.trans_chars[i],
				((scanCode << 16) | (1 << 29)));
		    }
		}
	    }
	}
    } else if (eventPtr->type == KeyRelease) {
	switch (keySym) {
	case XK_Alt_L:
	    scanCode = MapVirtualKey(VK_LMENU, 0);
	    CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
1818
1819
1820
1821
1822
1823
1824

1825
1826




1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855

1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
    int x,				/* left edge */
    int y,				/* right edge */
    int width,				/* width of entry */
    int height)				/* height of entry */
{
    int baseline;
    int indicatorSpace =  mePtr->indicatorSpace;

    int leftEdge = x + indicatorSpace + menuPtr->activeBorderWidth;
    int imageHeight, imageWidth;





    /*
     * Draw label or bitmap or image for entry.
     */

    baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
    if (mePtr->image != NULL) {
    	Tk_SizeOfImage(mePtr->image, &imageWidth, &imageHeight);
    	if ((mePtr->selectImage != NULL)
	    	&& (mePtr->entryFlags & ENTRY_SELECTED)) {
	    Tk_RedrawImage(mePtr->selectImage, 0, 0,
		    imageWidth, imageHeight, d, leftEdge,
	            (int) (y + (mePtr->height - imageHeight)/2));
    	} else {
	    Tk_RedrawImage(mePtr->image, 0, 0, imageWidth,
		    imageHeight, d, leftEdge,
		    (int) (y + (mePtr->height - imageHeight)/2));
    	}
    } else if (mePtr->bitmap != None) {
    	int width, height;

        Tk_SizeOfBitmap(menuPtr->display,
	        mePtr->bitmap, &width, &height);
    	XCopyPlane(menuPtr->display,
	    	mePtr->bitmap, d,
	    	gc, 0, 0, (unsigned) width, (unsigned) height, leftEdge,
	    	(int) (y + (mePtr->height - height)/2), 1);
    } else {
    	if (mePtr->labelLength > 0) {

	    Tk_DrawChars(menuPtr->display, d, gc,
		    tkfont, mePtr->label, mePtr->labelLength,
		    leftEdge, baseline);
	    DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y,
		    width, height);
    	}
    }

    if (mePtr->state == tkDisabledUid) {
	if (menuPtr->disabledFg == NULL) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
		    (unsigned) width, (unsigned) height);
	} else if ((mePtr->image != NULL) 
		&& (menuPtr->disabledImageGC != None)) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
		    leftEdge,
		    (int) (y + (mePtr->height - imageHeight)/2),







>
|

>
>
>
>


















|

|
|
<
|
<
|
|


>
|
<
|





|
|







1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959

1960

1961
1962
1963
1964
1965
1966

1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
    int x,				/* left edge */
    int y,				/* right edge */
    int width,				/* width of entry */
    int height)				/* height of entry */
{
    int baseline;
    int indicatorSpace =  mePtr->indicatorSpace;
    int activeBorderWidth;
    int leftEdge;
    int imageHeight, imageWidth;

    Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
	    menuPtr->activeBorderWidthPtr, &activeBorderWidth);
    leftEdge = x + indicatorSpace + activeBorderWidth;

    /*
     * Draw label or bitmap or image for entry.
     */

    baseline = y + (height + fmPtr->ascent - fmPtr->descent) / 2;
    if (mePtr->image != NULL) {
    	Tk_SizeOfImage(mePtr->image, &imageWidth, &imageHeight);
    	if ((mePtr->selectImage != NULL)
	    	&& (mePtr->entryFlags & ENTRY_SELECTED)) {
	    Tk_RedrawImage(mePtr->selectImage, 0, 0,
		    imageWidth, imageHeight, d, leftEdge,
	            (int) (y + (mePtr->height - imageHeight)/2));
    	} else {
	    Tk_RedrawImage(mePtr->image, 0, 0, imageWidth,
		    imageHeight, d, leftEdge,
		    (int) (y + (mePtr->height - imageHeight)/2));
    	}
    } else if (mePtr->bitmapPtr != NULL) {
    	int width, height;
	Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
        Tk_SizeOfBitmap(menuPtr->display, bitmap, &width, &height);

    	XCopyPlane(menuPtr->display, bitmap, d,	gc, 0, 0, (unsigned) width, 

		(unsigned) height, leftEdge,
		(int) (y + (mePtr->height - height)/2), 1);
    } else {
    	if (mePtr->labelLength > 0) {
	    char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
	    Tk_DrawChars(menuPtr->display, d, gc, tkfont, label, 

		    mePtr->labelLength, leftEdge, baseline);
	    DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y,
		    width, height);
    	}
    }

    if (mePtr->state == ENTRY_DISABLED) {
	if (menuPtr->disabledFgPtr == NULL) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
		    (unsigned) width, (unsigned) height);
	} else if ((mePtr->image != NULL) 
		&& (menuPtr->disabledImageGC != None)) {
	    XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
		    leftEdge,
		    (int) (y + (mePtr->height - imageHeight)/2),
1929
1930
1931
1932
1933
1934
1935

1936
1937
1938
1939
1940
1941
1942
1943
1944
1945

1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
    int x;
    int y;
    int width;
    int height;
{
    XPoint points[2];
    int segmentWidth, maxX;


    if (menuPtr->menuType != MASTER_MENU) {
	return;
    }
    
    points[0].x = x;
    points[0].y = y + height/2;
    points[1].y = points[0].y;
    segmentWidth = 6;
    maxX  = width - 1;


    while (points[0].x < maxX) {
	points[1].x = points[0].x + segmentWidth;
	if (points[1].x > maxX) {
	    points[1].x = maxX;
	}
	Tk_Draw3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 2, 1,
		TK_RELIEF_RAISED);
	points[0].x += 2*segmentWidth;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkpConfigureMenuEntry --
 *
 *	Processes configurations for menu entries.
 *
 * Results:
 *	Returns standard TCL result. If TCL_ERROR is returned, then
 *	interp->result contains an error message.
 *
 * Side effects:
 *	Configuration information get set for mePtr; old resources
 *	get freed, if any need it.
 *
 *----------------------------------------------------------------------
 */







>










>






|














|







2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
    int x;
    int y;
    int width;
    int height;
{
    XPoint points[2];
    int segmentWidth, maxX;
    Tk_3DBorder border;

    if (menuPtr->menuType != MASTER_MENU) {
	return;
    }
    
    points[0].x = x;
    points[0].y = y + height/2;
    points[1].y = points[0].y;
    segmentWidth = 6;
    maxX  = width - 1;
    border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);

    while (points[0].x < maxX) {
	points[1].x = points[0].x + segmentWidth;
	if (points[1].x > maxX) {
	    points[1].x = maxX;
	}
	Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
		TK_RELIEF_RAISED);
	points[0].x += 2*segmentWidth;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkpConfigureMenuEntry --
 *
 *	Processes configurations for menu entries.
 *
 * Results:
 *	Returns standard TCL result. If TCL_ERROR is returned, then
 *	the interp's result contains an error message.
 *
 * Side effects:
 *	Configuration information get set for mePtr; old resources
 *	get freed, if any need it.
 *
 *----------------------------------------------------------------------
 */
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046

2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
    int adjustedY = y + padY;
    int adjustedHeight = height - 2 * padY;

    /*
     * Choose the gc for drawing the foreground part of the entry.
     */

    if ((mePtr->state == tkActiveUid)
	    && !strictMotif) {
	gc = mePtr->activeGC;
	if (gc == NULL) {
	    gc = menuPtr->activeGC;
	}
    } else {
    	TkMenuEntry *cascadeEntryPtr;
    	int parentDisabled = 0;

    	
    	for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
    		cascadeEntryPtr != NULL;
    		cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
    	    if (strcmp(cascadeEntryPtr->name, 
    	    	    Tk_PathName(menuPtr->tkwin)) == 0) {
    	    	if (cascadeEntryPtr->state == tkDisabledUid) {
    	    	    parentDisabled = 1;
    	    	}
    	    	break;
    	    }
    	}

	if (((parentDisabled || (mePtr->state == tkDisabledUid)))
		&& (menuPtr->disabledFg != NULL)) {
	    gc = mePtr->disabledGC;
	    if (gc == NULL) {
		gc = menuPtr->disabledGC;
	    }
	} else {
	    gc = mePtr->textGC;
	    if (gc == NULL) {
		gc = menuPtr->textGC;
	    }
	}
    }
    indicatorGC = mePtr->indicatorGC;
    if (indicatorGC == NULL) {
	indicatorGC = menuPtr->indicatorGC;
    }
	    
    bgBorder = mePtr->border;
    if (bgBorder == NULL) {
	bgBorder = menuPtr->border;
    }
    if (strictMotif) {
	activeBorder = bgBorder;
    } else {
	activeBorder = mePtr->activeBorder;
	if (activeBorder == NULL) {
	    activeBorder = menuPtr->activeBorder;
	}
    }

    if (mePtr->tkfont == NULL) {
	fmPtr = menuMetricsPtr;
    } else {
	tkfont = mePtr->tkfont;
	Tk_GetFontMetrics(tkfont, &entryMetrics);
	fmPtr = &entryMetrics;
    }

    /*
     * Need to draw the entire background, including padding. On Unix,
     * for menubars, we have to draw the rest of the entry taking







|
<







>




|
|
|






|
|















|
|
|
|
<



|
|
|
|
|
<
|


|







2142
2143
2144
2145
2146
2147
2148
2149

2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191

2192
2193
2194
2195
2196
2197
2198
2199

2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
    int adjustedY = y + padY;
    int adjustedHeight = height - 2 * padY;

    /*
     * Choose the gc for drawing the foreground part of the entry.
     */

    if ((mePtr->state == ENTRY_ACTIVE) && !strictMotif) {

	gc = mePtr->activeGC;
	if (gc == NULL) {
	    gc = menuPtr->activeGC;
	}
    } else {
    	TkMenuEntry *cascadeEntryPtr;
    	int parentDisabled = 0;
	char *name;
    	
    	for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
    		cascadeEntryPtr != NULL;
    		cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
	    name = Tcl_GetStringFromObj(cascadeEntryPtr->namePtr, NULL);
    	    if (strcmp(name, Tk_PathName(menuPtr->tkwin)) == 0) {
    	    	if (mePtr->state == ENTRY_DISABLED) {
    	    	    parentDisabled = 1;
    	    	}
    	    	break;
    	    }
    	}

	if (((parentDisabled || (mePtr->state == ENTRY_DISABLED)))
		&& (menuPtr->disabledFgPtr != NULL)) {
	    gc = mePtr->disabledGC;
	    if (gc == NULL) {
		gc = menuPtr->disabledGC;
	    }
	} else {
	    gc = mePtr->textGC;
	    if (gc == NULL) {
		gc = menuPtr->textGC;
	    }
	}
    }
    indicatorGC = mePtr->indicatorGC;
    if (indicatorGC == NULL) {
	indicatorGC = menuPtr->indicatorGC;
    }

    bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
	    (mePtr->borderPtr == NULL) ? menuPtr->borderPtr
	    : mePtr->borderPtr);

    if (strictMotif) {
	activeBorder = bgBorder;
    } else {
	activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
	    (mePtr->activeBorderPtr == NULL) ? menuPtr->activeBorderPtr
	    : mePtr->activeBorderPtr);
    }


    if (mePtr->fontPtr == NULL) {
	fmPtr = menuMetricsPtr;
    } else {
	tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
	Tk_GetFontMetrics(tkfont, &entryMetrics);
	fmPtr = &entryMetrics;
    }

    /*
     * Need to draw the entire background, including padding. On Unix,
     * for menubars, we have to draw the rest of the entry taking
2150
2151
2152
2153
2154
2155
2156
2157

2158
2159
2160
2161
2162


2163
2164
2165
2166
2167
2168
2169
2170
    int *heightPtr;			/* The resulting height of the label
					 * portion */
{
    TkMenu *menuPtr = mePtr->menuPtr;
 
    if (mePtr->image != NULL) {
    	Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr);
    } else if (mePtr->bitmap != (Pixmap) NULL) {

    	Tk_SizeOfBitmap(menuPtr->display, mePtr->bitmap, widthPtr, heightPtr);
    } else {
    	*heightPtr = fmPtr->linespace;
    	
    	if (mePtr->label != NULL) {


    	    *widthPtr = Tk_TextWidth(tkfont, mePtr->label, mePtr->labelLength);
    	} else {
    	    *widthPtr = 0;
    	}
    }
    *heightPtr += 1;
}








|
>
|



|
>
>
|







2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
    int *heightPtr;			/* The resulting height of the label
					 * portion */
{
    TkMenu *menuPtr = mePtr->menuPtr;
 
    if (mePtr->image != NULL) {
    	Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr);
    } else if (mePtr->bitmapPtr != NULL) {
	Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
    	Tk_SizeOfBitmap(menuPtr->display, bitmap, widthPtr, heightPtr);
    } else {
    	*heightPtr = fmPtr->linespace;
    	
    	if (mePtr->labelPtr != NULL) {
	    char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);

    	    *widthPtr = Tk_TextWidth(tkfont, label, mePtr->labelLength);
    	} else {
    	    *widthPtr = 0;
    	}
    }
    *heightPtr += 1;
}

2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
    Tk_3DBorder activeBorder,		/* Border for active items */
    Tk_3DBorder bgBorder,		/* Border for the background */
    int x,				/* left edge */
    int y,				/* top edge */
    int width,				/* width of rectangle to draw */
    int height)				/* height of rectangle to draw */
{
    if (mePtr->state == tkActiveUid) {
	bgBorder = activeBorder;
    }
    Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder,
    	    x, y, width, height, 0, TK_RELIEF_FLAT);
}

/*







|







2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
    Tk_3DBorder activeBorder,		/* Border for active items */
    Tk_3DBorder bgBorder,		/* Border for the background */
    int x,				/* left edge */
    int y,				/* top edge */
    int width,				/* width of rectangle to draw */
    int height)				/* height of rectangle to draw */
{
    if (mePtr->state == ENTRY_ACTIVE) {
	bgBorder = activeBorder;
    }
    Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder,
    	    x, y, width, height, 0, TK_RELIEF_FLAT);
}

/*
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234

2235
2236
2237
2238
2239

2240

2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254

2255
2256


2257
2258
2259
2260
2261
2262
2263


2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
 *--------------------------------------------------------------
 */

void
TkpComputeStandardMenuGeometry(
    TkMenu *menuPtr)		/* Structure describing menu. */
{
    Tk_Font tkfont;
    Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
    int x, y, height, width, indicatorSpace, labelWidth, accelWidth;
    int windowWidth, windowHeight, accelSpace;
    int i, j, lastColumnBreak = 0;

    
    if (menuPtr->tkwin == NULL) {
	return;
    }


    x = y = menuPtr->borderWidth;

    indicatorSpace = labelWidth = accelWidth = 0;
    windowHeight = 0;

    /*
     * On the Mac especially, getting font metrics can be quite slow,
     * so we want to do it intelligently. We are going to precalculate
     * them and pass them down to all of the measuring and drawing
     * routines. We will measure the font metrics of the menu once.
     * If an entry does not have its own font set, then we give
     * the geometry/drawing routines the menu's font and metrics.
     * If an entry has its own font, we will measure that font and
     * give all of the geometry/drawing the entry's font and metrics.
     */


    Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics);
    accelSpace = Tk_TextWidth(menuPtr->tkfont, "M", 1);



    for (i = 0; i < menuPtr->numEntries; i++) {
    	tkfont = menuPtr->entries[i]->tkfont;
    	if (tkfont == NULL) {
    	    tkfont = menuPtr->tkfont;
    	    fmPtr = &menuMetrics;
    	} else {


    	    Tk_GetFontMetrics(tkfont, &entryMetrics);
    	    fmPtr = &entryMetrics;
    	}
    	
	if ((i > 0) && menuPtr->entries[i]->columnBreak) {
	    if (accelWidth != 0) {
		labelWidth += accelSpace;
	    }
	    for (j = lastColumnBreak; j < i; j++) {
		menuPtr->entries[j]->indicatorSpace = indicatorSpace;
		menuPtr->entries[j]->labelWidth = labelWidth;
		menuPtr->entries[j]->width = indicatorSpace + labelWidth
			+ accelWidth + 2 * menuPtr->activeBorderWidth;
		menuPtr->entries[j]->x = x;
		menuPtr->entries[j]->entryFlags &= ~ENTRY_LAST_COLUMN;
	    }
	    x += indicatorSpace + labelWidth + accelWidth
		    + 2 * menuPtr->borderWidth;
	    indicatorSpace = labelWidth = accelWidth = 0;
	    lastColumnBreak = i;
	    y = menuPtr->borderWidth;
	}

	if (menuPtr->entries[i]->type == SEPARATOR_ENTRY) {
	    GetMenuSeparatorGeometry(menuPtr, menuPtr->entries[i], tkfont,
	    	    fmPtr, &width, &height);
	    menuPtr->entries[i]->height = height;
	} else if (menuPtr->entries[i]->type == TEAROFF_ENTRY) {







|




>





>
|
>














>
|
|
>
>


|
<
|
|
|
>
>



<








|




|


|







2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377

2378
2379
2380
2381
2382
2383
2384
2385

2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
 *--------------------------------------------------------------
 */

void
TkpComputeStandardMenuGeometry(
    TkMenu *menuPtr)		/* Structure describing menu. */
{
    Tk_Font menuFont, tkfont;
    Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
    int x, y, height, width, indicatorSpace, labelWidth, accelWidth;
    int windowWidth, windowHeight, accelSpace;
    int i, j, lastColumnBreak = 0;
    int activeBorderWidth, borderWidth;
    
    if (menuPtr->tkwin == NULL) {
	return;
    }

    Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin, 
	    menuPtr->borderWidthPtr, &borderWidth);
    x = y = borderWidth;
    indicatorSpace = labelWidth = accelWidth = 0;
    windowHeight = 0;

    /*
     * On the Mac especially, getting font metrics can be quite slow,
     * so we want to do it intelligently. We are going to precalculate
     * them and pass them down to all of the measuring and drawing
     * routines. We will measure the font metrics of the menu once.
     * If an entry does not have its own font set, then we give
     * the geometry/drawing routines the menu's font and metrics.
     * If an entry has its own font, we will measure that font and
     * give all of the geometry/drawing the entry's font and metrics.
     */

    menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
    Tk_GetFontMetrics(menuFont, &menuMetrics);
    accelSpace = Tk_TextWidth(menuFont, "M", 1);
    Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
	    menuPtr->activeBorderWidthPtr, &activeBorderWidth);

    for (i = 0; i < menuPtr->numEntries; i++) {
	if (menuPtr->entries[i]->fontPtr == NULL) {

	    tkfont = menuFont;
	    fmPtr = &menuMetrics;
	} else {
	    tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
		    menuPtr->entries[i]->fontPtr);
    	    Tk_GetFontMetrics(tkfont, &entryMetrics);
    	    fmPtr = &entryMetrics;
    	}

	if ((i > 0) && menuPtr->entries[i]->columnBreak) {
	    if (accelWidth != 0) {
		labelWidth += accelSpace;
	    }
	    for (j = lastColumnBreak; j < i; j++) {
		menuPtr->entries[j]->indicatorSpace = indicatorSpace;
		menuPtr->entries[j]->labelWidth = labelWidth;
		menuPtr->entries[j]->width = indicatorSpace + labelWidth
			+ accelWidth + 2 * activeBorderWidth;
		menuPtr->entries[j]->x = x;
		menuPtr->entries[j]->entryFlags &= ~ENTRY_LAST_COLUMN;
	    }
	    x += indicatorSpace + labelWidth + accelWidth
		    + 2 * borderWidth;
	    indicatorSpace = labelWidth = accelWidth = 0;
	    lastColumnBreak = i;
	    y = borderWidth;
	}

	if (menuPtr->entries[i]->type == SEPARATOR_ENTRY) {
	    GetMenuSeparatorGeometry(menuPtr, menuPtr->entries[i], tkfont,
	    	    fmPtr, &width, &height);
	    menuPtr->entries[i]->height = height;
	} else if (menuPtr->entries[i]->type == TEAROFF_ENTRY) {
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
	    if (height > menuPtr->entries[i]->height) {
	    	menuPtr->entries[i]->height = height;
	    }
	    if (width > indicatorSpace) {
	    	indicatorSpace = width;
	    }

	    menuPtr->entries[i]->height += 2 * menuPtr->activeBorderWidth + 1;
    	}
        menuPtr->entries[i]->y = y;
	y += menuPtr->entries[i]->height;
	if (y > windowHeight) {
	    windowHeight = y;
	}
    }

    if (accelWidth != 0) {
	labelWidth += accelSpace;
    }
    for (j = lastColumnBreak; j < menuPtr->numEntries; j++) {
	menuPtr->entries[j]->indicatorSpace = indicatorSpace;
	menuPtr->entries[j]->labelWidth = labelWidth;
	menuPtr->entries[j]->width = indicatorSpace + labelWidth
		+ accelWidth + 2 * menuPtr->activeBorderWidth;
	menuPtr->entries[j]->x = x;
	menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN;
    }
    windowWidth = x + indicatorSpace + labelWidth + accelWidth + accelSpace
	    + 2 * menuPtr->activeBorderWidth
	    + 2 * menuPtr->borderWidth;


    windowHeight += menuPtr->borderWidth;
    
    /*
     * The X server doesn't like zero dimensions, so round up to at least
     * 1 (a zero-sized menu should never really occur, anyway).
     */

    if (windowWidth <= 0) {







|















|




|
<


|







2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471

2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
	    if (height > menuPtr->entries[i]->height) {
	    	menuPtr->entries[i]->height = height;
	    }
	    if (width > indicatorSpace) {
	    	indicatorSpace = width;
	    }

	    menuPtr->entries[i]->height += 2 * activeBorderWidth + 1;
    	}
        menuPtr->entries[i]->y = y;
	y += menuPtr->entries[i]->height;
	if (y > windowHeight) {
	    windowHeight = y;
	}
    }

    if (accelWidth != 0) {
	labelWidth += accelSpace;
    }
    for (j = lastColumnBreak; j < menuPtr->numEntries; j++) {
	menuPtr->entries[j]->indicatorSpace = indicatorSpace;
	menuPtr->entries[j]->labelWidth = labelWidth;
	menuPtr->entries[j]->width = indicatorSpace + labelWidth
		+ accelWidth + 2 * activeBorderWidth;
	menuPtr->entries[j]->x = x;
	menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN;
    }
    windowWidth = x + indicatorSpace + labelWidth + accelWidth + accelSpace
	    + 2 * activeBorderWidth + 2 * borderWidth;



    windowHeight += borderWidth;
    
    /*
     * The X server doesn't like zero dimensions, so round up to at least
     * 1 (a zero-sized menu should never really occur, anyway).
     */

    if (windowWidth <= 0) {
2476
2477
2478
2479
2480
2481
2482



2483
2484
2485
2486
2487
2488
2489















2490























2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504


2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574



2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
 *----------------------------------------------------------------------
 */

static void
MenuExitHandler(
    ClientData clientData)	    /* Not used */
{



    DestroyWindow(menuHWND);
    UnregisterClass(MENU_CLASS_NAME, Tk_GetHINSTANCE());
}

/*
 *----------------------------------------------------------------------
 *















 * TkpMenuInit --























 *
 *	Sets up the hash tables and the variables used by the menu package.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	lastMenuID gets initialized, and the parent hash and the command hash
 *	are allocated.
 *
 *----------------------------------------------------------------------
 */

void


TkpMenuInit()
{
    WNDCLASS wndClass;
    char sizeString[4];
    char faceName[LF_FACESIZE];
    HDC scratchDC;
    Tcl_DString boldItalicDString;
    int bold = 0; 
    int italic = 0;
    int i;
    TEXTMETRIC tm;

    Tcl_InitHashTable(&winMenuTable, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&commandTable, TCL_ONE_WORD_KEYS);
 
    wndClass.style = CS_OWNDC;
    wndClass.lpfnWndProc = TkWinMenuProc;
    wndClass.cbClsExtra = 0;
    wndClass.cbWndExtra = 0;
    wndClass.hInstance = Tk_GetHINSTANCE();
    wndClass.hIcon = NULL;
    wndClass.hCursor = NULL;
    wndClass.hbrBackground = (HBRUSH)(COLOR_WINDOW + 1);
    wndClass.lpszMenuName = NULL;
    wndClass.lpszClassName = MENU_CLASS_NAME;
    RegisterClass(&wndClass);

    menuHWND = CreateWindow(MENU_CLASS_NAME, "MenuWindow", WS_POPUP,
	0, 0, 10, 10, NULL, NULL, Tk_GetHINSTANCE(), NULL);

    Tcl_CreateExitHandler(MenuExitHandler, (ClientData) NULL);

    versionInfo.dwOSVersionInfoSize = sizeof(versionInfo);

    /*
     * If GetVersionEx fails, it means that the version info record
     * is too big for what is compiled. Should never happen, but if
     * it does, we are later than Windows 95 or NT 4.0.
     */

    if (!GetVersionEx(&versionInfo)) {
	versionInfo.dwMajorVersion = 4;
    }

    /*
     * Set all of the default options. The loop will terminate when we run 
     * out of options via a break statement.
     */

    for (i = 0; ; i++) {
	if (tkMenuConfigSpecs[i].type == TK_CONFIG_END) {
	    break;
	}

	if ((strcmp(tkMenuConfigSpecs[i].dbName,
		"activeBorderWidth") == 0) ||
		(strcmp(tkMenuConfigSpecs[i].dbName, "borderWidth") == 0)) {
	    int borderWidth;

	    borderWidth = GetSystemMetrics(SM_CXBORDER);
	    if (GetSystemMetrics(SM_CYBORDER) > borderWidth) {
		borderWidth = GetSystemMetrics(SM_CYBORDER);
	    }
	    sprintf(borderString, "%d", borderWidth);
	    tkMenuConfigSpecs[i].defValue = borderString;
	} else if ((strcmp(tkMenuConfigSpecs[i].dbName, "font") == 0)) {
	    int pointSize;
	    HFONT menuFont;

	    scratchDC = CreateDC("DISPLAY", NULL, NULL, NULL);



	    Tcl_DStringInit(&menuFontDString);

	    if (versionInfo.dwMajorVersion >= 4) {
		NONCLIENTMETRICS ncMetrics;

		ncMetrics.cbSize = sizeof(ncMetrics);
		SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(ncMetrics),
			&ncMetrics, 0);
		menuFont = CreateFontIndirect(&ncMetrics.lfMenuFont);
	    } else {
		menuFont = GetStockObject(SYSTEM_FONT);
	    }
	    SelectObject(scratchDC, menuFont);
	    GetTextMetrics(scratchDC, &tm);
	    GetTextFace(scratchDC, sizeof(menuFontDString), faceName);
	    pointSize = MulDiv(tm.tmHeight - tm.tmInternalLeading,
		    72, GetDeviceCaps(scratchDC, LOGPIXELSY));
	    if (tm.tmWeight >= 700) {
		bold = 1;
	    }
	    if (tm.tmItalic) {
		italic = 1;
	    }

	    SelectObject(scratchDC, GetStockObject(SYSTEM_FONT));
	    DeleteDC(scratchDC);

	    DeleteObject(menuFont);
	    
	    Tcl_DStringAppendElement(&menuFontDString, faceName);
	    sprintf(sizeString, "%d", pointSize);
	    Tcl_DStringAppendElement(&menuFontDString, sizeString);

	    if (bold == 1 || italic == 1) {
		Tcl_DStringInit(&boldItalicDString);
		if (bold == 1) {
		    Tcl_DStringAppendElement(&boldItalicDString, "bold");
		}
		if (italic == 1) {
		    Tcl_DStringAppendElement(&boldItalicDString, "italic");
		}
		Tcl_DStringAppendElement(&menuFontDString, 
			Tcl_DStringValue(&boldItalicDString));
	    }

	    tkMenuConfigSpecs[i].defValue = Tcl_DStringValue(&menuFontDString);
	}
    }

    /*
     * Now we go ahead and get the dimensions of the check mark and the
     * appropriate margins. Since this is fairly hairy, we do it here
     * to save time when traversing large sets of menu items.
     *







>
>
>
|






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














>
>
|

<
|





<

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

<
<
<
<


















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

|
>
>
>
|

|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|

|
|
|
|
|

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







2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666

2667
2668
2669
2670
2671
2672

2673
2674


2675











2676




2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694










2695
2696
2697
2698
2699




2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747




2748
2749
2750
2751
2752
2753
2754
 *----------------------------------------------------------------------
 */

static void
MenuExitHandler(
    ClientData clientData)	    /* Not used */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    DestroyWindow(tsdPtr->menuHWND);
    UnregisterClass(MENU_CLASS_NAME, Tk_GetHINSTANCE());
}

/*
 *----------------------------------------------------------------------
 *
 * TkWinGetMenuSystemDefault --
 *
 *	Gets the Windows specific default value for a given X resource
 *	database name.
 *
 * Results:
 *	Returns a Tcl_Obj * with the default value. If there is no
 *	Windows-specific default for this attribute, returns NULL.
 *	This object has a ref count of 0.
 *
 * Side effects:
 *	Storage is allocated.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TkWinGetMenuSystemDefault(
    Tk_Window tkwin,		/* A window to use. */
    char *dbName,		/* The option database name. */
    char *className)		/* The name of the option class. */
{
    Tcl_Obj *valuePtr = NULL;

    if ((strcmp(dbName, "activeBorderWidth") == 0) ||
	    (strcmp(dbName, "borderWidth") == 0)) {
	valuePtr = Tcl_NewIntObj(defaultBorderWidth);
    } else if (strcmp(dbName, "font") == 0) {
	valuePtr = Tcl_NewStringObj(Tcl_DStringValue(&menuFontDString),
		-1);
    }

    return valuePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TkWinMenuSetDefaults --
 *
 *	Sets up the hash tables and the variables used by the menu package.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	lastMenuID gets initialized, and the parent hash and the command hash
 *	are allocated.
 *
 *----------------------------------------------------------------------
 */

void
SetDefaults(
    int firstTime)		    /* Is this the first time this
				     * has been called? */
{

    char sizeString[TCL_INTEGER_SPACE];
    char faceName[LF_FACESIZE];
    HDC scratchDC;
    Tcl_DString boldItalicDString;
    int bold = 0; 
    int italic = 0;

    TEXTMETRIC tm;
    int pointSize;


    HFONT menuFont;

















    versionInfo.dwOSVersionInfoSize = sizeof(versionInfo);

    /*
     * If GetVersionEx fails, it means that the version info record
     * is too big for what is compiled. Should never happen, but if
     * it does, we are later than Windows 95 or NT 4.0.
     */

    if (!GetVersionEx(&versionInfo)) {
	versionInfo.dwMajorVersion = 4;
    }

    /*
     * Set all of the default options. The loop will terminate when we run 
     * out of options via a break statement.
     */











    defaultBorderWidth = GetSystemMetrics(SM_CXBORDER);
    if (GetSystemMetrics(SM_CYBORDER) > defaultBorderWidth) {
	defaultBorderWidth = GetSystemMetrics(SM_CYBORDER);
    }






    scratchDC = CreateDC("DISPLAY", NULL, NULL, NULL);
    if (!firstTime) {
	Tcl_DStringFree(&menuFontDString);
    }
    Tcl_DStringInit(&menuFontDString);

    if (versionInfo.dwMajorVersion >= 4) {
	NONCLIENTMETRICS ncMetrics;

	ncMetrics.cbSize = sizeof(ncMetrics);
	SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(ncMetrics),
		&ncMetrics, 0);
	menuFont = CreateFontIndirect(&ncMetrics.lfMenuFont);
    } else {
	menuFont = GetStockObject(SYSTEM_FONT);
    }
    SelectObject(scratchDC, menuFont);
    GetTextMetrics(scratchDC, &tm);
    GetTextFace(scratchDC, sizeof(menuFontDString), faceName);
    pointSize = MulDiv(tm.tmHeight - tm.tmInternalLeading,
	    72, GetDeviceCaps(scratchDC, LOGPIXELSY));
    if (tm.tmWeight >= 700) {
	bold = 1;
    }
    if (tm.tmItalic) {
	italic = 1;
    }

    SelectObject(scratchDC, GetStockObject(SYSTEM_FONT));
    DeleteDC(scratchDC);

    DeleteObject(menuFont);
    
    Tcl_DStringAppendElement(&menuFontDString, faceName);
    sprintf(sizeString, "%d", pointSize);
    Tcl_DStringAppendElement(&menuFontDString, sizeString);

    if (bold == 1 || italic == 1) {
	Tcl_DStringInit(&boldItalicDString);
	if (bold == 1) {
	    Tcl_DStringAppendElement(&boldItalicDString, "bold");
	}
	if (italic == 1) {
	    Tcl_DStringAppendElement(&boldItalicDString, "italic");
	}
	Tcl_DStringAppendElement(&menuFontDString, 
		Tcl_DStringValue(&boldItalicDString));




    }

    /*
     * Now we go ahead and get the dimensions of the check mark and the
     * appropriate margins. Since this is fairly hairy, we do it here
     * to save time when traversing large sets of menu items.
     *
2638
2639
2640
2641
2642
2643
2644
2645
2646



































































		+ GetSystemMetrics(SM_CXMENUCHECK) + 7) & 0xFFF8)
		- GetSystemMetrics(SM_CXFIXEDFRAME);
    } else {
	DWORD dimensions = GetMenuCheckMarkDimensions();
	indicatorDimensions[0] = HIWORD(dimensions);
	indicatorDimensions[1] = LOWORD(dimensions);
   }

}










































































|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
		+ GetSystemMetrics(SM_CXMENUCHECK) + 7) & 0xFFF8)
		- GetSystemMetrics(SM_CXFIXEDFRAME);
    } else {
	DWORD dimensions = GetMenuCheckMarkDimensions();
	indicatorDimensions[0] = HIWORD(dimensions);
	indicatorDimensions[1] = LOWORD(dimensions);
   }
}

/*
 *----------------------------------------------------------------------
 *
 * TkpMenuInit --
 *
 *	Sets up the process-wide variables used by the menu package.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	lastMenuID gets initialized.
 *
 *----------------------------------------------------------------------
 */

void
TkpMenuInit()
{
    WNDCLASS wndClass;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    wndClass.style = CS_OWNDC;
    wndClass.lpfnWndProc = TkWinMenuProc;
    wndClass.cbClsExtra = 0;
    wndClass.cbWndExtra = 0;
    wndClass.hInstance = Tk_GetHINSTANCE();
    wndClass.hIcon = NULL;
    wndClass.hCursor = NULL;
    wndClass.hbrBackground = (HBRUSH)(COLOR_WINDOW + 1);
    wndClass.lpszMenuName = NULL;
    wndClass.lpszClassName = MENU_CLASS_NAME;
    RegisterClass(&wndClass);

    tsdPtr->menuHWND = CreateWindow(MENU_CLASS_NAME, "MenuWindow", WS_POPUP,
	0, 0, 10, 10, NULL, NULL, Tk_GetHINSTANCE(), NULL);

    Tcl_CreateExitHandler(MenuExitHandler, (ClientData) NULL);
    SetDefaults(1);
}

/*
 *----------------------------------------------------------------------
 *
 * TkpMenuThreadInit --
 *
 *	Sets up the thread-local hash tables used by the menu module.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Hash tables winMenuTable and commandTable are initialized.
 *
 *----------------------------------------------------------------------
 */

void
TkpMenuThreadInit()
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    Tcl_InitHashTable(&tsdPtr->winMenuTable, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&tsdPtr->commandTable, TCL_ONE_WORD_KEYS);
}

Changes to win/tkWinPixmap.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkWinPixmap.c --
 *
 *	This file contains the Xlib emulation functions pertaining to
 *	creating and destroying pixmaps.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinPixmap.c 1.18 97/08/06 15:36:23
 */

#include "tkWinInt.h"


/*
 *----------------------------------------------------------------------











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkWinPixmap.c --
 *
 *	This file contains the Xlib emulation functions pertaining to
 *	creating and destroying pixmaps.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinPixmap.c,v 1.1.4.1 1998/09/30 02:19:36 stanton Exp $
 */

#include "tkWinInt.h"


/*
 *----------------------------------------------------------------------

Changes to win/tkWinPointer.c.

1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkWinPointer.c --
 *
 *	Windows specific mouse tracking code.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinPointer.c 1.28 97/10/31 08:40:07
 */

#include "tkWinInt.h"

/*
 * Check for enter/leave events every MOUSE_TIMER_INTERVAL milliseconds.
 */






>




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkWinPointer.c --
 *
 *	Windows specific mouse tracking code.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinPointer.c,v 1.1.4.3 1999/03/01 19:35:28 redman Exp $
 */

#include "tkWinInt.h"

/*
 * Check for enter/leave events every MOUSE_TIMER_INTERVAL milliseconds.
 */
237
238
239
240
241
242
243

























244
245
246
247
248
249
250
    GetCursorPos(&pos);
    Tk_PointerEvent(NULL, pos.x, pos.y);
}

/*
 *----------------------------------------------------------------------
 *

























 * TkGetPointerCoords --
 *
 *	Fetch the position of the mouse pointer.
 *
 * Results:
 *	*xPtr and *yPtr are filled in with the root coordinates
 *	of the mouse pointer for the display.







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







238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
    GetCursorPos(&pos);
    Tk_PointerEvent(NULL, pos.x, pos.y);
}

/*
 *----------------------------------------------------------------------
 *
 * TkWinCancelMouseTimer --
 *
 *    If the mouse timer is set, cancel it.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    May cancel the mouse timer.
 *
 *----------------------------------------------------------------------
 */

void
TkWinCancelMouseTimer()
{
    if (mouseTimerSet) {
	Tcl_DeleteTimerHandler(mouseTimer);
	mouseTimerSet = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkGetPointerCoords --
 *
 *	Fetch the position of the mouse pointer.
 *
 * Results:
 *	*xPtr and *yPtr are filled in with the root coordinates
 *	of the mouse pointer for the display.
405
406
407
408
409
410
411









412
413
414
415
416
417
418
	    return 0;
	}
    }

    if (winPtr->window == None) {
	panic("ChangeXFocus got null X window");
    }









    XSetInputFocus(dispPtr->display, winPtr->window, RevertToParent,
	    CurrentTime);

    /*
     * Remember the current serial number for the X server and issue
     * a dummy server request.  This marks the position at which we
     * changed the focus, so we can distinguish FocusIn and FocusOut







>
>
>
>
>
>
>
>
>







431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
	    return 0;
	}
    }

    if (winPtr->window == None) {
	panic("ChangeXFocus got null X window");
    }
 
    /*
     * Change the foreground window so the focus window is raised to the top of
     * the system stacking order and gets the keyboard focus.
     */

    if (force) {
	TkWinSetForegroundWindow(winPtr);
    }
    XSetInputFocus(dispPtr->display, winPtr->window, RevertToParent,
	    CurrentTime);

    /*
     * Remember the current serial number for the X server and issue
     * a dummy server request.  This marks the position at which we
     * changed the focus, so we can distinguish FocusIn and FocusOut

Changes to win/tkWinPort.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkWinPort.h --
 *
 *	This header file handles porting issues that occur because of
 *	differences between Windows and Unix. It should be the only
 *	file that contains #ifdefs to handle different flavors of OS.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinPort.h 1.25 97/04/21 17:08:42
 */

#ifndef _WINPORT
#define _WINPORT

#include <X11/Xlib.h>
#include <X11/cursorfont.h>












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tkWinPort.h --
 *
 *	This header file handles porting issues that occur because of
 *	differences between Windows and Unix. It should be the only
 *	file that contains #ifdefs to handle different flavors of OS.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinPort.h,v 1.1.4.3 1999/03/10 07:13:52 stanton Exp $
 */

#ifndef _WINPORT
#define _WINPORT

#include <X11/Xlib.h>
#include <X11/cursorfont.h>
29
30
31
32
33
34
35

36
37
38
39
40
41
42
#include <stdlib.h>
#include <string.h>
#include <limits.h>
#include <fcntl.h>
#include <io.h>
#include <sys/stat.h>
#include <time.h>


#ifdef _MSC_VER
#    define hypot _hypot
#endif /* _MSC_VER */

#define strncasecmp strnicmp
#define strcasecmp stricmp







>







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#include <stdlib.h>
#include <string.h>
#include <limits.h>
#include <fcntl.h>
#include <io.h>
#include <sys/stat.h>
#include <time.h>
#include <tchar.h>

#ifdef _MSC_VER
#    define hypot _hypot
#endif /* _MSC_VER */

#define strncasecmp strnicmp
#define strcasecmp stricmp
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
#define XSync(display, bool) {display->request++;}
#define XVisualIDFromVisual(visual) (visual->visualid)

/*
 * The following Tk functions are implemented as macros under Windows.
 */

#define TkGetNativeProlog(interp) TkGetProlog(interp)
#define TkpGetPixel(p) (((((p)->red >> 8) & 0xff) \
	| ((p)->green & 0xff00) | (((p)->blue << 8) & 0xff0000)) | 0x20000000)

/*
 * These calls implement native bitmaps which are not currently 
 * supported under Windows.  The macros eliminate the calls.
 */







<







86
87
88
89
90
91
92

93
94
95
96
97
98
99
#define XSync(display, bool) {display->request++;}
#define XVisualIDFromVisual(visual) (visual->visualid)

/*
 * The following Tk functions are implemented as macros under Windows.
 */


#define TkpGetPixel(p) (((((p)->red >> 8) & 0xff) \
	| ((p)->green & 0xff00) | (((p)->blue << 8) & 0xff0000)) | 0x20000000)

/*
 * These calls implement native bitmaps which are not currently 
 * supported under Windows.  The macros eliminate the calls.
 */
107
108
109
110
111
112
113
114
115

116
117
 */

struct timezone {
    int tz_minuteswest;
    int tz_dsttime;
};

extern int gettimeofday(struct timeval *, struct timezone *);
EXTERN void		panic _ANSI_ARGS_(TCL_VARARGS(char *,format));


#endif /* _WINPORT */







|
|
>


107
108
109
110
111
112
113
114
115
116
117
118
 */

struct timezone {
    int tz_minuteswest;
    int tz_dsttime;
};

#ifndef _TCLINT
#include <tclInt.h>
#endif

#endif /* _WINPORT */

Changes to win/tkWinRegion.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkWinRegion.c --
 *
 *	Tk Region emulation code.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinRegion.c 1.7 96/05/03 11:05:54
 */

#include "tkWinInt.h"


/*
 *----------------------------------------------------------------------










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tkWinRegion.c --
 *
 *	Tk Region emulation code.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinRegion.c,v 1.1.4.1 1998/09/30 02:19:37 stanton Exp $
 */

#include "tkWinInt.h"


/*
 *----------------------------------------------------------------------

Changes to win/tkWinScrlbr.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkWinScrollbar.c --
 *
 *	This file implements the Windows specific portion of the scrollbar
 *	widget.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinScrlbr.c 1.19 97/08/13 17:37:49
 */

#include "tkWinInt.h"
#include "tkScrollbar.h"


/*











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * tkWinScrollbar.c --
 *
 *	This file implements the Windows specific portion of the scrollbar
 *	widget.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinScrlbr.c,v 1.1.4.3 1998/12/13 08:16:19 lfb Exp $
 */

#include "tkWinInt.h"
#include "tkScrollbar.h"


/*
53
54
55
56
57
58
59


60
61
62
63
64
65
66
67
68
69
70
71
72
 * Cached system metrics used to determine scrollbar geometry.
 */

static int initialized = 0;
static int hArrowWidth, hThumb; /* Horizontal control metrics. */
static int vArrowWidth, vArrowHeight, vThumb; /* Vertical control metrics. */



/*
 * This variable holds the default width for a scrollbar in string
 * form for use in a Tk_ConfigSpec.
 */

static char defWidth[8];

/*
 * Declarations for functions defined in this file.
 */

static Window		CreateProc _ANSI_ARGS_((Tk_Window tkwin,
			    Window parent, ClientData instanceData));







>
>





|







53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
 * Cached system metrics used to determine scrollbar geometry.
 */

static int initialized = 0;
static int hArrowWidth, hThumb; /* Horizontal control metrics. */
static int vArrowWidth, vArrowHeight, vThumb; /* Vertical control metrics. */

TCL_DECLARE_MUTEX(winScrlbrMutex)

/*
 * This variable holds the default width for a scrollbar in string
 * form for use in a Tk_ConfigSpec.
 */

static char defWidth[TCL_INTEGER_SPACE];

/*
 * Declarations for functions defined in this file.
 */

static Window		CreateProc _ANSI_ARGS_((Tk_Window tkwin,
			    Window parent, ClientData instanceData));
112
113
114
115
116
117
118

119
120

121
122
123
124
125
126
127
TkpCreateScrollbar(tkwin)
    Tk_Window tkwin;
{
    WinScrollbar *scrollPtr;
    TkWindow *winPtr = (TkWindow *)tkwin;
    
    if (!initialized) {

	UpdateScrollbarMetrics();
	initialized = 1;

    }

    scrollPtr = (WinScrollbar *) ckalloc(sizeof(WinScrollbar));
    scrollPtr->winFlags = 0;
    scrollPtr->hwnd = NULL;

    Tk_CreateEventHandler(tkwin,







>


>







114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
TkpCreateScrollbar(tkwin)
    Tk_Window tkwin;
{
    WinScrollbar *scrollPtr;
    TkWindow *winPtr = (TkWindow *)tkwin;
    
    if (!initialized) {
        Tcl_MutexLock(&winScrlbrMutex);
	UpdateScrollbarMetrics();
	initialized = 1;
	Tcl_MutexUnlock(&winScrlbrMutex);
    }

    scrollPtr = (WinScrollbar *) ckalloc(sizeof(WinScrollbar));
    scrollPtr->winFlags = 0;
    scrollPtr->hwnd = NULL;

    Tk_CreateEventHandler(tkwin,

Changes to win/tkWinSend.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkWinSend.c --
 *
 *	This file provides procedures that implement the "send"
 *	command, allowing commands to be passed from interpreter
 *	to interpreter.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinSend.c 1.4 97/06/10 09:39:50
 */

#include "tkPort.h"
#include "tkInt.h"


/*












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/* 
 * tkWinSend.c --
 *
 *	This file provides procedures that implement the "send"
 *	command, allowing commands to be passed from interpreter
 *	to interpreter.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinSend.c,v 1.1.4.7 1999/04/01 21:58:52 redman Exp $
 */

#include "tkPort.h"
#include "tkInt.h"


/*

Added win/tkWinTest.c.













































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
/* 
 * tkWinTest.c --
 *
 *	Contains commands for platform specific tests for
 *	the Windows platform.
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinTest.c,v 1.1.2.2 1998/09/30 02:19:38 stanton Exp $
 */

#include "tkWinInt.h"

HWND tkWinCurrentDialog;
 
/*
 * Forward declarations of procedures defined later in this file:
 */

int			TkplatformtestInit(Tcl_Interp *interp);
static int		TestclipboardCmd(ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv);
static int		TestwineventCmd(ClientData clientData, 
			    Tcl_Interp *interp, int argc, char **argv);


/*
 *----------------------------------------------------------------------
 *
 * TkplatformtestInit --
 *
 *	Defines commands that test platform specific functionality for
 *	Unix platforms.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Defines new commands.
 *
 *----------------------------------------------------------------------
 */

int
TkplatformtestInit(
    Tcl_Interp *interp)		/* Interpreter to add commands to. */
{
    /*
     * Add commands for platform specific tests on MacOS here.
     */
    
    Tcl_CreateCommand(interp, "testclipboard", TestclipboardCmd,
	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "testwinevent", TestwineventCmd,
            (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestclipboardCmd --
 *
 *	This procedure implements the testclipboard command. It provides
 *	a way to determine the actual contents of the Windows clipboard.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestclipboardCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    TkWindow *winPtr = (TkWindow *) clientData;
    HGLOBAL handle;
    char *data;

    if (OpenClipboard(NULL)) {
	handle = GetClipboardData(CF_TEXT);
	if (handle != NULL) {
	    data = GlobalLock(handle);
	    Tcl_AppendResult(interp, data, (char *) NULL);
	    GlobalUnlock(handle);
	}
	CloseClipboard();
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestwineventCmd --
 *
 *	This procedure implements the testwinevent command. It provides
 *	a way to send messages to windows dialogs.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestwineventCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Main window for application. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    HWND hwnd;
    int id;
    char *rest;
    UINT message;
    WPARAM wParam;
    LPARAM lParam;
    static TkStateMap messageMap[] = {
	{WM_LBUTTONDOWN,	"WM_LBUTTONDOWN"},
	{WM_LBUTTONUP,		"WM_LBUTTONUP"},
	{WM_CHAR,		"WM_CHAR"},
	{WM_GETTEXT,		"WM_GETTEXT"},
	{WM_SETTEXT,		"WM_SETTEXT"},
	{-1,			NULL}
    };

    if ((argc == 3) && (strcmp(argv[1], "debug") == 0)) {
	int i;

	if (Tcl_GetBoolean(interp, argv[2], &i) != TCL_OK) {
	    return TCL_ERROR;
	}
	TkWinDialogDebug(i);
	return TCL_OK;
    }

    if (argc < 4) {
	return TCL_ERROR;
    }

    hwnd = (HWND) strtol(argv[1], &rest, 0);
    if (rest == argv[2]) {
	hwnd = FindWindow(NULL, argv[1]);
	if (hwnd == NULL) {
	    Tcl_SetResult(interp, "no such window", TCL_STATIC);
	    return TCL_ERROR;
	}
    } 
    UpdateWindow(hwnd);

    id = strtol(argv[2], &rest, 0);
    if (rest == argv[2]) {
	HWND child;
	char buf[256];

	child = GetWindow(hwnd, GW_CHILD);
	while (child != NULL) {
	    SendMessage(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf);
	    if (strcasecmp(buf, argv[2]) == 0) {
		id = GetDlgCtrlID(child);
		break;
	    }
	    child = GetWindow(child, GW_HWNDNEXT);
	}
	if (child == NULL) {
	    return TCL_ERROR;
	}
    }
    message = TkFindStateNum(NULL, NULL, messageMap, argv[3]);
    if (message < 0) {
	message = strtol(argv[3], NULL, 0);
    }
    wParam = 0;
    lParam = 0;

    if (argc > 4) {
	wParam = strtol(argv[4], NULL, 0);
    }
    if (argc > 5) {
	lParam = strtol(argv[5], NULL, 0);
    }

    switch (message) {
	case WM_GETTEXT: {
	    Tcl_DString ds;
	    char buf[256];

	    GetDlgItemText(hwnd, id, buf, 256);
	    Tcl_ExternalToUtfDString(NULL, buf, -1, &ds);
	    Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
	    Tcl_DStringFree(&ds);
	    break;
	}
	case WM_SETTEXT: {
	    Tcl_DString ds;

	    Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds);
	    SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds));
	    Tcl_DStringFree(&ds);
	    break;
	}
	default: {
	    char buf[TCL_INTEGER_SPACE];
	    
	    sprintf(buf, "%d", 
		    SendDlgItemMessage(hwnd, id, message, wParam, lParam));
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    break;
	}
    }
    return TCL_OK;
}
    


Changes to win/tkWinWindow.c.

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
/* 
 * tkWinWindow.c --
 *
 *	Xlib emulation routines for Windows related to creating,
 *	displaying and destroying windows.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinWindow.c 1.23 97/07/01 18:14:13
 */

#include "tkWinInt.h"

/*
 * The windowTable maps from HWND to Tk_Window handles.
 */


static Tcl_HashTable windowTable;

/*
 * Have statics in this module been initialized?
 */

static int initialized = 0;

/*
 * Forward declarations for procedures defined in this file:
 */

static void		NotifyVisibility _ANSI_ARGS_((XEvent *eventPtr,
			    TkWindow *winPtr));






|




|




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







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
/* 
 * tkWinWindow.c --
 *
 *	Xlib emulation routines for Windows related to creating,
 *	displaying and destroying windows.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinWindow.c,v 1.1.4.3 1998/12/13 08:16:20 lfb Exp $
 */

#include "tkWinInt.h"




typedef struct ThreadSpecificData {
    int initialized;            /* 0 means table below needs initializing. */
    Tcl_HashTable windowTable;  /* The windowTable maps from HWND to 
				 * Tk_Window handles. */



} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations for procedures defined in this file:
 */

static void		NotifyVisibility _ANSI_ARGS_((XEvent *eventPtr,
			    TkWindow *winPtr));
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
Tk_AttachHWND(tkwin, hwnd)
    Tk_Window tkwin;
    HWND hwnd;
{
    int new;
    Tcl_HashEntry *entryPtr;
    TkWinDrawable *twdPtr = (TkWinDrawable *) Tk_WindowId(tkwin);



    if (!initialized) {
	Tcl_InitHashTable(&windowTable, TCL_ONE_WORD_KEYS);
	initialized = 1;
    }

    /*
     * Allocate a new drawable if necessary.  Otherwise, remove the
     * previous HWND from from the window table.
     */

    if (twdPtr == NULL) {
	twdPtr = (TkWinDrawable*) ckalloc(sizeof(TkWinDrawable));
	twdPtr->type = TWD_WINDOW;
	twdPtr->window.winPtr = (TkWindow *) tkwin;
    } else if (twdPtr->window.handle != NULL) {
	entryPtr = Tcl_FindHashEntry(&windowTable,
		(char *)twdPtr->window.handle);
	Tcl_DeleteHashEntry(entryPtr);
    }

    /*
     * Insert the new HWND into the window table.
     */

    twdPtr->window.handle = hwnd;
    entryPtr = Tcl_CreateHashEntry(&windowTable, (char *)hwnd, &new);
    Tcl_SetHashValue(entryPtr, (ClientData)tkwin);

    return (Window)twdPtr;
}

/*
 *----------------------------------------------------------------------







>
>

|
|
|












|









|







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
Tk_AttachHWND(tkwin, hwnd)
    Tk_Window tkwin;
    HWND hwnd;
{
    int new;
    Tcl_HashEntry *entryPtr;
    TkWinDrawable *twdPtr = (TkWinDrawable *) Tk_WindowId(tkwin);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (!tsdPtr->initialized) {
	Tcl_InitHashTable(&tsdPtr->windowTable, TCL_ONE_WORD_KEYS);
	tsdPtr->initialized = 1;
    }

    /*
     * Allocate a new drawable if necessary.  Otherwise, remove the
     * previous HWND from from the window table.
     */

    if (twdPtr == NULL) {
	twdPtr = (TkWinDrawable*) ckalloc(sizeof(TkWinDrawable));
	twdPtr->type = TWD_WINDOW;
	twdPtr->window.winPtr = (TkWindow *) tkwin;
    } else if (twdPtr->window.handle != NULL) {
	entryPtr = Tcl_FindHashEntry(&tsdPtr->windowTable,
		(char *)twdPtr->window.handle);
	Tcl_DeleteHashEntry(entryPtr);
    }

    /*
     * Insert the new HWND into the window table.
     */

    twdPtr->window.handle = hwnd;
    entryPtr = Tcl_CreateHashEntry(&tsdPtr->windowTable, (char *)hwnd, &new);
    Tcl_SetHashValue(entryPtr, (ClientData)tkwin);

    return (Window)twdPtr;
}

/*
 *----------------------------------------------------------------------
110
111
112
113
114
115
116
117








118
119
120
121
122
123
124
 *----------------------------------------------------------------------
 */

Tk_Window
Tk_HWNDToWindow(hwnd)
    HWND hwnd;
{
    Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&windowTable, (char*)hwnd);








    if (entryPtr != NULL) {
	return (Tk_Window) Tcl_GetHashValue(entryPtr);
    }
    return NULL;
}

/*







|
>
>
>
>
>
>
>
>







107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
 *----------------------------------------------------------------------
 */

Tk_Window
Tk_HWNDToWindow(hwnd)
    HWND hwnd;
{
    Tcl_HashEntry *entryPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (!tsdPtr->initialized) {
	Tcl_InitHashTable(&tsdPtr->windowTable, TCL_ONE_WORD_KEYS);
	tsdPtr->initialized = 1;
    }
    entryPtr = Tcl_FindHashEntry(&tsdPtr->windowTable, (char*)hwnd);
    if (entryPtr != NULL) {
	return (Tk_Window) Tcl_GetHashValue(entryPtr);
    }
    return NULL;
}

/*
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
 *	Given a string which represents the platform dependent window
 *	handle, produce the X Window id for the window.
 *
 * Results:
 *	The return value is normally TCL_OK;  in this case *idPtr
 *	will be set to the X Window id equivalent to string.  If
 *	string is improperly formed then TCL_ERROR is returned and
 *	an error message will be left in interp->result.  If the
 *	number does not correspond to a Tk Window, then *idPtr will
 *	be set to None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------







|







186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
 *	Given a string which represents the platform dependent window
 *	handle, produce the X Window id for the window.
 *
 * Results:
 *	The return value is normally TCL_OK;  in this case *idPtr
 *	will be set to the X Window id equivalent to string.  If
 *	string is improperly formed then TCL_ERROR is returned and
 *	an error message will be left in the interp's result.  If the
 *	number does not correspond to a Tk Window, then *idPtr will
 *	be set to None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
    }

    /*
     * Create the window, then ensure that it is at the top of the
     * stacking order.
     */

    hwnd = CreateWindow(TK_WIN_CHILD_CLASS_NAME, NULL, style,
	    Tk_X(winPtr), Tk_Y(winPtr), Tk_Width(winPtr), Tk_Height(winPtr),
	    parentWin, NULL, Tk_GetHINSTANCE(), NULL);
    SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0,
		    SWP_NOACTIVATE | SWP_NOMOVE | SWP_NOSIZE);
    return Tk_AttachHWND((Tk_Window)winPtr, hwnd);
}

/*
 *----------------------------------------------------------------------







|
|
|







257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
    }

    /*
     * Create the window, then ensure that it is at the top of the
     * stacking order.
     */

    hwnd = CreateWindowEx(WS_EX_NOPARENTNOTIFY, TK_WIN_CHILD_CLASS_NAME, NULL,
	    style, Tk_X(winPtr), Tk_Y(winPtr), Tk_Width(winPtr),
	    Tk_Height(winPtr), parentWin, NULL, Tk_GetHINSTANCE(), NULL);
    SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0,
		    SWP_NOACTIVATE | SWP_NOMOVE | SWP_NOSIZE);
    return Tk_AttachHWND((Tk_Window)winPtr, hwnd);
}

/*
 *----------------------------------------------------------------------
286
287
288
289
290
291
292


293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
    Display* display;
    Window w;
{
    Tcl_HashEntry *entryPtr;
    TkWinDrawable *twdPtr = (TkWinDrawable *)w;
    TkWindow *winPtr = TkWinGetWinPtr(w);
    HWND hwnd = Tk_GetHWND(w);



    display->request++;

    /*
     * Remove references to the window in the pointer module then
     * release the drawable.
     */

    TkPointerDeadWindow(winPtr);

    entryPtr = Tcl_FindHashEntry(&windowTable, (char*)hwnd);
    if (entryPtr != NULL) {
	Tcl_DeleteHashEntry(entryPtr);
    }

    ckfree((char *)twdPtr);

    /*







>
>










|







291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
    Display* display;
    Window w;
{
    Tcl_HashEntry *entryPtr;
    TkWinDrawable *twdPtr = (TkWinDrawable *)w;
    TkWindow *winPtr = TkWinGetWinPtr(w);
    HWND hwnd = Tk_GetHWND(w);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    display->request++;

    /*
     * Remove references to the window in the pointer module then
     * release the drawable.
     */

    TkPointerDeadWindow(winPtr);

    entryPtr = Tcl_FindHashEntry(&tsdPtr->windowTable, (char*)hwnd);
    if (entryPtr != NULL) {
	Tcl_DeleteHashEntry(entryPtr);
    }

    ckfree((char *)twdPtr);

    /*

Changes to win/tkWinWm.c.

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
/* 
 * tkWinWm.c --
 *
 *	This module takes care of the interactions between a Tk-based
 *	application and the window manager.  Among other things, it
 *	implements the "wm" command and passes geometry information
 *	to the window manager.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinWm.c 1.67 97/09/23 17:39:47
 */

#include "tkWinInt.h"












/*
 * A data structure of the following type holds information for
 * each window manager protocol (such as WM_DELETE_WINDOW) for
 * which a handler (i.e. a Tcl command) has been defined for a
 * particular top-level window.
 */










>




|




>
>
>
>
>
>
>
>
>
>
>







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
/* 
 * tkWinWm.c --
 *
 *	This module takes care of the interactions between a Tk-based
 *	application and the window manager.  Among other things, it
 *	implements the "wm" command and passes geometry information
 *	to the window manager.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinWm.c,v 1.1.4.13 1999/04/06 03:51:08 stanton Exp $
 */

#include "tkWinInt.h"

/*
 * Event structure for synthetic activation events.  These events are
 * placed on the event queue whenever a toplevel gets a WM_MOUSEACTIVATE
 * message.
 */

typedef struct ActivateEvent {
    Tcl_Event ev;
    TkWindow *winPtr;
} ActivateEvent;

/*
 * A data structure of the following type holds information for
 * each window manager protocol (such as WM_DELETE_WINDOW) for
 * which a handler (i.e. a Tcl command) has been defined for a
 * particular top-level window.
 */

207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245

246
247
248
249
250
251
252
253
254

255

256
257
258
259
260
261
262
263
264
265


266
267
268
269


270
271
272
273
274
275
276
277

278
279
280
281
282
283
284


285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302

303
304
305
306
307
308
309
#define EX_OVERRIDE_STYLE (WS_EX_TOOLWINDOW)

#define WM_TOPLEVEL_STYLE (WS_OVERLAPPEDWINDOW|WS_CLIPCHILDREN|CS_DBLCLKS)
#define EX_TOPLEVEL_STYLE (0)

#define WM_TRANSIENT_STYLE \
		(WS_POPUP|WS_CAPTION|WS_SYSMENU|WS_CLIPSIBLINGS|CS_DBLCLKS)
#define EX_TRANSIENT_STYLE (WS_EX_TOOLWINDOW | WS_EX_DLGMODALFRAME)

/*
 * This module keeps a list of all top-level windows.
 */

static WmInfo *firstWmPtr = NULL;	/* Points to first top-level window. */
static WmInfo *foregroundWmPtr = NULL; /* Points to the foreground window. */

/*
 * The variable below is used to enable or disable tracing in this
 * module.  If tracing is enabled, then information is printed on
 * standard output about interesting interactions with the window
 * manager.
 */

static int wmTracing = 0;

/*
 * The following structure is the official type record for geometry
 * management of top-level windows.
 */

static void		TopLevelReqProc(ClientData dummy, Tk_Window tkwin);

static Tk_GeomMgr wmMgrType = {
    "wm",				/* name */
    TopLevelReqProc,			/* requestProc */
    (Tk_GeomLostSlaveProc *) NULL,	/* lostSlaveProc */
};

/*

 * Global system palette.  This value always refers to the currently
 * installed foreground logical palette.
 */

static HPALETTE systemPalette = NULL;

/*
 * Window that is being constructed.  This value is set immediately
 * before a call to CreateWindowEx, and is used by SetLimits.

 * This is a gross hack needed to work around Windows brain damage

 * where it sends the WM_GETMINMAXINFO message before the WM_CREATE
 * window.
 */

static TkWindow *createWindow = NULL;

/*
 * Flag indicating whether this module has been initialized yet.
 */



static int initialized = 0;

/*
 * Class for toplevel windows.


 */

static WNDCLASS toplevelClass;

/*
 * This flag is cleared when the first window is mapped in a non-iconic
 * state.
 */


static int firstWindow = 1;

/*
 * Forward declarations for procedures defined in this file:
 */



static void		ConfigureEvent _ANSI_ARGS_((TkWindow *winPtr,
			    XConfigureEvent *eventPtr));
static void		ConfigureTopLevel _ANSI_ARGS_((WINDOWPOS *pos));
static void		GenerateConfigureNotify _ANSI_ARGS_((
			    TkWindow *winPtr));
static void		GetMaxSize _ANSI_ARGS_((WmInfo *wmPtr,
			    int *maxWidthPtr, int *maxHeightPtr));
static void		GetMinSize _ANSI_ARGS_((WmInfo *wmPtr,
			    int *minWidthPtr, int *minHeightPtr));
static TkWindow *	GetTopLevel _ANSI_ARGS_((HWND hwnd));
static void		InitWm _ANSI_ARGS_((void));
static int		InstallColormaps _ANSI_ARGS_((HWND hwnd, int message,
			    int isForemost));
static void		InvalidateSubTree _ANSI_ARGS_((TkWindow *winPtr,
			    Colormap colormap));
static int		ParseGeometry _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, TkWindow *winPtr));
static void		RefreshColormap _ANSI_ARGS_((Colormap colormap));

static void		SetLimits _ANSI_ARGS_((HWND hwnd, MINMAXINFO *info));
static LRESULT CALLBACK	TopLevelProc _ANSI_ARGS_((HWND hwnd, UINT message,
			    WPARAM wParam, LPARAM lParam));
static void		TopLevelEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		TopLevelReqProc _ANSI_ARGS_((ClientData dummy,
			    Tk_Window tkwin));







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














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


<
>
>


|
|
<
<
|
<
>

<





>
>

















|
>







219
220
221
222
223
224
225
226
227















228
229
230
231
232
233
234
235
236
237
238
239
240
241

242
243
244

245

246

247
248
249
250
251
252
253

254

255

256

257
258
259
260
261
262

263
264
265
266
267
268


269

270
271

272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
#define EX_OVERRIDE_STYLE (WS_EX_TOOLWINDOW)

#define WM_TOPLEVEL_STYLE (WS_OVERLAPPEDWINDOW|WS_CLIPCHILDREN|CS_DBLCLKS)
#define EX_TOPLEVEL_STYLE (0)

#define WM_TRANSIENT_STYLE \
		(WS_POPUP|WS_CAPTION|WS_SYSMENU|WS_CLIPSIBLINGS|CS_DBLCLKS)
#define EX_TRANSIENT_STYLE \
		(WS_EX_TOOLWINDOW|WS_EX_DLGMODALFRAME)
















/*
 * The following structure is the official type record for geometry
 * management of top-level windows.
 */

static void		TopLevelReqProc(ClientData dummy, Tk_Window tkwin);

static Tk_GeomMgr wmMgrType = {
    "wm",				/* name */
    TopLevelReqProc,			/* requestProc */
    (Tk_GeomLostSlaveProc *) NULL,	/* lostSlaveProc */
};


typedef struct ThreadSpecificData {
    HPALETTE systemPalette;      /* System palette; refers to the 
				  * currently installed foreground logical

				  * palette. */

    TkWindow *createWindow;      /* Window that is being constructed.  This

				  * value is set immediately before a
				  * call to CreateWindowEx, and is used
				  * by SetLimits.  This is a gross hack
				  * needed to work around Windows brain
				  * damage where it sends the
				  * WM_GETMINMAXINFO message before the
				  * WM_CREATE window. */

    int initialized;             /* Flag indicating whether thread-

				  * specific elements of module have 

				  * been initialized. */

    int firstWindow;             /* Flag, cleared when the first window
				  * is mapped in a non-iconic state. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*

 * The following variables cannot be placed in thread local storage
 * because they must be shared across threads.
 */

static WNDCLASS toplevelClass; /* Class for toplevel windows. */
static int initialized;        /* Flag indicating whether module has


				* been initialized. */

TCL_DECLARE_MUTEX(winWmMutex)



/*
 * Forward declarations for procedures defined in this file:
 */

static int		ActivateWindow _ANSI_ARGS_((Tcl_Event *evPtr,
			    int flags));
static void		ConfigureEvent _ANSI_ARGS_((TkWindow *winPtr,
			    XConfigureEvent *eventPtr));
static void		ConfigureTopLevel _ANSI_ARGS_((WINDOWPOS *pos));
static void		GenerateConfigureNotify _ANSI_ARGS_((
			    TkWindow *winPtr));
static void		GetMaxSize _ANSI_ARGS_((WmInfo *wmPtr,
			    int *maxWidthPtr, int *maxHeightPtr));
static void		GetMinSize _ANSI_ARGS_((WmInfo *wmPtr,
			    int *minWidthPtr, int *minHeightPtr));
static TkWindow *	GetTopLevel _ANSI_ARGS_((HWND hwnd));
static void		InitWm _ANSI_ARGS_((void));
static int		InstallColormaps _ANSI_ARGS_((HWND hwnd, int message,
			    int isForemost));
static void		InvalidateSubTree _ANSI_ARGS_((TkWindow *winPtr,
			    Colormap colormap));
static int		ParseGeometry _ANSI_ARGS_((Tcl_Interp *interp,
			    char *string, TkWindow *winPtr));
static void		RefreshColormap _ANSI_ARGS_((Colormap colormap,
	                    TkDisplay *dispPtr));
static void		SetLimits _ANSI_ARGS_((HWND hwnd, MINMAXINFO *info));
static LRESULT CALLBACK	TopLevelProc _ANSI_ARGS_((HWND hwnd, UINT message,
			    WPARAM wParam, LPARAM lParam));
static void		TopLevelEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static void		TopLevelReqProc _ANSI_ARGS_((ClientData dummy,
			    Tk_Window tkwin));
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
 *
 *----------------------------------------------------------------------
 */

static void
InitWm(void)
{




    if (initialized) {
        return;


    }



    initialized = 1;














    toplevelClass.style = CS_HREDRAW | CS_VREDRAW | CS_CLASSDC;

    toplevelClass.cbClsExtra = 0;
    toplevelClass.cbWndExtra = 0;
    toplevelClass.hInstance = Tk_GetHINSTANCE();
    toplevelClass.hbrBackground = NULL;
    toplevelClass.lpszMenuName = NULL;
    toplevelClass.lpszClassName = TK_WIN_TOPLEVEL_CLASS_NAME;
    toplevelClass.lpfnWndProc = WmProc;
    toplevelClass.hIcon = LoadIcon(Tk_GetHINSTANCE(), "tk");
    toplevelClass.hCursor = LoadCursor(NULL, IDC_ARROW);

    if (!RegisterClass(&toplevelClass)) {
	panic("Unable to register TkTopLevel class");



    }
}

/*
 *----------------------------------------------------------------------
 *
 * GetTopLevel --







>
>
>
>
|
<
>
>

>
>
>
|
>

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

|
|
>
>
>







323
324
325
326
327
328
329
330
331
332
333
334

335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
 *
 *----------------------------------------------------------------------
 */

static void
InitWm(void)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    WNDCLASS * classPtr;

    if (! tsdPtr->initialized) {

	tsdPtr->initialized = 1;
	tsdPtr->firstWindow = 1;
    }
    if (! initialized) {
	Tcl_MutexLock(&winWmMutex);
	if (! initialized) {
	    initialized = 1;
	    classPtr = &toplevelClass;

    /*
     * When threads are enabled, we cannot use CLASSDC because
     * threads will then write into the same device context.
     * 
     * This is a hack; we should add a subsystem that manages
     * device context on a per-thread basis.  See also tkWinX.c,
     * which also initializes a WNDCLASS structure.
     */

#ifdef TCL_THREADS
	    classPtr->style = CS_HREDRAW | CS_VREDRAW;
#else
	    classPtr->style = CS_HREDRAW | CS_VREDRAW | CS_CLASSDC;
#endif
	    classPtr->cbClsExtra = 0;
	    classPtr->cbWndExtra = 0;
	    classPtr->hInstance = Tk_GetHINSTANCE();
	    classPtr->hbrBackground = NULL;
	    classPtr->lpszMenuName = NULL;
	    classPtr->lpszClassName = TK_WIN_TOPLEVEL_CLASS_NAME;
	    classPtr->lpfnWndProc = WmProc;
	    classPtr->hIcon = LoadIcon(Tk_GetHINSTANCE(), "tk");
	    classPtr->hCursor = LoadCursor(NULL, IDC_ARROW);

	    if (!RegisterClass(classPtr)) {
		panic("Unable to register TkTopLevel class");
	    }
	}
	Tcl_MutexUnlock(&winWmMutex);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * GetTopLevel --
370
371
372
373
374
375
376



377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
 *----------------------------------------------------------------------
 */

static TkWindow *
GetTopLevel(hwnd)
    HWND hwnd;
{



    /*
     * If this function is called before the CreateWindowEx call
     * has completed, then the user data slot will not have been
     * set yet, so we use the global createWindow variable.
     */

    if (createWindow) {
	return createWindow;
    }
    return (TkWindow *) GetWindowLong(hwnd, GWL_USERDATA);
}

/*
 *----------------------------------------------------------------------
 *







>
>
>






|
|







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
 *----------------------------------------------------------------------
 */

static TkWindow *
GetTopLevel(hwnd)
    HWND hwnd;
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * If this function is called before the CreateWindowEx call
     * has completed, then the user data slot will not have been
     * set yet, so we use the global createWindow variable.
     */

    if (tsdPtr->createWindow) {
	return tsdPtr->createWindow;
    }
    return (TkWindow *) GetWindowLong(hwnd, GWL_USERDATA);
}

/*
 *----------------------------------------------------------------------
 *
491
492
493
494
495
496
497



498
499
500
501
502
503
504
505
506
507
508
 *----------------------------------------------------------------------
 */

void
TkWinWmCleanup(hInstance)
    HINSTANCE hInstance;
{



    if (!initialized) {
        return;
    }
    initialized = 0;
    
    UnregisterClass(TK_WIN_TOPLEVEL_CLASS_NAME, hInstance);
}

/*
 *--------------------------------------------------------------
 *







>
>
>
|


|







514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
 *----------------------------------------------------------------------
 */

void
TkWinWmCleanup(hInstance)
    HINSTANCE hInstance;
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (!tsdPtr->initialized) {
        return;
    }
    tsdPtr->initialized = 0;
    
    UnregisterClass(TK_WIN_TOPLEVEL_CLASS_NAME, hInstance);
}

/*
 *--------------------------------------------------------------
 *
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592

    wmPtr->configWidth = -1;
    wmPtr->configHeight = -1;
    wmPtr->protPtr = NULL;
    wmPtr->cmdArgv = NULL;
    wmPtr->clientMachine = NULL;
    wmPtr->flags = WM_NEVER_MAPPED;
    wmPtr->nextPtr = firstWmPtr;
    firstWmPtr = wmPtr;

    /*
     * Tk must monitor structure events for top-level windows, in order
     * to detect size and position changes caused by window managers.
     */

    Tk_CreateEventHandler((Tk_Window) winPtr, StructureNotifyMask,







|
|







603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618

    wmPtr->configWidth = -1;
    wmPtr->configHeight = -1;
    wmPtr->protPtr = NULL;
    wmPtr->cmdArgv = NULL;
    wmPtr->clientMachine = NULL;
    wmPtr->flags = WM_NEVER_MAPPED;
    wmPtr->nextPtr = winPtr->dispPtr->firstWmPtr;
    winPtr->dispPtr->firstWmPtr = wmPtr;

    /*
     * Tk must monitor structure events for top-level windows, in order
     * to detect size and position changes caused by window managers.
     */

    Tk_CreateEventHandler((Tk_Window) winPtr, StructureNotifyMask,
625
626
627
628
629
630
631



632
633
634
635
636
637
638
    TkWindow *winPtr;		/* Top-level window to redecorate. */
{
    register WmInfo *wmPtr = winPtr->wmInfoPtr;
    HWND parentHWND = NULL, oldWrapper;
    HWND child = TkWinGetHWND(winPtr->window);
    int x, y, width, height, state;
    WINDOWPLACEMENT place;




    parentHWND = NULL;
    child = TkWinGetHWND(winPtr->window); 

    if (winPtr->flags & TK_EMBEDDED) {
	wmPtr->wrapper = (HWND) winPtr->privatePtr;
	if (wmPtr->wrapper == NULL) {







>
>
>







651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
    TkWindow *winPtr;		/* Top-level window to redecorate. */
{
    register WmInfo *wmPtr = winPtr->wmInfoPtr;
    HWND parentHWND = NULL, oldWrapper;
    HWND child = TkWinGetHWND(winPtr->window);
    int x, y, width, height, state;
    WINDOWPLACEMENT place;
    Tcl_DString titleString;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    parentHWND = NULL;
    child = TkWinGetHWND(winPtr->window); 

    if (winPtr->flags & TK_EMBEDDED) {
	wmPtr->wrapper = (HWND) winPtr->privatePtr;
	if (wmPtr->wrapper == NULL) {
663
664
665
666
667
668
669





670
671
672
673
674
675
676
		    (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE))) {
		wmPtr->style |= WS_THICKFRAME;
	    }
	} else {
	    wmPtr->style = WM_TOPLEVEL_STYLE;
	    wmPtr->exStyle = EX_TOPLEVEL_STYLE;
	}






	/*
	 * Compute the geometry of the parent and child windows.
	 */

	wmPtr->flags |= WM_CREATE_PENDING|WM_MOVE_PENDING;
	UpdateGeometryInfo((ClientData)winPtr);







>
>
>
>
>







692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
		    (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE))) {
		wmPtr->style |= WS_THICKFRAME;
	    }
	} else {
	    wmPtr->style = WM_TOPLEVEL_STYLE;
	    wmPtr->exStyle = EX_TOPLEVEL_STYLE;
	}

	if ((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE)
		&& (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE)) {
	    wmPtr->style &= ~ (WS_MAXIMIZEBOX | WS_SIZEBOX);
	}

	/*
	 * Compute the geometry of the parent and child windows.
	 */

	wmPtr->flags |= WM_CREATE_PENDING|WM_MOVE_PENDING;
	UpdateGeometryInfo((ClientData)winPtr);
696
697
698
699
700
701
702
703

704
705
706
707

708
709
710
711
712
713
714
715
716
	}

	/*
	 * Create the containing window, and set the user data to point
	 * to the TkWindow.
	 */

	createWindow = winPtr;

	wmPtr->wrapper = CreateWindowEx(wmPtr->exStyle,
		TK_WIN_TOPLEVEL_CLASS_NAME,
		wmPtr->titleUid, wmPtr->style, x, y, width, height,
		parentHWND, NULL, Tk_GetHINSTANCE(), NULL);

	SetWindowLong(wmPtr->wrapper, GWL_USERDATA, (LONG) winPtr);
	createWindow = NULL;

	place.length = sizeof(WINDOWPLACEMENT);
	GetWindowPlacement(wmPtr->wrapper, &place);
	wmPtr->x = place.rcNormalPosition.left;
	wmPtr->y = place.rcNormalPosition.top;

	TkInstallFrameMenu((Tk_Window) winPtr);







|
>


|
|
>

|







730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
	}

	/*
	 * Create the containing window, and set the user data to point
	 * to the TkWindow.
	 */

	tsdPtr->createWindow = winPtr;
	Tcl_UtfToExternalDString(NULL, wmPtr->titleUid, -1, &titleString);
	wmPtr->wrapper = CreateWindowEx(wmPtr->exStyle,
		TK_WIN_TOPLEVEL_CLASS_NAME,
		Tcl_DStringValue(&titleString), wmPtr->style, x, y, width, 
		height, parentHWND, NULL, Tk_GetHINSTANCE(), NULL);
	Tcl_DStringFree(&titleString);
	SetWindowLong(wmPtr->wrapper, GWL_USERDATA, (LONG) winPtr);
	tsdPtr->createWindow = NULL;

	place.length = sizeof(WINDOWPLACEMENT);
	GetWindowPlacement(wmPtr->wrapper, &place);
	wmPtr->x = place.rcNormalPosition.left;
	wmPtr->y = place.rcNormalPosition.top;

	TkInstallFrameMenu((Tk_Window) winPtr);
727
728
729
730
731
732
733







734
735
736
737
738
739
740
    if (winPtr->flags & TK_EMBEDDED) {
	SetWindowLong(child, GWL_WNDPROC, (LONG) TopLevelProc);
    }
    oldWrapper = SetParent(child, wmPtr->wrapper);
    if (oldWrapper && (oldWrapper != wmPtr->wrapper) 
	    && (oldWrapper != GetDesktopWindow())) {
	SetWindowLong(oldWrapper, GWL_USERDATA, (LONG) NULL);







	DestroyWindow(oldWrapper);
    }
    wmPtr->flags &= ~WM_NEVER_MAPPED;
    SendMessage(wmPtr->wrapper, TK_ATTACHWINDOW, (WPARAM) child, 0);

    /*
     * Force an initial transition from withdrawn to the real







>
>
>
>
>
>
>







763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
    if (winPtr->flags & TK_EMBEDDED) {
	SetWindowLong(child, GWL_WNDPROC, (LONG) TopLevelProc);
    }
    oldWrapper = SetParent(child, wmPtr->wrapper);
    if (oldWrapper && (oldWrapper != wmPtr->wrapper) 
	    && (oldWrapper != GetDesktopWindow())) {
	SetWindowLong(oldWrapper, GWL_USERDATA, (LONG) NULL);

	/*
	 * Remove the menubar before destroying the window so the menubar
	 * isn't destroyed.
	 */

	SetMenu(oldWrapper, NULL);
	DestroyWindow(oldWrapper);
    }
    wmPtr->flags &= ~WM_NEVER_MAPPED;
    SendMessage(wmPtr->wrapper, TK_ATTACHWINDOW, (WPARAM) child, 0);

    /*
     * Force an initial transition from withdrawn to the real
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
    }

    /*
     * If this is the first window created by the application, then
     * we should activate the initial window.
     */

    if (firstWindow) {
	firstWindow = 0;
	SetActiveWindow(wmPtr->wrapper);
    }
}

/*
 *--------------------------------------------------------------
 *







|
|







812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
    }

    /*
     * If this is the first window created by the application, then
     * we should activate the initial window.
     */

    if (tsdPtr->firstWindow) {
	tsdPtr->firstWindow = 0;
	SetActiveWindow(wmPtr->wrapper);
    }
}

/*
 *--------------------------------------------------------------
 *
804
805
806
807
808
809
810


811
812
813
814
815
816
817
818
819

void
TkWmMapWindow(winPtr)
    TkWindow *winPtr;		/* Top-level window that's about to
				 * be mapped. */
{
    register WmInfo *wmPtr = winPtr->wmInfoPtr;



    if (!initialized) {
	InitWm();
    }

    if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
	if (wmPtr->hints.initial_state == WithdrawnState) {
	    return;
	}







>
>

|







847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864

void
TkWmMapWindow(winPtr)
    TkWindow *winPtr;		/* Top-level window that's about to
				 * be mapped. */
{
    register WmInfo *wmPtr = winPtr->wmInfoPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (!tsdPtr->initialized) {
	InitWm();
    }

    if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
	if (wmPtr->hints.initial_state == WithdrawnState) {
	    return;
	}
886
887
888
889
890
891
892

893
894
895
896
897
898
899
900
901
902
903
904
905
906
907

908
909
910
911
912
913
914
     TkWindow *winPtr;		/* Toplevel window to operate on. */
     int state;			/* One of IconicState, ZoomState, NormalState,
				 * or WithdrawnState. */
{
    WmInfo *wmPtr = winPtr->wmInfoPtr;
    int cmd;
    

    if (wmPtr->flags & WM_NEVER_MAPPED) {
	wmPtr->hints.initial_state = state;
	return;
    }

    wmPtr->flags |= WM_SYNC_PENDING;
    if (state == WithdrawnState) {
	cmd = SW_HIDE;
    } else if (state == IconicState) {
	cmd = SW_SHOWMINNOACTIVE;
    } else if (state == NormalState) {
	cmd = SW_SHOWNOACTIVATE;
    } else if (state == ZoomState) {
	cmd = SW_SHOWMAXIMIZED;
    }

    ShowWindow(wmPtr->wrapper, cmd);
    wmPtr->flags &= ~WM_SYNC_PENDING;
}

/*
 *--------------------------------------------------------------
 *







>















>







931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
     TkWindow *winPtr;		/* Toplevel window to operate on. */
     int state;			/* One of IconicState, ZoomState, NormalState,
				 * or WithdrawnState. */
{
    WmInfo *wmPtr = winPtr->wmInfoPtr;
    int cmd;
    

    if (wmPtr->flags & WM_NEVER_MAPPED) {
	wmPtr->hints.initial_state = state;
	return;
    }

    wmPtr->flags |= WM_SYNC_PENDING;
    if (state == WithdrawnState) {
	cmd = SW_HIDE;
    } else if (state == IconicState) {
	cmd = SW_SHOWMINNOACTIVE;
    } else if (state == NormalState) {
	cmd = SW_SHOWNOACTIVATE;
    } else if (state == ZoomState) {
	cmd = SW_SHOWMAXIMIZED;
    }

    ShowWindow(wmPtr->wrapper, cmd);
    wmPtr->flags &= ~WM_SYNC_PENDING;
}

/*
 *--------------------------------------------------------------
 *
938
939
940
941
942
943
944
945
946
947
948

949
950
951
952
953
954
955
956
957
958
959
960
961
962
963

964
965
966
967
968
969
970
971
	return;
    }

    /*
     * Clean up event related window info.
     */

    if (firstWmPtr == wmPtr) {
	firstWmPtr = wmPtr->nextPtr;
    } else {
	register WmInfo *prevPtr;

	for (prevPtr = firstWmPtr; ; prevPtr = prevPtr->nextPtr) {
	    if (prevPtr == NULL) {
		panic("couldn't unlink window in TkWmDeadWindow");
	    }
	    if (prevPtr->nextPtr == wmPtr) {
		prevPtr->nextPtr = wmPtr->nextPtr;
		break;
	    }
	}
    }

    /*
     * Reset all transient windows whose master is the dead window.
     */


    for (wmPtr2 = firstWmPtr; wmPtr2 != NULL; wmPtr2 = wmPtr2->nextPtr) {
	if (wmPtr2->masterPtr == winPtr) {
	    wmPtr2->masterPtr = NULL;
	    if ((wmPtr2->wrapper != None)
		    && !(wmPtr2->flags & (WM_NEVER_MAPPED))) {
		UpdateWrapper(wmPtr2->winPtr);
	    }
	}







|
|


>
|














>
|







985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
	return;
    }

    /*
     * Clean up event related window info.
     */

    if (winPtr->dispPtr->firstWmPtr == wmPtr) {
	winPtr->dispPtr->firstWmPtr = wmPtr->nextPtr;
    } else {
	register WmInfo *prevPtr;
	for (prevPtr = winPtr->dispPtr->firstWmPtr; ; prevPtr
		 = prevPtr->nextPtr) {
	    if (prevPtr == NULL) {
		panic("couldn't unlink window in TkWmDeadWindow");
	    }
	    if (prevPtr->nextPtr == wmPtr) {
		prevPtr->nextPtr = wmPtr->nextPtr;
		break;
	    }
	}
    }

    /*
     * Reset all transient windows whose master is the dead window.
     */

    for (wmPtr2 = winPtr->dispPtr->firstWmPtr; wmPtr2 != NULL; wmPtr2
	     = wmPtr2->nextPtr) {
	if (wmPtr2->masterPtr == winPtr) {
	    wmPtr2->masterPtr = NULL;
	    if ((wmPtr2->wrapper != None)
		    && !(wmPtr2->flags & (WM_NEVER_MAPPED))) {
		UpdateWrapper(wmPtr2->winPtr);
	    }
	}
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081

1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    Tk_Window tkwin = (Tk_Window) clientData;
    TkWindow *winPtr;
    register WmInfo *wmPtr;
    int c;
    size_t length;


    if (argc < 2) {
	wrongNumArgs:
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option window ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 't') && (strncmp(argv[1], "tracing", length) == 0)
	    && (length >= 3)) {
	if ((argc != 2) && (argc != 3)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " tracing ?boolean?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 2) {
	    interp->result = (wmTracing) ? "on" : "off";
	    return TCL_OK;
	}
	return Tcl_GetBoolean(interp, argv[2], &wmTracing);
    }

    if (argc < 3) {
	goto wrongNumArgs;
    }
    winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
    if (winPtr == NULL) {







|



>

















|


|







1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
    ClientData clientData;	/* Main window associated with
				 * interpreter. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
{
    Tk_Window tkwin = (Tk_Window) clientData;
    TkWindow *winPtr = NULL;
    register WmInfo *wmPtr;
    int c;
    size_t length;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    if (argc < 2) {
	wrongNumArgs:
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option window ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    c = argv[1][0];
    length = strlen(argv[1]);
    if ((c == 't') && (strncmp(argv[1], "tracing", length) == 0)
	    && (length >= 3)) {
	if ((argc != 2) && (argc != 3)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " tracing ?boolean?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 2) {
	    Tcl_SetResult(interp, ((dispPtr->wmTracing) ? "on" : "off"), TCL_STATIC);
	    return TCL_OK;
	}
	return Tcl_GetBoolean(interp, argv[2], &dispPtr->wmTracing);
    }

    if (argc < 3) {
	goto wrongNumArgs;
    }
    winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
    if (winPtr == NULL) {
1122
1123
1124
1125
1126
1127
1128


1129
1130
1131

1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146

1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " aspect window ?minNumer minDenom ",
		    "maxNumer maxDenom?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & PAspect) {


		sprintf(interp->result, "%d %d %d %d", wmPtr->minAspect.x,
			wmPtr->minAspect.y, wmPtr->maxAspect.x,
			wmPtr->maxAspect.y);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~PAspect;
	} else {
	    if ((Tcl_GetInt(interp, argv[3], &numer1) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[4], &denom1) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[5], &numer2) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[6], &denom2) != TCL_OK)) {
		return TCL_ERROR;
	    }
	    if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
		    (denom2 <= 0)) {
		interp->result = "aspect number can't be <= 0";

		return TCL_ERROR;
	    }
	    wmPtr->minAspect.x = numer1;
	    wmPtr->minAspect.y = denom1;
	    wmPtr->maxAspect.x = numer2;
	    wmPtr->maxAspect.y = denom2;
	    wmPtr->sizeHintsFlags |= PAspect;
	}
	goto updateGeom;
    } else if ((c == 'c') && (strncmp(argv[1], "client", length) == 0)
	    && (length >= 2)) {
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " client window ?name?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->clientMachine != NULL) {
		interp->result = wmPtr->clientMachine;
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == 0) {
	    if (wmPtr->clientMachine != NULL) {
		ckfree((char *) wmPtr->clientMachine);
		wmPtr->clientMachine = NULL;







>
>
|


>














|
>



















|







1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " aspect window ?minNumer minDenom ",
		    "maxNumer maxDenom?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & PAspect) {
		char buf[TCL_INTEGER_SPACE * 4];
		
		sprintf(buf, "%d %d %d %d", wmPtr->minAspect.x,
			wmPtr->minAspect.y, wmPtr->maxAspect.x,
			wmPtr->maxAspect.y);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~PAspect;
	} else {
	    if ((Tcl_GetInt(interp, argv[3], &numer1) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[4], &denom1) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[5], &numer2) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[6], &denom2) != TCL_OK)) {
		return TCL_ERROR;
	    }
	    if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
		    (denom2 <= 0)) {
		Tcl_SetResult(interp, "aspect number can't be <= 0",
			TCL_STATIC);
		return TCL_ERROR;
	    }
	    wmPtr->minAspect.x = numer1;
	    wmPtr->minAspect.y = denom1;
	    wmPtr->maxAspect.x = numer2;
	    wmPtr->maxAspect.y = denom2;
	    wmPtr->sizeHintsFlags |= PAspect;
	}
	goto updateGeom;
    } else if ((c == 'c') && (strncmp(argv[1], "client", length) == 0)
	    && (length >= 2)) {
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " client window ?name?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->clientMachine != NULL) {
		Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == 0) {
	    if (wmPtr->clientMachine != NULL) {
		ckfree((char *) wmPtr->clientMachine);
		wmPtr->clientMachine = NULL;
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280

1281
1282
1283
1284
1285
1286
1287
1288
1289
	wmPtr->cmapCount = windowArgc;
	ckfree((char *) windowArgv);

	/*
	 * Now we need to force the updated colormaps to be installed.
	 */

	if (wmPtr == foregroundWmPtr) {
	    InstallColormaps(wmPtr->wrapper, WM_QUERYNEWPALETTE, 1);
	} else {
	    InstallColormaps(wmPtr->wrapper, WM_PALETTECHANGED, 0);
	}
	return TCL_OK;
    } else if ((c == 'c') && (strncmp(argv[1], "command", length) == 0)
	    && (length >= 3)) {
	int cmdArgc;
	char **cmdArgv;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " command window ?value?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->cmdArgv != NULL) {

		interp->result = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
		interp->freeProc = TCL_DYNAMIC;
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == 0) {
	    if (wmPtr->cmdArgv != NULL) {
		ckfree((char *) wmPtr->cmdArgv);
		wmPtr->cmdArgv = NULL;







|


















>
|
|







1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
	wmPtr->cmapCount = windowArgc;
	ckfree((char *) windowArgv);

	/*
	 * Now we need to force the updated colormaps to be installed.
	 */

	if (wmPtr == winPtr->dispPtr->foregroundWmPtr) {
	    InstallColormaps(wmPtr->wrapper, WM_QUERYNEWPALETTE, 1);
	} else {
	    InstallColormaps(wmPtr->wrapper, WM_PALETTECHANGED, 0);
	}
	return TCL_OK;
    } else if ((c == 'c') && (strncmp(argv[1], "command", length) == 0)
	    && (length >= 3)) {
	int cmdArgc;
	char **cmdArgv;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " command window ?value?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->cmdArgv != NULL) {
		Tcl_SetResult(interp,
			Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv),
			TCL_DYNAMIC);
	    }
	    return TCL_OK;
	}
	if (argv[3][0] == 0) {
	    if (wmPtr->cmdArgv != NULL) {
		ckfree((char *) wmPtr->cmdArgv);
		wmPtr->cmdArgv = NULL;
1327
1328
1329
1330
1331
1332
1333
1334

1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350

1351
1352
1353
1354
1355
1356



1357
1358
1359
1360
1361

1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373


1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386

1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406


1407
1408
1409

1410
1411
1412
1413
1414
1415
1416
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " focusmodel window ?active|passive?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    interp->result = wmPtr->hints.input ? "passive" : "active";

	    return TCL_OK;
	}
	c = argv[3][0];
	length = strlen(argv[3]);
	if ((c == 'a') && (strncmp(argv[3], "active", length) == 0)) {
	    wmPtr->hints.input = False;
	} else if ((c == 'p') && (strncmp(argv[3], "passive", length) == 0)) {
	    wmPtr->hints.input = True;
	} else {
	    Tcl_AppendResult(interp, "bad argument \"", argv[3],
		    "\": must be active or passive", (char *) NULL);
	    return TCL_ERROR;
	}
    } else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0)
	    && (length >= 2)) {
	HWND hwnd;


	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " frame window\"", (char *) NULL);
	    return TCL_ERROR;
	}



	hwnd = wmPtr->wrapper;
	if (hwnd == NULL) {
	    hwnd = Tk_GetHWND(Tk_WindowId((Tk_Window) winPtr));
	}
	sprintf(interp->result, "0x%x", (unsigned int) hwnd);

    } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)
	    && (length >= 2)) {
	char xSign, ySign;
	int width, height;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " geometry window ?newGeometry?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {


	    xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
	    ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
	    if (wmPtr->gridWin != NULL) {
		width = wmPtr->reqGridWidth + (winPtr->changes.width
			- winPtr->reqWidth)/wmPtr->widthInc;
		height = wmPtr->reqGridHeight + (winPtr->changes.height
			- winPtr->reqHeight)/wmPtr->heightInc;
	    } else {
		width = winPtr->changes.width;
		height = winPtr->changes.height;
	    }
	    sprintf(interp->result, "%dx%d%c%d%c%d", width, height,
		    xSign, wmPtr->x, ySign, wmPtr->y);

	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->width = -1;
	    wmPtr->height = -1;
	    goto updateGeom;
	}
	return ParseGeometry(interp, argv[3], winPtr);
    } else if ((c == 'g') && (strncmp(argv[1], "grid", length) == 0)
	    && (length >= 3)) {
	int reqWidth, reqHeight, widthInc, heightInc;

	if ((argc != 3) && (argc != 7)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " grid window ?baseWidth baseHeight ",
		    "widthInc heightInc?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & PBaseSize) {


		sprintf(interp->result, "%d %d %d %d", wmPtr->reqGridWidth,
			wmPtr->reqGridHeight, wmPtr->widthInc,
			wmPtr->heightInc);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    /*
	     * Turn off gridding and reset the width and height
	     * to make sense as ungridded numbers.







|
>
















>






>
>
>




|
>












>
>











|
|
>




















>
>
|


>







1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " focusmodel window ?active|passive?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
		    TCL_STATIC);
	    return TCL_OK;
	}
	c = argv[3][0];
	length = strlen(argv[3]);
	if ((c == 'a') && (strncmp(argv[3], "active", length) == 0)) {
	    wmPtr->hints.input = False;
	} else if ((c == 'p') && (strncmp(argv[3], "passive", length) == 0)) {
	    wmPtr->hints.input = True;
	} else {
	    Tcl_AppendResult(interp, "bad argument \"", argv[3],
		    "\": must be active or passive", (char *) NULL);
	    return TCL_ERROR;
	}
    } else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0)
	    && (length >= 2)) {
	HWND hwnd;
	char buf[TCL_INTEGER_SPACE];

	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " frame window\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (Tk_WindowId((Tk_Window) winPtr) == None) {
	    Tk_MakeWindowExist((Tk_Window) winPtr);
	}
	hwnd = wmPtr->wrapper;
	if (hwnd == NULL) {
	    hwnd = Tk_GetHWND(Tk_WindowId((Tk_Window) winPtr));
	}
	sprintf(buf, "0x%x", (unsigned int) hwnd);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)
	    && (length >= 2)) {
	char xSign, ySign;
	int width, height;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " geometry window ?newGeometry?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    char buf[16 + TCL_INTEGER_SPACE * 4];
	    
	    xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
	    ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
	    if (wmPtr->gridWin != NULL) {
		width = wmPtr->reqGridWidth + (winPtr->changes.width
			- winPtr->reqWidth)/wmPtr->widthInc;
		height = wmPtr->reqGridHeight + (winPtr->changes.height
			- winPtr->reqHeight)/wmPtr->heightInc;
	    } else {
		width = winPtr->changes.width;
		height = winPtr->changes.height;
	    }
	    sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x,
		    ySign, wmPtr->y);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->width = -1;
	    wmPtr->height = -1;
	    goto updateGeom;
	}
	return ParseGeometry(interp, argv[3], winPtr);
    } else if ((c == 'g') && (strncmp(argv[1], "grid", length) == 0)
	    && (length >= 3)) {
	int reqWidth, reqHeight, widthInc, heightInc;

	if ((argc != 3) && (argc != 7)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " grid window ?baseWidth baseHeight ",
		    "widthInc heightInc?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & PBaseSize) {
		char buf[TCL_INTEGER_SPACE * 4];
		
		sprintf(buf, "%d %d %d %d", wmPtr->reqGridWidth,
			wmPtr->reqGridHeight, wmPtr->widthInc,
			wmPtr->heightInc);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    /*
	     * Turn off gridding and reset the width and height
	     * to make sense as ungridded numbers.
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
	    if ((Tcl_GetInt(interp, argv[3], &reqWidth) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[4], &reqHeight) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[5], &widthInc) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[6], &heightInc) != TCL_OK)) {
		return TCL_ERROR;
	    }
	    if (reqWidth < 0) {
		interp->result = "baseWidth can't be < 0";
		return TCL_ERROR;
	    }
	    if (reqHeight < 0) {
		interp->result = "baseHeight can't be < 0";
		return TCL_ERROR;
	    }
	    if (widthInc < 0) {
		interp->result = "widthInc can't be < 0";
		return TCL_ERROR;
	    }
	    if (heightInc < 0) {
		interp->result = "heightInc can't be < 0";
		return TCL_ERROR;
	    }
	    Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
		    heightInc);
	}
	goto updateGeom;
    } else if ((c == 'g') && (strncmp(argv[1], "group", length) == 0)
	    && (length >= 3)) {
	Tk_Window tkwin2;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " group window ?pathName?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & WindowGroupHint) {
		interp->result = wmPtr->leaderName;
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~WindowGroupHint;
	    if (wmPtr->leaderName != NULL) {
		ckfree(wmPtr->leaderName);







|



|



|



|


















|







1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
	    if ((Tcl_GetInt(interp, argv[3], &reqWidth) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[4], &reqHeight) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[5], &widthInc) != TCL_OK)
		    || (Tcl_GetInt(interp, argv[6], &heightInc) != TCL_OK)) {
		return TCL_ERROR;
	    }
	    if (reqWidth < 0) {
		Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC);
		return TCL_ERROR;
	    }
	    if (reqHeight < 0) {
		Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC);
		return TCL_ERROR;
	    }
	    if (widthInc < 0) {
		Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC);
		return TCL_ERROR;
	    }
	    if (heightInc < 0) {
		Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC);
		return TCL_ERROR;
	    }
	    Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
		    heightInc);
	}
	goto updateGeom;
    } else if ((c == 'g') && (strncmp(argv[1], "group", length) == 0)
	    && (length >= 3)) {
	Tk_Window tkwin2;

	if ((argc != 3) && (argc != 4)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " group window ?pathName?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & WindowGroupHint) {
		Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~WindowGroupHint;
	    if (wmPtr->leaderName != NULL) {
		ckfree(wmPtr->leaderName);
1493
1494
1495
1496
1497
1498
1499
1500
1501

1502
1503
1504
1505
1506
1507
1508
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconbitmap window ?bitmap?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconPixmapHint) {
		interp->result = Tk_NameOfBitmap(winPtr->display,
			wmPtr->hints.icon_pixmap);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    if (wmPtr->hints.icon_pixmap != None) {
		Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap);
	    }







|
|
>







1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconbitmap window ?bitmap?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconPixmapHint) {
		Tcl_SetResult(interp,
			Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap),
			TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    if (wmPtr->hints.icon_pixmap != None) {
		Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap);
	    }
1552
1553
1554
1555
1556
1557
1558
1559
1560

1561
1562
1563
1564
1565
1566
1567
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconmask window ?bitmap?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconMaskHint) {
		interp->result = Tk_NameOfBitmap(winPtr->display,
			wmPtr->hints.icon_mask);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    if (wmPtr->hints.icon_mask != None) {
		Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask);
	    }







|
|
>







1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconmask window ?bitmap?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconMaskHint) {
		Tcl_SetResult(interp,
			Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
			TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    if (wmPtr->hints.icon_mask != None) {
		Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask);
	    }
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
	    && (length >= 5)) {
	if (argc > 4) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconname window ?newName?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {

	    interp->result = (wmPtr->iconName != NULL) ? wmPtr->iconName : "";

	    return TCL_OK;
	} else {
	    wmPtr->iconName = Tk_GetUid(argv[3]);
	    if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
		XSetIconName(winPtr->display, winPtr->window, wmPtr->iconName);
	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "iconposition", length) == 0)
	    && (length >= 5)) {
	int x, y;

	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconposition window ?x y?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconPositionHint) {


		sprintf(interp->result, "%d %d", wmPtr->hints.icon_x,
			wmPtr->hints.icon_y);

	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~IconPositionHint;
	} else {
	    if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK)







>
|
>



















>
>
|

>







1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
	    && (length >= 5)) {
	if (argc > 4) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconname window ?newName?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    Tcl_SetResult(interp,
		    ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""),
		    TCL_STATIC);
	    return TCL_OK;
	} else {
	    wmPtr->iconName = Tk_GetUid(argv[3]);
	    if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
		XSetIconName(winPtr->display, winPtr->window, wmPtr->iconName);
	    }
	}
    } else if ((c == 'i') && (strncmp(argv[1], "iconposition", length) == 0)
	    && (length >= 5)) {
	int x, y;

	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconposition window ?x y?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->hints.flags & IconPositionHint) {
		char buf[TCL_INTEGER_SPACE * 2];
		
		sprintf(buf, "%d %d", wmPtr->hints.icon_x,
			wmPtr->hints.icon_y);
		Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~IconPositionHint;
	} else {
	    if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK)
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconwindow window ?pathName?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->icon != NULL) {
		interp->result = Tk_PathName(wmPtr->icon);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~IconWindowHint;
	    if (wmPtr->icon != NULL) {
		/*







|







1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " iconwindow window ?pathName?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->icon != NULL) {
		Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->hints.flags &= ~IconWindowHint;
	    if (wmPtr->icon != NULL) {
		/*
1695
1696
1697
1698
1699
1700
1701
1702
1703

1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717


1718
1719

1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738


1739
1740

1741
1742
1743
1744
1745
1746
1747
	    wmPtr->hints.icon_window = Tk_WindowId(tkwin2);
	    wmPtr->hints.flags |= IconWindowHint;
	    wmPtr->icon = tkwin2;
	    wmPtr2->iconFor = (Tk_Window) winPtr;
	    if (!(wmPtr2->flags & WM_NEVER_MAPPED)) {
		if (XWithdrawWindow(Tk_Display(tkwin2), Tk_WindowId(tkwin2),
			Tk_ScreenNumber(tkwin2)) == 0) {
		    interp->result =
			    "couldn't send withdraw message to window manager";

		    return TCL_ERROR;
		}
	    }
	}
    } else if ((c == 'm') && (strncmp(argv[1], "maxsize", length) == 0)
	    && (length >= 2)) {
	int width, height;
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " maxsize window ?width height?\"",
                    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {


	    GetMaxSize(wmPtr, &width, &height);
	    sprintf(interp->result, "%d %d", width, height);

	    return TCL_OK;
	}
	if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	wmPtr->maxWidth = width;
	wmPtr->maxHeight = height;
	goto updateGeom;
    } else if ((c == 'm') && (strncmp(argv[1], "minsize", length) == 0)
	    && (length >= 2)) {
	int width, height;
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " minsize window ?width height?\"",
                    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {


	    GetMinSize(wmPtr, &width, &height);
	    sprintf(interp->result, "%d %d", width, height);

	    return TCL_OK;
	}
	if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	wmPtr->minWidth = width;







|
|
>














>
>

|
>



















>
>

|
>







1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
	    wmPtr->hints.icon_window = Tk_WindowId(tkwin2);
	    wmPtr->hints.flags |= IconWindowHint;
	    wmPtr->icon = tkwin2;
	    wmPtr2->iconFor = (Tk_Window) winPtr;
	    if (!(wmPtr2->flags & WM_NEVER_MAPPED)) {
		if (XWithdrawWindow(Tk_Display(tkwin2), Tk_WindowId(tkwin2),
			Tk_ScreenNumber(tkwin2)) == 0) {
		    Tcl_SetResult(interp,
			    "couldn't send withdraw message to window manager",
			    TCL_STATIC);
		    return TCL_ERROR;
		}
	    }
	}
    } else if ((c == 'm') && (strncmp(argv[1], "maxsize", length) == 0)
	    && (length >= 2)) {
	int width, height;
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " maxsize window ?width height?\"",
                    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    char buf[TCL_INTEGER_SPACE * 2];
	    
	    GetMaxSize(wmPtr, &width, &height);
	    sprintf(buf, "%d %d", width, height);
    	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    return TCL_OK;
	}
	if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	wmPtr->maxWidth = width;
	wmPtr->maxHeight = height;
	goto updateGeom;
    } else if ((c == 'm') && (strncmp(argv[1], "minsize", length) == 0)
	    && (length >= 2)) {
	int width, height;
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " minsize window ?width height?\"",
                    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    char buf[TCL_INTEGER_SPACE * 2];
	    
	    GetMinSize(wmPtr, &width, &height);
	    sprintf(buf, "%d %d", width, height);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    return TCL_OK;
	}
	if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	wmPtr->minWidth = width;
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " overrideredirect window ?boolean?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
		interp->result = "1";
	    } else {
		interp->result = "0";
	    }
	    return TCL_OK;
	}
	if (Tcl_GetBoolean(interp, argv[3], &boolean) != TCL_OK) {
	    return TCL_ERROR;
	}
	atts.override_redirect = (boolean) ? True : False;







|

|







1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " overrideredirect window ?boolean?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
		Tcl_SetResult(interp, "1", TCL_STATIC);
	    } else {
		Tcl_SetResult(interp, "0", TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (Tcl_GetBoolean(interp, argv[3], &boolean) != TCL_OK) {
	    return TCL_ERROR;
	}
	atts.override_redirect = (boolean) ? True : False;
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " positionfrom window ?user/program?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & USPosition) {
		interp->result = "user";
	    } else if (wmPtr->sizeHintsFlags & PPosition) {
		interp->result = "program";
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~(USPosition|PPosition);
	} else {
	    c = argv[3][0];







|

|







1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " positionfrom window ?user/program?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & USPosition) {
		Tcl_SetResult(interp, "user", TCL_STATIC);
	    } else if (wmPtr->sizeHintsFlags & PPosition) {
		Tcl_SetResult(interp, "program", TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~(USPosition|PPosition);
	} else {
	    c = argv[3][0];
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
	if (argc == 4) {
	    /*
	     * Return the command to handle a given protocol.
	     */
	    for (protPtr = wmPtr->protPtr; protPtr != NULL;
		    protPtr = protPtr->nextPtr) {
		if (protPtr->protocol == protocol) {
		    interp->result = protPtr->command;
		    return TCL_OK;
		}
	    }
	    return TCL_OK;
	}

	/*







|







1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
	if (argc == 4) {
	    /*
	     * Return the command to handle a given protocol.
	     */
	    for (protPtr = wmPtr->protPtr; protPtr != NULL;
		    protPtr = protPtr->nextPtr) {
		if (protPtr->protocol == protocol) {
		    Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
		    return TCL_OK;
		}
	    }
	    return TCL_OK;
	}

	/*
1882
1883
1884
1885
1886
1887
1888


1889
1890
1891

1892
1893
1894
1895
1896
1897
1898
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " resizable window ?width height?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {


	    sprintf(interp->result, "%d %d",
		    (wmPtr->flags  & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
		    (wmPtr->flags  & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);

	    return TCL_OK;
	}
	if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetBoolean(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	if (width) {







>
>
|


>







1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
	if ((argc != 3) && (argc != 5)) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " resizable window ?width height?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    char buf[TCL_INTEGER_SPACE * 2];
	    
	    sprintf(buf, "%d %d",
		    (wmPtr->flags  & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
		    (wmPtr->flags  & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
	    return TCL_OK;
	}
	if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK)
		|| (Tcl_GetBoolean(interp, argv[4], &height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	if (width) {
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " sizefrom window ?user|program?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & USSize) {
		interp->result = "user";
	    } else if (wmPtr->sizeHintsFlags & PSize) {
		interp->result = "program";
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~(USSize|PSize);
	} else {
	    c = argv[3][0];







|

|







1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " sizefrom window ?user|program?\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    if (wmPtr->sizeHintsFlags & USSize) {
		Tcl_SetResult(interp, "user", TCL_STATIC);
	    } else if (wmPtr->sizeHintsFlags & PSize) {
		Tcl_SetResult(interp, "program", TCL_STATIC);
	    }
	    return TCL_OK;
	}
	if (*argv[3] == '\0') {
	    wmPtr->sizeHintsFlags &= ~(USSize|PSize);
	} else {
	    c = argv[3][0];
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977

1978
1979

1980
1981
1982
1983



1984

1985
1986
1987
1988
1989
1990
1991
	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " state window\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (wmPtr->iconFor != NULL) {
	    interp->result = "icon";
	} else {
	    switch (wmPtr->hints.initial_state) {
		case NormalState:
		    interp->result = "normal";
		    break;
		case IconicState:
		    interp->result = "iconic";
		    break;
		case WithdrawnState:
		    interp->result = "withdrawn";
		    break;
		case ZoomState:
		    interp->result = "zoomed";
		    break;
	    }
	}
    } else if ((c == 't') && (strncmp(argv[1], "title", length) == 0)
	    && (length >= 2)) {
	if (argc > 4) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " title window ?newTitle?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {

	    interp->result = (wmPtr->titleUid != NULL) ? wmPtr->titleUid
		    : winPtr->nameUid;

	    return TCL_OK;
	} else {
	    wmPtr->titleUid = Tk_GetUid(argv[3]);
	    if (!(wmPtr->flags & WM_NEVER_MAPPED) && wmPtr->wrapper != NULL) {



		SetWindowText(wmPtr->wrapper, wmPtr->titleUid);

	    }
	}
    } else if ((c == 't') && (strncmp(argv[1], "transient", length) == 0)
	    && (length >= 3)) {
	TkWindow *masterPtr;

	if ((argc != 3) && (argc != 4)) {







|



|


|


|


|











>
|
<
>




>
>
>
|
>







2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063

2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
	    && (length >= 2)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " state window\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (wmPtr->iconFor != NULL) {
	    Tcl_SetResult(interp, "icon", TCL_STATIC);
	} else {
	    switch (wmPtr->hints.initial_state) {
		case NormalState:
		    Tcl_SetResult(interp, "normal", TCL_STATIC);
		    break;
		case IconicState:
		    Tcl_SetResult(interp, "iconic", TCL_STATIC);
		    break;
		case WithdrawnState:
		    Tcl_SetResult(interp, "withdrawn", TCL_STATIC);
		    break;
		case ZoomState:
		    Tcl_SetResult(interp, "zoomed", TCL_STATIC);
		    break;
	    }
	}
    } else if ((c == 't') && (strncmp(argv[1], "title", length) == 0)
	    && (length >= 2)) {
	if (argc > 4) {
	    Tcl_AppendResult(interp, "wrong # arguments: must be \"",
		    argv[0], " title window ?newTitle?\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if (argc == 3) {
	    Tcl_SetResult(interp,
		    ((wmPtr->titleUid != NULL) ? wmPtr->titleUid : winPtr->nameUid),

		    TCL_STATIC);
	    return TCL_OK;
	} else {
	    wmPtr->titleUid = Tk_GetUid(argv[3]);
	    if (!(wmPtr->flags & WM_NEVER_MAPPED) && wmPtr->wrapper != NULL) {
		Tcl_DString titleString;
		Tcl_UtfToExternalDString(NULL, wmPtr->titleUid, -1, 
			&titleString);
		SetWindowText(wmPtr->wrapper, Tcl_DStringValue(&titleString));
		Tcl_DStringFree(&titleString);
	    }
	}
    } else if ((c == 't') && (strncmp(argv[1], "transient", length) == 0)
	    && (length >= 3)) {
	TkWindow *masterPtr;

	if ((argc != 3) && (argc != 4)) {
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
    }

    if ((wmPtr->reqGridWidth == reqWidth)
	    && (wmPtr->reqGridHeight == reqHeight)
	    && (wmPtr->widthInc == widthInc)
	    && (wmPtr->heightInc == heightInc)
	    && ((wmPtr->sizeHintsFlags & (PBaseSize|PResizeInc))
		    == PBaseSize|PResizeInc)) {
	return;
    }

    /*
     * If gridding was previously off, then forget about any window
     * size requests made by the user or via "wm geometry":  these are
     * in pixel units and there's no easy way to translate them to







|







2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
    }

    if ((wmPtr->reqGridWidth == reqWidth)
	    && (wmPtr->reqGridHeight == reqHeight)
	    && (wmPtr->widthInc == widthInc)
	    && (wmPtr->heightInc == heightInc)
	    && ((wmPtr->sizeHintsFlags & (PBaseSize|PResizeInc))
		    == (PBaseSize|PResizeInc))) {
	return;
    }

    /*
     * If gridding was previously off, then forget about any window
     * size requests made by the user or via "wm geometry":  these are
     * in pixel units and there's no easy way to translate them to
2352
2353
2354
2355
2356
2357
2358





2359
2360
2361
2362
2363
2364
2365
     * state of the window changes.
     */

    if (IsIconic(wmPtr->wrapper) || IsZoomed(wmPtr->wrapper)) {
	return;
    }






    /*
     * Compute the border size for the current window style.  This
     * size will include the resize handles, the title bar and the
     * menubar.  Note that this size will not be correct if the
     * menubar spans multiple lines.  The height will be off by a
     * multiple of the menubar height.  It really only measures the
     * minimum size of the border.







>
>
>
>
>







2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
     * state of the window changes.
     */

    if (IsIconic(wmPtr->wrapper) || IsZoomed(wmPtr->wrapper)) {
	return;
    }

    if (wmPtr->flags & WM_UPDATE_SIZE_HINTS) {
	wmPtr->flags &= ~WM_UPDATE_SIZE_HINTS;
	UpdateWrapper(winPtr);
    }
	   
    /*
     * Compute the border size for the current window style.  This
     * size will include the resize handles, the title bar and the
     * menubar.  Note that this size will not be correct if the
     * menubar spans multiple lines.  The height will be off by a
     * multiple of the menubar height.  It really only measures the
     * minimum size of the border.
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
 *
 *	This procedure parses a geometry string and updates
 *	information used to control the geometry of a top-level
 *	window.
 *
 * Results:
 *	A standard Tcl return value, plus an error message in
 *	interp->result if an error occurs.
 *
 * Side effects:
 *	The size and/or location of winPtr may change.
 *
 *--------------------------------------------------------------
 */








|







2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
 *
 *	This procedure parses a geometry string and updates
 *	information used to control the geometry of a top-level
 *	window.
 *
 * Results:
 *	A standard Tcl return value, plus an error message in
 *	the interp's result if an error occurs.
 *
 * Side effects:
 *	The size and/or location of winPtr may change.
 *
 *--------------------------------------------------------------
 */

3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
    topPtr->wmInfoPtr->cmapList = newPtr;
    topPtr->wmInfoPtr->cmapCount = count+1;

    /*
     * Now we need to force the updated colormaps to be installed.
     */

    if (topPtr->wmInfoPtr == foregroundWmPtr) {
	InstallColormaps(topPtr->wmInfoPtr->wrapper, WM_QUERYNEWPALETTE, 1);
    } else {
	InstallColormaps(topPtr->wmInfoPtr->wrapper, WM_PALETTECHANGED, 0);
    }
}

/*







|







3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
    topPtr->wmInfoPtr->cmapList = newPtr;
    topPtr->wmInfoPtr->cmapCount = count+1;

    /*
     * Now we need to force the updated colormaps to be installed.
     */

    if (topPtr->wmInfoPtr == winPtr->dispPtr->foregroundWmPtr) {
	InstallColormaps(topPtr->wmInfoPtr->wrapper, WM_QUERYNEWPALETTE, 1);
    } else {
	InstallColormaps(topPtr->wmInfoPtr->wrapper, WM_PALETTECHANGED, 0);
    }
}

/*
3495
3496
3497
3498
3499
3500
3501


3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
    int isForemost;		/* 1 if window is foremost, else 0 */
{
    int i;
    HDC dc;
    HPALETTE oldPalette;
    TkWindow *winPtr = GetTopLevel(hwnd);
    WmInfo *wmPtr;


	    
    if (winPtr == NULL) {
	return 0;
    }

    wmPtr = winPtr->wmInfoPtr;

    if (message == WM_QUERYNEWPALETTE) {
	/*
	 * Case 1: This window is about to become the foreground window, so we
	 * need to install the primary palette. If the system palette was
	 * updated, then Windows will generate a WM_PALETTECHANGED message.
	 * Otherwise, we have to synthesize one in order to ensure that the
	 * secondary palettes are installed properly.
	 */

	foregroundWmPtr = wmPtr;

	if (wmPtr->cmapCount > 0) {
	    winPtr = wmPtr->cmapList[0];
	}

	systemPalette = TkWinGetPalette(winPtr->atts.colormap);
	dc = GetDC(hwnd);
	oldPalette = SelectPalette(dc, systemPalette, FALSE);
	if (RealizePalette(dc)) {
	    RefreshColormap(winPtr->atts.colormap);
	} else if (wmPtr->cmapCount > 1) {
	    SelectPalette(dc, oldPalette, TRUE);
	    RealizePalette(dc);
	    ReleaseDC(hwnd, dc);
	    SendMessage(hwnd, WM_PALETTECHANGED, (WPARAM)hwnd,
		    (LPARAM)NULL);
	    return TRUE;







>
>
















|





|

|

|







3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
    int isForemost;		/* 1 if window is foremost, else 0 */
{
    int i;
    HDC dc;
    HPALETTE oldPalette;
    TkWindow *winPtr = GetTopLevel(hwnd);
    WmInfo *wmPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
	    
    if (winPtr == NULL) {
	return 0;
    }

    wmPtr = winPtr->wmInfoPtr;

    if (message == WM_QUERYNEWPALETTE) {
	/*
	 * Case 1: This window is about to become the foreground window, so we
	 * need to install the primary palette. If the system palette was
	 * updated, then Windows will generate a WM_PALETTECHANGED message.
	 * Otherwise, we have to synthesize one in order to ensure that the
	 * secondary palettes are installed properly.
	 */

	winPtr->dispPtr->foregroundWmPtr = wmPtr;

	if (wmPtr->cmapCount > 0) {
	    winPtr = wmPtr->cmapList[0];
	}

	tsdPtr->systemPalette = TkWinGetPalette(winPtr->atts.colormap);
	dc = GetDC(hwnd);
	oldPalette = SelectPalette(dc, tsdPtr->systemPalette, FALSE);
	if (RealizePalette(dc)) {
	    RefreshColormap(winPtr->atts.colormap, winPtr->dispPtr);
	} else if (wmPtr->cmapCount > 1) {
	    SelectPalette(dc, oldPalette, TRUE);
	    RealizePalette(dc);
	    ReleaseDC(hwnd, dc);
	    SendMessage(hwnd, WM_PALETTECHANGED, (WPARAM)hwnd,
		    (LPARAM)NULL);
	    return TRUE;
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
	    winPtr = wmPtr->cmapList[1];
	    i = 2;
	}
	dc = GetDC(hwnd);
	oldPalette = SelectPalette(dc,
		TkWinGetPalette(winPtr->atts.colormap), TRUE);
	if (RealizePalette(dc)) {
	    RefreshColormap(winPtr->atts.colormap);
	}
	for (; i < wmPtr->cmapCount; i++) {
	    winPtr = wmPtr->cmapList[i];
	    SelectPalette(dc, TkWinGetPalette(winPtr->atts.colormap), TRUE);
	    if (RealizePalette(dc)) {
		RefreshColormap(winPtr->atts.colormap);
	    }
	}
    }

    SelectPalette(dc, oldPalette, TRUE);
    RealizePalette(dc);
    ReleaseDC(hwnd, dc);







|





|







3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
	    winPtr = wmPtr->cmapList[1];
	    i = 2;
	}
	dc = GetDC(hwnd);
	oldPalette = SelectPalette(dc,
		TkWinGetPalette(winPtr->atts.colormap), TRUE);
	if (RealizePalette(dc)) {
	    RefreshColormap(winPtr->atts.colormap, winPtr->dispPtr);
	}
	for (; i < wmPtr->cmapCount; i++) {
	    winPtr = wmPtr->cmapList[i];
	    SelectPalette(dc, TkWinGetPalette(winPtr->atts.colormap), TRUE);
	    if (RealizePalette(dc)) {
		RefreshColormap(winPtr->atts.colormap, winPtr->dispPtr);
	    }
	}
    }

    SelectPalette(dc, oldPalette, TRUE);
    RealizePalette(dc);
    ReleaseDC(hwnd, dc);
3595
3596
3597
3598
3599
3600
3601
3602
3603

3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
 * Side effects:
 *	Causes damage events to be generated.
 *
 *----------------------------------------------------------------------
 */

static void
RefreshColormap(colormap)
    Colormap colormap;

{
    WmInfo *wmPtr;
    int i;

    for (wmPtr = firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) {
	if (wmPtr->cmapCount > 0) {
	    for (i = 0; i < wmPtr->cmapCount; i++) {
		if ((wmPtr->cmapList[i]->atts.colormap == colormap)
			&& Tk_IsMapped(wmPtr->cmapList[i])) {
		    InvalidateSubTree(wmPtr->cmapList[i], colormap);
		}
	    }







|

>




|







3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
 * Side effects:
 *	Causes damage events to be generated.
 *
 *----------------------------------------------------------------------
 */

static void
RefreshColormap(colormap, dispPtr)
    Colormap colormap;
    TkDisplay *dispPtr;
{
    WmInfo *wmPtr;
    int i;

    for (wmPtr = dispPtr->firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) {
	if (wmPtr->cmapCount > 0) {
	    for (i = 0; i < wmPtr->cmapCount; i++) {
		if ((wmPtr->cmapList[i]->atts.colormap == colormap)
			&& Tk_IsMapped(wmPtr->cmapList[i])) {
		    InvalidateSubTree(wmPtr->cmapList[i], colormap);
		}
	    }
3683
3684
3685
3686
3687
3688
3689



3690
3691
3692
3693
3694
3695
3696
3697
 *
 *----------------------------------------------------------------------
 */

HPALETTE
TkWinGetSystemPalette()
{



    return systemPalette;
}

/*
 *----------------------------------------------------------------------
 *
 * GetMinSize --
 *







>
>
>
|







3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
 *
 *----------------------------------------------------------------------
 */

HPALETTE
TkWinGetSystemPalette()
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    return tsdPtr->systemPalette;
}

/*
 *----------------------------------------------------------------------
 *
 * GetMinSize --
 *
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931









3932
3933
3934
3935
3936
3937
3938
{
    static int inMoveSize = 0;
    static oldMode;	/* This static is set upon entering move/size mode
			 * and is used to reset the service mode after
			 * leaving move/size mode.  Note that this mechanism
			 * assumes move/size is only one level deep. */
    LRESULT result;
    TkWindow *winPtr;
	
    if (TkWinHandleMenuEvent(&hwnd, &message, &wParam, &lParam, &result)) {
	goto done;
    }

    switch (message) {
	case WM_KILLFOCUS:
	case WM_ERASEBKGND:
	    result = 0;
	    goto done;

	case WM_ENTERSIZEMOVE:
	    inMoveSize = 1;









	    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
	    break;

	case WM_ACTIVATE:
	case WM_EXITSIZEMOVE:
	    if (inMoveSize) {
		inMoveSize = 0;







|
|












>
>
>
>
>
>
>
>
>







4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
{
    static int inMoveSize = 0;
    static oldMode;	/* This static is set upon entering move/size mode
			 * and is used to reset the service mode after
			 * leaving move/size mode.  Note that this mechanism
			 * assumes move/size is only one level deep. */
    LRESULT result;
    TkWindow *winPtr = NULL;

    if (TkWinHandleMenuEvent(&hwnd, &message, &wParam, &lParam, &result)) {
	goto done;
    }

    switch (message) {
	case WM_KILLFOCUS:
	case WM_ERASEBKGND:
	    result = 0;
	    goto done;

	case WM_ENTERSIZEMOVE:
	    inMoveSize = 1;

	    /*
	     * Cancel any current mouse timer.  If the mouse timer
	     * fires during the size/move mouse capture, it will
	     * release the capture, which is wrong.
	     */

	    TkWinCancelMouseTimer();

	    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
	    break;

	case WM_ACTIVATE:
	case WM_EXITSIZEMOVE:
	    if (inMoveSize) {
		inMoveSize = 0;
3954
3955
3956
3957
3958
3959
3960






































3961
3962
3963
3964
3965
3966
3967
	    result = InstallColormaps(hwnd, WM_QUERYNEWPALETTE, TRUE);
	    goto done;
	    
	case WM_WINDOWPOSCHANGED:
	    ConfigureTopLevel((WINDOWPOS *) lParam);
	    result = 0;
	    goto done;







































	default:
	    break;
    }

    winPtr = GetTopLevel(hwnd);
    if (winPtr && winPtr->window) {







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







4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
	    result = InstallColormaps(hwnd, WM_QUERYNEWPALETTE, TRUE);
	    goto done;
	    
	case WM_WINDOWPOSCHANGED:
	    ConfigureTopLevel((WINDOWPOS *) lParam);
	    result = 0;
	    goto done;

	case WM_NCHITTEST: {
	    winPtr = GetTopLevel(hwnd);
	    if (winPtr && (TkGrabState(winPtr) == TK_GRAB_EXCLUDED)) {
		/*
		 * This window is outside the grab heirarchy, so don't let any
		 * of the normal non-client processing occur.  Note that this
		 * implementation is not strictly correct because the grab
		 * might change between now and when the event would have been
		 * processed by Tk, but it's close enough.
		 */

		result = HTCLIENT;
		goto done;
	    }
	    break;
	}

	case WM_MOUSEACTIVATE: {
	    ActivateEvent *eventPtr;
	    winPtr = GetTopLevel((HWND) wParam);

	    /*
	     * Don't activate the window yet since there may be grabs
	     * that should take precedence.  Instead we need to queue
	     * an event so we can check the grab state right before we
	     * handle the mouse event.
	     */

	    if (winPtr) { 
		eventPtr = (ActivateEvent *)ckalloc(sizeof(ActivateEvent));
		eventPtr->ev.proc = ActivateWindow;
		eventPtr->winPtr = winPtr;
		Tcl_QueueEvent((Tcl_Event*)eventPtr, TCL_QUEUE_TAIL);
	    }
	    result = MA_NOACTIVATE;
	    goto done;
	}

	default:
	    break;
    }

    winPtr = GetTopLevel(hwnd);
    if (winPtr && winPtr->window) {
4109
4110
4111
4112
4113
4114
4115








































































				 * event. */
{
    if (!(winPtr->flags & TK_TOP_LEVEL)) {
	return NULL;
    }
    return winPtr;
}















































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
				 * event. */
{
    if (!(winPtr->flags & TK_TOP_LEVEL)) {
	return NULL;
    }
    return winPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ActivateWindow --
 *
 *	This function is called when an ActivateEvent is processed.
 *
 * Results:
 *	Returns 1 to indicate that the event was handled, else 0.
 *
 * Side effects:
 *	May activate the toplevel window associated with the event.
 *
 *----------------------------------------------------------------------
 */

static int
ActivateWindow(
    Tcl_Event *evPtr,		/* Pointer to ActivateEvent. */
    int flags)			/* Notifier event mask. */
{
    TkWindow *winPtr;

    if (! (flags & TCL_WINDOW_EVENTS)) {
	return 0;
    }

    winPtr = ((ActivateEvent *) evPtr)->winPtr;

    /*
     * Ensure that the window is not excluded by a grab.
     */

    if (winPtr && (TkGrabState(winPtr) != TK_GRAB_EXCLUDED)) {
	SetFocus(Tk_GetHWND(winPtr->window));
    }
    
    return 1;
}


/*
 *----------------------------------------------------------------------
 *
 * TkWinSetForegroundWindow --
 *
 *	This function is a wrapper for SetForegroundWindow, calling
 *      it on the wrapper window because it has no affect on child
 *      windows.
 *
 * Results:
 *	none
 *
 * Side effects:
 *	May activate the toplevel window.
 *
 *----------------------------------------------------------------------
 */

void
TkWinSetForegroundWindow(winPtr)
    TkWindow *winPtr;
{
    register WmInfo *wmPtr = winPtr->wmInfoPtr;
    
    if (wmPtr->wrapper != NULL) {
	SetForegroundWindow(wmPtr->wrapper);
    } else {
	SetForegroundWindow(Tk_GetHWND(winPtr->window));
    }
}

Changes to win/tkWinX.c.

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
/* 
 * tkWinX.c --
 *
 *	This file contains Windows emulation procedures for X routines. 
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 * Copyright (c) 1994 Software Research Associates, Inc.

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tkWinX.c 1.51 97/09/02 13:06:57
 */

#include "tkInt.h"





#include "tkWinInt.h"

/*
 * Definitions of extern variables supplied by this file.
 */

int tkpIsWin32s = -1;

/*
 * Declarations of static variables used in this file.
 */

static HINSTANCE tkInstance = (HINSTANCE) NULL;
				/* Global application instance handle. */
static TkDisplay *winDisplay;	/* Display that represents Windows screen. */
static char winScreenName[] = ":0";
				/* Default name of windows display. */


static WNDCLASS childClass;	/* Window class for child windows. */
static childClassInitialized = 0; /* Registered child class? */













/*
 * Forward declarations of procedures used in this file.
 */

static void		GenerateXEvent _ANSI_ARGS_((HWND hwnd, UINT message,
			    WPARAM wParam, LPARAM lParam));







>




|


|
>
>
>
>
>
|











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







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
/* 
 * tkWinX.c --
 *
 *	This file contains Windows emulation procedures for X routines. 
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 * Copyright (c) 1994 Software Research Associates, Inc.
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkWinX.c,v 1.1.4.9 1999/03/09 01:47:28 lfb Exp $
 */

#include "tkWinInt.h"

/*
 * The zmouse.h file includes the definition for WM_MOUSEWHEEL.
 */

#include <zmouse.h>

/*
 * Definitions of extern variables supplied by this file.
 */

int tkpIsWin32s = -1;

/*
 * Declarations of static variables used in this file.
 */




static char winScreenName[] = ":0"; /* Default name of windows display. */

static HINSTANCE tkInstance;        /* Application instance handle. */
static int childClassInitialized;   /* Registered child class? */
static WNDCLASS childClass;	    /* Window class for child windows. */

TCL_DECLARE_MUTEX(winXMutex)

/*
 * Thread local storage.  Notice that now each thread must have its
 * own TkDisplay structure, since this structure contains most of
 * the thread-specific date for threads.
 */
typedef struct ThreadSpecificData {
    TkDisplay *winDisplay;       /* TkDisplay structure that *
				  *  represents Windows screen. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations of procedures used in this file.
 */

static void		GenerateXEvent _ANSI_ARGS_((HWND hwnd, UINT message,
			    WPARAM wParam, LPARAM lParam));
131
132
133
134
135
136
137












138


139
140
141
142
143
144
145
    if (childClassInitialized != 0) {
	return;
    }
    childClassInitialized = 1;

    tkInstance = hInstance;













    childClass.style = CS_HREDRAW | CS_VREDRAW | CS_CLASSDC;


    childClass.cbClsExtra = 0;
    childClass.cbWndExtra = 0;
    childClass.hInstance = hInstance;
    childClass.hbrBackground = NULL;
    childClass.lpszMenuName = NULL;

    /*







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

>
>







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
    if (childClassInitialized != 0) {
	return;
    }
    childClassInitialized = 1;

    tkInstance = hInstance;

    /*
     * When threads are enabled, we cannot use CLASSDC because
     * threads will then write into the same device context.
     * 
     * This is a hack; we should add a subsystem that manages
     * device context on a per-thread basis.  See also tkWinWm.c,
     * which also initializes a WNDCLASS structure.
     */

#ifdef TCL_THREADS
    childClass.style = CS_HREDRAW | CS_VREDRAW;
#else
    childClass.style = CS_HREDRAW | CS_VREDRAW | CS_CLASSDC;
#endif

    childClass.cbClsExtra = 0;
    childClass.cbWndExtra = 0;
    childClass.hInstance = hInstance;
    childClass.hbrBackground = NULL;
    childClass.lpszMenuName = NULL;

    /*
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247


248
249
250

251
252
253
254
255
256
257
258
 *
 * TkpOpenDisplay --
 *
 *	Create the Display structure and fill it with device
 *	specific information.
 *
 * Results:
 *	Returns a Display structure on success or NULL on failure.
 *
 * Side effects:
 *	Allocates a new Display structure.
 *
 *----------------------------------------------------------------------
 */

TkDisplay *
TkpOpenDisplay(display_name)
    char *display_name;
{
    Screen *screen;
    HDC dc;
    TkWinDrawable *twdPtr;
    Display *display;



    if (winDisplay != NULL) {
	if (strcmp(winDisplay->display->display_name, display_name) == 0) {

	    return winDisplay;
	} else {
	    return NULL;
	}
    }

    display = (Display *) ckalloc(sizeof(Display));
    display->display_name = (char *) ckalloc(strlen(display_name)+1);







|


|












>
>

|
|
>
|







255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
 *
 * TkpOpenDisplay --
 *
 *	Create the Display structure and fill it with device
 *	specific information.
 *
 * Results:
 *	Returns a TkDisplay structure on success or NULL on failure.
 *
 * Side effects:
 *	Allocates a new TkDisplay structure.
 *
 *----------------------------------------------------------------------
 */

TkDisplay *
TkpOpenDisplay(display_name)
    char *display_name;
{
    Screen *screen;
    HDC dc;
    TkWinDrawable *twdPtr;
    Display *display;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (tsdPtr->winDisplay != NULL) {
	if (strcmp(tsdPtr->winDisplay->display->display_name, display_name) 
                == 0) {
	    return tsdPtr->winDisplay;
	} else {
	    return NULL;
	}
    }

    display = (Display *) ckalloc(sizeof(Display));
    display->display_name = (char *) ckalloc(strlen(display_name)+1);
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
    screen->black_pixel = RGB(0, 0, 0);

    display->screens = screen;
    display->nscreens = 1;
    display->default_screen = 0;
    screen->cmap = XCreateColormap(display, None, screen->root_visual,
	    AllocNone);
    winDisplay = (TkDisplay *) ckalloc(sizeof(TkDisplay));
    winDisplay->display = display;
    return winDisplay;
}

/*
 *----------------------------------------------------------------------
 *
 * TkpCloseDisplay --
 *







|
|
|







379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
    screen->black_pixel = RGB(0, 0, 0);

    display->screens = screen;
    display->nscreens = 1;
    display->default_screen = 0;
    screen->cmap = XCreateColormap(display, None, screen->root_visual,
	    AllocNone);
    tsdPtr->winDisplay = (TkDisplay *) ckalloc(sizeof(TkDisplay));
    tsdPtr->winDisplay->display = display;
    return tsdPtr->winDisplay;
}

/*
 *----------------------------------------------------------------------
 *
 * TkpCloseDisplay --
 *
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

void
TkpCloseDisplay(dispPtr)
    TkDisplay *dispPtr;
{
    Display *display = dispPtr->display;
    HWND hwnd;



    if (dispPtr != winDisplay) {
        panic("TkpCloseDisplay: tried to call TkpCloseDisplay on another display");
        return;
    }

    /*
     * Force the clipboard to be rendered if we are the clipboard owner.
     */
    
    if (dispPtr->clipWindow) {
	hwnd = Tk_GetHWND(Tk_WindowId(dispPtr->clipWindow));
	if (GetClipboardOwner() == hwnd) {
	    OpenClipboard(hwnd);
	    EmptyClipboard();
	    TkWinClipboardRender(dispPtr, CF_TEXT);
	    CloseClipboard();
	}
    }

    winDisplay = NULL;

    if (display->display_name != (char *) NULL) {
        ckfree(display->display_name);
    }
    if (display->screens != (Screen *) NULL) {
        if (display->screens->root_visual != NULL) {
            ckfree((char *) display->screens->root_visual);







>
>

|


















|







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

void
TkpCloseDisplay(dispPtr)
    TkDisplay *dispPtr;
{
    Display *display = dispPtr->display;
    HWND hwnd;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (dispPtr != tsdPtr->winDisplay) {
        panic("TkpCloseDisplay: tried to call TkpCloseDisplay on another display");
        return;
    }

    /*
     * Force the clipboard to be rendered if we are the clipboard owner.
     */
    
    if (dispPtr->clipWindow) {
	hwnd = Tk_GetHWND(Tk_WindowId(dispPtr->clipWindow));
	if (GetClipboardOwner() == hwnd) {
	    OpenClipboard(hwnd);
	    EmptyClipboard();
	    TkWinClipboardRender(dispPtr, CF_TEXT);
	    CloseClipboard();
	}
    }

    tsdPtr->winDisplay = NULL;

    if (display->display_name != (char *) NULL) {
        ckfree(display->display_name);
    }
    if (display->screens != (Screen *) NULL) {
        if (display->screens->root_visual != NULL) {
            ckfree((char *) display->screens->root_visual);
587
588
589
590
591
592
593

594
595





596
597
598
599
600
601
602
	case WM_KILLFOCUS:
	case WM_DESTROYCLIPBOARD:
	case WM_CHAR:
	case WM_SYSKEYDOWN:
	case WM_SYSKEYUP:
	case WM_KEYDOWN:
	case WM_KEYUP:

 	    GenerateXEvent(hwnd, message, wParam, lParam);
	    return 1;





    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *







>


>
>
>
>
>







622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
	case WM_KILLFOCUS:
	case WM_DESTROYCLIPBOARD:
	case WM_CHAR:
	case WM_SYSKEYDOWN:
	case WM_SYSKEYUP:
	case WM_KEYDOWN:
	case WM_KEYUP:
	case WM_MOUSEWHEEL:
 	    GenerateXEvent(hwnd, message, wParam, lParam);
	    return 1;
	case WM_MENUCHAR:
	    GenerateXEvent(hwnd, message, wParam, lParam);
	    /* MNC_CLOSE is the only one that looks right.  This is a hack. */
	    *resultPtr = MAKELONG (0, MNC_CLOSE);
	    return 1;
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
688
689
690
691
692
693
694







695
696
697
698
699
700
701

	case WM_DESTROYCLIPBOARD:
	    event.type = SelectionClear;
	    event.xselectionclear.selection =
		Tk_InternAtom((Tk_Window)winPtr, "CLIPBOARD");
	    event.xselectionclear.time = TkpGetMS();
	    break;







	    
	case WM_CHAR:
	case WM_SYSKEYDOWN:
	case WM_SYSKEYUP:
	case WM_KEYDOWN:
	case WM_KEYUP: {
	    unsigned int state = GetState(message, wParam, lParam);







>
>
>
>
>
>
>







729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749

	case WM_DESTROYCLIPBOARD:
	    event.type = SelectionClear;
	    event.xselectionclear.selection =
		Tk_InternAtom((Tk_Window)winPtr, "CLIPBOARD");
	    event.xselectionclear.time = TkpGetMS();
	    break;
	    
	case WM_MOUSEWHEEL:
	    /*
	     * The mouse wheel event is closer to a key event than a
	     * mouse event in that the message is sent to the window
	     * that has focus.
	     */
	    
	case WM_CHAR:
	case WM_SYSKEYDOWN:
	case WM_SYSKEYUP:
	case WM_KEYDOWN:
	case WM_KEYUP: {
	    unsigned int state = GetState(message, wParam, lParam);
730
731
732
733
734
735
736












737
738
739
740
741
742
743
	    event.xbutton.same_screen = True;

	    /*
	     * Now set up event specific fields.
	     */

	    switch (message) {












		case WM_SYSKEYDOWN:
		case WM_KEYDOWN:
		    /*
		     * Check for translated characters in the event queue.
		     * Setting xany.send_event to -1 indicates to the
		     * Windows implementation of XLookupString that this
		     * event was generated by windows and that the Windows







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







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
	    event.xbutton.same_screen = True;

	    /*
	     * Now set up event specific fields.
	     */

	    switch (message) {
		case WM_MOUSEWHEEL:
		    /*
		     * We have invented a new X event type to handle
		     * this event.  It still uses the KeyPress struct.
		     * However, the keycode field has been overloaded
		     * to hold the zDelta of the wheel.
		     */
		    
		    event.type = MouseWheelEvent;
		    event.xany.send_event = -1;
		    event.xkey.keycode = (short) HIWORD(wParam);
		    break;
		case WM_SYSKEYDOWN:
		case WM_KEYDOWN:
		    /*
		     * Check for translated characters in the event queue.
		     * Setting xany.send_event to -1 indicates to the
		     * Windows implementation of XLookupString that this
		     * event was generated by windows and that the Windows
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
		    /*
		     * We don't check for translated characters on keyup
		     * because Tk won't know what to do with them.  Instead, we
		     * wait for the WM_CHAR messages which will follow.
		     */
		    event.type = KeyRelease;
		    event.xkey.keycode = wParam;
		    event.xkey.nchars = 0;
		    break;

		case WM_CHAR:
		    /*
		     * Synthesize both a KeyPress and a KeyRelease.































		     */

		    event.type = KeyPress;
		    event.xany.send_event = -1;
		    event.xkey.keycode = 0;
		    event.xkey.nchars = 1;
		    event.xkey.trans_chars[0] = (char) wParam;











		    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
		    event.type = KeyRelease;
		    break;
	    }
	    break;
	}








|





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





|

>
>
>
>
>
>
>
>
>
>
>







819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
		    /*
		     * We don't check for translated characters on keyup
		     * because Tk won't know what to do with them.  Instead, we
		     * wait for the WM_CHAR messages which will follow.
		     */
		    event.type = KeyRelease;
		    event.xkey.keycode = wParam;
		    event.xkey.nbytes = 0;
		    break;

		case WM_CHAR:
		    /*
		     * Synthesize both a KeyPress and a KeyRelease.
		     * Strings generated by Input Method Editor are handled
		     * in the following manner:
		     * 1. A series of WM_KEYDOWN & WM_KEYUP messages that 
		     *    cause GetTranslatedKey() to be called and return
		     *    immediately because the WM_KEYDOWNs have no 
		     *	  associated WM_CHAR messages -- the IME window is 
		     *	  accumulating the characters and translating them 
		     *    itself.  In the "bind" command, you get an event
		     *	  with a mystery keysym and %A == "" for each 
		     *	  WM_KEYDOWN that actually was meant for the IME.
		     * 2. A WM_KEYDOWN corresponding to the "confirm typing"
		     *    character.  This causes GetTranslatedKey() to be 
		     *	  called.
		     * 3. A WM_IME_NOTIFY message saying that the IME is 
		     *	  done.  A side effect of this message is that 
		     *    GetTranslatedKey() thinks this means that there
		     *	  are no WM_CHAR messages and returns immediately.
		     *    In the "bind" command, you get an another event
		     *	  with a mystery keysym and %A == "".
		     * 4. A sequence of WM_CHAR messages that correspond to 
		     *	  the characters in the IME window.  A bunch of 
		     *    simulated KeyPress/KeyRelease events will be 
		     *    generated, one for each character.  Adjacent 
		     *    WM_CHAR messages may actually specify the high
		     *	  and low bytes of a multi-byte character -- in that
		     *    case the two WM_CHAR messages will be combined into
		     *	  one event.  It is the event-consumer's 
		     *	  responsibility to convert the string returned from
		     *	  XLookupString from system encoding to UTF-8.
		     * 5. And finally we get the WM_KEYUP for the "confirm
		     *    typing" character.
		     */

		    event.type = KeyPress;
		    event.xany.send_event = -1;
		    event.xkey.keycode = 0;
		    event.xkey.nbytes = 1;
		    event.xkey.trans_chars[0] = (char) wParam;

		    if (IsDBCSLeadByte((BYTE) wParam)) {
			MSG msg;

			if ((PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE) != 0)
				&& (msg.message == WM_CHAR)) {
			    GetMessage(&msg, NULL, 0, 0);
			    event.xkey.nbytes = 2;
			    event.xkey.trans_chars[1] = (char) msg.wParam;
			}
		    }
		    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
		    event.type = KeyRelease;
		    break;
	    }
	    break;
	}

870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890

891
892
893
894
895
896
897
898
899









900
901
902



903
904
905
906
907
908
909
 * GetTranslatedKey --
 *
 *	Retrieves WM_CHAR messages that are placed on the system queue
 *	by the TranslateMessage system call and places them in the
 *	given KeyPress event.
 *
 * Results:
 *	Sets the trans_chars and nchars member of the key event.
 *
 * Side effects:
 *	Removes any WM_CHAR messages waiting on the top of the system
 *	event queue.
 *
 *----------------------------------------------------------------------
 */

static void
GetTranslatedKey(xkey)
    XKeyEvent *xkey;
{
    MSG msg;

    
    xkey->nchars = 0;

    while (xkey->nchars < XMaxTransChars
	    && PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
	if (msg.message == WM_CHAR) {
	    xkey->trans_chars[xkey->nchars] = (char) msg.wParam;
	    xkey->nchars++;
	    GetMessage(&msg, NULL, 0, 0);









	    if ((msg.message == WM_CHAR) && (msg.lParam & 0x20000000)) {
		xkey->state = 0;
	    }



	} else {
	    break;
	}
    }
}

/*







|













>

|

|

|
<
<

>
>
>
>
>
>
>
>
>



>
>
>







972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999


1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
 * GetTranslatedKey --
 *
 *	Retrieves WM_CHAR messages that are placed on the system queue
 *	by the TranslateMessage system call and places them in the
 *	given KeyPress event.
 *
 * Results:
 *	Sets the trans_chars and nbytes member of the key event.
 *
 * Side effects:
 *	Removes any WM_CHAR messages waiting on the top of the system
 *	event queue.
 *
 *----------------------------------------------------------------------
 */

static void
GetTranslatedKey(xkey)
    XKeyEvent *xkey;
{
    MSG msg;
    char buf[XMaxTransChars];
    
    xkey->nbytes = 0;

    while ((xkey->nbytes < XMaxTransChars)
	    && PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
	if ((msg.message == WM_CHAR) || (msg.message == WM_SYSCHAR)) {


	    GetMessage(&msg, NULL, 0, 0);

	    /*
	     * If this is a normal character message, we may need to strip
	     * off the Alt modifier (e.g. Alt-digits).  Note that we don't
	     * want to do this for system messages, because those were
	     * presumably generated as an Alt-char sequence (e.g. accelerator
	     * keys).
	     */

	    if ((msg.message == WM_CHAR) && (msg.lParam & 0x20000000)) {
		xkey->state = 0;
	    }
	    buf[xkey->nbytes] = (char) msg.wParam;
	    xkey->trans_chars[xkey->nbytes] = (char) msg.wParam;
	    xkey->nbytes++;
	} else {
	    break;
	}
    }
}

/*

Changes to win/winMain.c.

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
/* 
 * winMain.c --
 *
 *	Main entry point for wish and other Tk-based applications.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.

 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) winMain.c 1.33 96/12/17 12:56:14
 */

#include <tk.h>
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
#include <malloc.h>
#include <locale.h>



/*
 * The following declarations refer to internal Tk routines.  These
 * interfaces are available for use, but are not supported.
 */

EXTERN void		TkConsoleCreate(void);
EXTERN int		TkConsoleInit(Tcl_Interp *interp);

/*
 * Forward declarations for procedures defined later in this file:
 */

static void		setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
static void		WishPanic _ANSI_ARGS_(TCL_VARARGS(char *,format));

#ifdef TK_TEST
EXTERN int		Tktest_Init(Tcl_Interp *interp);
#endif /* TK_TEST */









/*
 *----------------------------------------------------------------------
 *
 * WinMain --
 *
 *	Main entry point from Windows.





|
>




|









>
>





<
<









|


>
>
>
>
>
>
>







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
/* 
 * winMain.c --
 *
 *	Main entry point for wish and other Tk-based applications.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: winMain.c,v 1.1.4.5 1999/03/10 07:13:52 stanton Exp $
 */

#include <tk.h>
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
#include <malloc.h>
#include <locale.h>

#include "tkInt.h"

/*
 * The following declarations refer to internal Tk routines.  These
 * interfaces are available for use, but are not supported.
 */




/*
 * Forward declarations for procedures defined later in this file:
 */

static void		setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
static void		WishPanic _ANSI_ARGS_(TCL_VARARGS(char *,format));

#ifdef TK_TEST
extern int		Tktest_Init(Tcl_Interp *interp);
#endif /* TK_TEST */

#ifdef TCL_TEST
extern int		TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
extern int		Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#endif /* TCL_TEST */

static BOOL consoleRequired = TRUE;


/*
 *----------------------------------------------------------------------
 *
 * WinMain --
 *
 *	Main entry point from Windows.
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
int APIENTRY
WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
    HINSTANCE hInstance;
    HINSTANCE hPrevInstance;
    LPSTR lpszCmdLine;
    int nCmdShow;
{
    char **argv, *p;
    int argc;
    char buffer[MAX_PATH];

    Tcl_SetPanicProc(WishPanic);

    /*
     * Set up the default locale to be standard "C" locale so parsing
     * is performed correctly.
     */

    setlocale(LC_ALL, "C");


    /*
     * Increase the application queue size from default value of 8.
     * At the default value, cross application SendMessage of WM_KILLFOCUS
     * will fail because the handler will not be able to do a PostMessage!
     * This is only needed for Windows 3.x, since NT dynamically expands
     * the queue.
     */

    SetMessageQueue(64);

    /*
     * Create the console channels and install them as the standard
     * channels.  All I/O will be discarded until TkConsoleInit is
     * called to attach the console to a text widget.
     */

    TkConsoleCreate();

    setargv(&argc, &argv);

    /*
     * Replace argv[0] with full pathname of executable, and forward
     * slashes substituted for backslashes.
     */

    GetModuleFileName(NULL, buffer, sizeof(buffer));
    argv[0] = buffer;
    for (p = buffer; *p != '\0'; p++) {
	if (*p == '\\') {
	    *p = '/';
	}
    }

    Tk_Main(argc, argv, Tcl_AppInit);
    return 1;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppInit --
 *
 *	This procedure performs application-specific initialization.
 *	Most applications, especially those that incorporate additional
 *	packages, will have their own version of this procedure.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error
 *	message in interp->result if an error occurs.
 *
 * Side effects:
 *	Depends on the startup script.
 *
 *----------------------------------------------------------------------
 */








|

<









|








>








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

















|







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
int APIENTRY
WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
    HINSTANCE hInstance;
    HINSTANCE hPrevInstance;
    LPSTR lpszCmdLine;
    int nCmdShow;
{
    char **argv;
    int argc;


    Tcl_SetPanicProc(WishPanic);

    /*
     * Set up the default locale to be standard "C" locale so parsing
     * is performed correctly.
     */

    setlocale(LC_ALL, "C");
    setargv(&argc, &argv);

    /*
     * Increase the application queue size from default value of 8.
     * At the default value, cross application SendMessage of WM_KILLFOCUS
     * will fail because the handler will not be able to do a PostMessage!
     * This is only needed for Windows 3.x, since NT dynamically expands
     * the queue.
     */

    SetMessageQueue(64);

    /*
     * Create the console channels and install them as the standard
     * channels.  All I/O will be discarded until TkConsoleInit is
     * called to attach the console to a text widget.
     */


    consoleRequired = TRUE;















    Tk_Main(argc, argv, Tcl_AppInit);
    return 1;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppInit --
 *
 *	This procedure performs application-specific initialization.
 *	Most applications, especially those that incorporate additional
 *	packages, will have their own version of this procedure.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error
 *	message in the interp's result if an error occurs.
 *
 * Side effects:
 *	Depends on the startup script.
 *
 *----------------------------------------------------------------------
 */

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
    Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);

    /*
     * Initialize the console only if we are running as an interactive
     * application.
     */


    if (TkConsoleInit(interp) == TCL_ERROR) {
	goto error;
    }













#ifdef TK_TEST
    if (Tktest_Init(interp) == TCL_ERROR) {
	goto error;
    }
    Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
            (Tcl_PackageInitProc *) NULL);
#endif /* TK_TEST */

    Tcl_SetVar(interp, "tcl_rcFileName", "~/wishrc.tcl", TCL_GLOBAL_ONLY);
    return TCL_OK;

error:
    WishPanic(interp->result);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * WishPanic --







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













|







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
    Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);

    /*
     * Initialize the console only if we are running as an interactive
     * application.
     */

    if (consoleRequired) {
	if (TkConsoleInit(interp) == TCL_ERROR) {
	    goto error;
	}
    }

#ifdef TCL_TEST
    if (Tcltest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
            (Tcl_PackageInitProc *) NULL);
    if (TclObjTest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
#endif /* TCL_TEST */

#ifdef TK_TEST
    if (Tktest_Init(interp) == TCL_ERROR) {
	goto error;
    }
    Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
            (Tcl_PackageInitProc *) NULL);
#endif /* TK_TEST */

    Tcl_SetVar(interp, "tcl_rcFileName", "~/wishrc.tcl", TCL_GLOBAL_ONLY);
    return TCL_OK;

error:
    WishPanic(Tcl_GetStringResult(interp));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * WishPanic --
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
    format = TCL_VARARGS_START(char *,arg1,argList);
    vsprintf(buf, format, argList);

    MessageBeep(MB_ICONEXCLAMATION);
    MessageBox(NULL, buf, "Fatal Error in Wish",
	    MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
#ifdef _MSC_VER
    _asm {
        int 3
    }
#endif
    ExitProcess(1);
}
/*
 *-------------------------------------------------------------------------
 *
 * setargv --







|
<
<







201
202
203
204
205
206
207
208


209
210
211
212
213
214
215
    format = TCL_VARARGS_START(char *,arg1,argList);
    vsprintf(buf, format, argList);

    MessageBeep(MB_ICONEXCLAMATION);
    MessageBox(NULL, buf, "Fatal Error in Wish",
	    MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
#ifdef _MSC_VER
    DebugBreak();


#endif
    ExitProcess(1);
}
/*
 *-------------------------------------------------------------------------
 *
 * setargv --
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
    int *argcPtr;		/* Filled with number of argument strings. */
    char ***argvPtr;		/* Filled with argument strings (malloc'd). */
{
    char *cmdLine, *p, *arg, *argSpace;
    char **argv;
    int argc, size, inquote, copy, slashes;
    
    cmdLine = GetCommandLine();

    /*
     * Precompute an overly pessimistic guess at the number of arguments
     * in the command line by counting non-space spans.
     */

    size = 2;
    for (p = cmdLine; *p != '\0'; p++) {
	if (isspace(*p)) {
	    size++;
	    while (isspace(*p)) {
		p++;
	    }
	    if (*p == '\0') {
		break;
	    }
	}
    }
    argSpace = (char *) ckalloc((unsigned) (size * sizeof(char *) 
	    + strlen(cmdLine) + 1));
    argv = (char **) argSpace;
    argSpace += size * sizeof(char *);
    size--;

    p = cmdLine;
    for (argc = 0; argc < size; argc++) {
	argv[argc] = arg = argSpace;
	while (isspace(*p)) {
	    p++;
	}
	if (*p == '\0') {
	    break;
	}

	inquote = 0;







|








|

|







|
|







|







241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
    int *argcPtr;		/* Filled with number of argument strings. */
    char ***argvPtr;		/* Filled with argument strings (malloc'd). */
{
    char *cmdLine, *p, *arg, *argSpace;
    char **argv;
    int argc, size, inquote, copy, slashes;
    
    cmdLine = GetCommandLine();	/* INTL: BUG */

    /*
     * Precompute an overly pessimistic guess at the number of arguments
     * in the command line by counting non-space spans.
     */

    size = 2;
    for (p = cmdLine; *p != '\0'; p++) {
	if ((*p == ' ') || (*p == '\t')) {	/* INTL: ISO space. */
	    size++;
	    while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
		p++;
	    }
	    if (*p == '\0') {
		break;
	    }
	}
    }
    argSpace = (char *) Tcl_Alloc(
	    (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));
    argv = (char **) argSpace;
    argSpace += size * sizeof(char *);
    size--;

    p = cmdLine;
    for (argc = 0; argc < size; argc++) {
	argv[argc] = arg = argSpace;
	while ((*p == ' ') || (*p == '\t')) {	/* INTL: ISO space. */
	    p++;
	}
	if (*p == '\0') {
	    break;
	}

	inquote = 0;
299
300
301
302
303
304
305
306

307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323



















































            while (slashes) {
		*arg = '\\';
		arg++;
		slashes--;
	    }

	    if ((*p == '\0') || (!inquote && isspace(*p))) {

		break;
	    }
	    if (copy != 0) {
		*arg = *p;
		arg++;
	    }
	    p++;
        }
	*arg = '\0';
	argSpace = arg + 1;
    }
    argv[argc] = NULL;

    *argcPtr = argc;
    *argvPtr = argv;
}


























































|
>

















>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378

            while (slashes) {
		*arg = '\\';
		arg++;
		slashes--;
	    }

	    if ((*p == '\0')
		    || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
		break;
	    }
	    if (copy != 0) {
		*arg = *p;
		arg++;
	    }
	    p++;
        }
	*arg = '\0';
	argSpace = arg + 1;
    }
    argv[argc] = NULL;

    *argcPtr = argc;
    *argvPtr = argv;
}


/*
 *----------------------------------------------------------------------
 *
 * main --
 *
 *	Main entry point from the console.
 *
 * Results:
 *	None: Tk_Main never returns here, so this procedure never
 *      returns either.
 *
 * Side effects:
 *	Whatever the applications does.
 *
 *----------------------------------------------------------------------
 */

int main(int argc, char **argv)
{
    Tcl_SetPanicProc(WishPanic);

    /*
     * Set up the default locale to be standard "C" locale so parsing
     * is performed correctly.
     */

    setlocale(LC_ALL, "C");
    /*
     * Increase the application queue size from default value of 8.
     * At the default value, cross application SendMessage of WM_KILLFOCUS
     * will fail because the handler will not be able to do a PostMessage!
     * This is only needed for Windows 3.x, since NT dynamically expands
     * the queue.
     */

    SetMessageQueue(64);

    /*
     * Create the console channels and install them as the standard
     * channels.  All I/O will be discarded until TkConsoleInit is
     * called to attach the console to a text widget.
     */

    consoleRequired = FALSE;

    Tk_Main(argc, argv, Tcl_AppInit);
    return 0;
}

Changes to xlib/X11/X.h.

55
56
57
58
59
60
61
62




63
64
65
66
67
68
69

typedef unsigned long Atom;

typedef unsigned long VisualID;

typedef unsigned long Time;

typedef unsigned short KeyCode;





/*****************************************************************
 * RESERVED RESOURCE AND CONSTANT DEFINITIONS
 *****************************************************************/

#define None                 0L	/* universal null resource or null atom */








|
>
>
>
>







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73

typedef unsigned long Atom;

typedef unsigned long VisualID;

typedef unsigned long Time;

typedef unsigned long KeyCode;	/* In order to use IME, the Macintosh needs
				 * to pack 3 bytes into the keyCode field in
				 * the XEvent.  In the real X.h, a KeyCode is
				 * defined as a short, which wouldn't be big
				 * enough. */

/*****************************************************************
 * RESERVED RESOURCE AND CONSTANT DEFINITIONS
 *****************************************************************/

#define None                 0L	/* universal null resource or null atom */

Changes to xlib/X11/Xlib.h.

542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
	int x, y;		/* pointer x, y coordinates in event window */
	int x_root, y_root;	/* coordinates relative to root */
	unsigned int state;	/* key or button mask */
	unsigned int keycode;	/* detail */
	Bool same_screen;	/* same screen flag */
        char trans_chars[XMaxTransChars];
				/* translated characters */
	int nchars;
} XKeyEvent;
typedef XKeyEvent XKeyPressedEvent;
typedef XKeyEvent XKeyReleasedEvent;

typedef struct {
	int type;		/* of event */
	unsigned long serial;	/* # of last request processed by server */







|







542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
	int x, y;		/* pointer x, y coordinates in event window */
	int x_root, y_root;	/* coordinates relative to root */
	unsigned int state;	/* key or button mask */
	unsigned int keycode;	/* detail */
	Bool same_screen;	/* same screen flag */
        char trans_chars[XMaxTransChars];
				/* translated characters */
	int nbytes;
} XKeyEvent;
typedef XKeyEvent XKeyPressedEvent;
typedef XKeyEvent XKeyReleasedEvent;

typedef struct {
	int type;		/* of event */
	unsigned long serial;	/* # of last request processed by server */
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
    XIMStatusDataType type;
    union {
	XIMText *text;
	Pixmap  bitmap;
    } data;
} XIMStatusDrawCallbackStruct;

_XFUNCPROTOBEGIN

extern XFontStruct *XLoadQueryFont(
#if NeedFunctionPrototypes
    Display*		/* display */,
    _Xconst char*	/* name */
#endif
);

extern XFontStruct *XQueryFont(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XID			/* font_ID */
#endif
);


extern XTimeCoord *XGetMotionEvents(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Time		/* start */,
    Time		/* stop */,
    int*		/* nevents_return */
#endif
);

extern XModifierKeymap *XDeleteModifiermapEntry(
#if NeedFunctionPrototypes
    XModifierKeymap*	/* modmap */,
#if NeedWidePrototypes
    unsigned int	/* keycode_entry */,
#else
    KeyCode		/* keycode_entry */,
#endif
    int			/* modifier */
#endif
);

extern XModifierKeymap	*XGetModifierMapping(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern XModifierKeymap	*XInsertModifiermapEntry(
#if NeedFunctionPrototypes
    XModifierKeymap*	/* modmap */,
#if NeedWidePrototypes
    unsigned int	/* keycode_entry */,
#else
    KeyCode		/* keycode_entry */,
#endif
    int			/* modifier */    
#endif
);

extern XModifierKeymap *XNewModifiermap(
#if NeedFunctionPrototypes
    int			/* max_keys_per_mod */
#endif
);

extern XImage *XCreateImage(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Visual*		/* visual */,
    unsigned int	/* depth */,
    int			/* format */,
    int			/* offset */,
    char*		/* data */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    int			/* bitmap_pad */,
    int			/* bytes_per_line */
#endif
);
extern XImage *XGetImage(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    int			/* x */,
    int			/* y */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    unsigned long	/* plane_mask */,
    int			/* format */
#endif
);
extern XImage *XGetSubImage(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    int			/* x */,
    int			/* y */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    unsigned long	/* plane_mask */,
    int			/* format */,
    XImage*		/* dest_image */,
    int			/* dest_x */,
    int			/* dest_y */
#endif
);

/* 
 * X function declarations.
 */
extern Display *XOpenDisplay(
#if NeedFunctionPrototypes
    _Xconst char*	/* display_name */
#endif
);

extern void XrmInitialize(
#if NeedFunctionPrototypes
    void
#endif
);

extern char *XFetchBytes(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int*		/* nbytes_return */
#endif
);
extern char *XFetchBuffer(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int*		/* nbytes_return */,
    int			/* buffer */
#endif
);
extern char *XGetAtomName(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Atom		/* atom */
#endif
);
extern char *XGetDefault(
#if NeedFunctionPrototypes
    Display*		/* display */,
    _Xconst char*	/* program */,
    _Xconst char*	/* option */		  
#endif
);
extern char *XDisplayName(
#if NeedFunctionPrototypes
    _Xconst char*	/* string */
#endif
);
extern char *XKeysymToString(
#if NeedFunctionPrototypes
    KeySym		/* keysym */
#endif
);

extern int (*XSynchronize(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Bool		/* onoff */
#endif
))();
extern int (*XSetAfterFunction(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int (*) (
#if NeedNestedPrototypes
	     Display*	/* display */
#endif
            )		/* procedure */
#endif
))();
extern Atom XInternAtom(
#if NeedFunctionPrototypes
    Display*		/* display */,
    _Xconst char*	/* atom_name */,
    Bool		/* only_if_exists */		 
#endif
);
extern Colormap XCopyColormapAndFree(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */
#endif
);
extern Colormap XCreateColormap(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Visual*		/* visual */,
    int			/* alloc */			 
#endif
);
extern Cursor XCreatePixmapCursor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Pixmap		/* source */,
    Pixmap		/* mask */,
    XColor*		/* foreground_color */,
    XColor*		/* background_color */,
    unsigned int	/* x */,
    unsigned int	/* y */			   
#endif
);
extern Cursor XCreateGlyphCursor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Font		/* source_font */,
    Font		/* mask_font */,
    unsigned int	/* source_char */,
    unsigned int	/* mask_char */,
    XColor*		/* foreground_color */,
    XColor*		/* background_color */
#endif
);
extern Cursor XCreateFontCursor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    unsigned int	/* shape */
#endif
);
extern Font XLoadFont(
#if NeedFunctionPrototypes
    Display*		/* display */,
    _Xconst char*	/* name */
#endif
);
extern GC XCreateGC(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    unsigned long	/* valuemask */,
    XGCValues*		/* values */
#endif
);
extern GContext XGContextFromGC(
#if NeedFunctionPrototypes
    GC			/* gc */
#endif
);
extern void XFlushGC(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */
#endif
);
extern Pixmap XCreatePixmap(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    unsigned int	/* depth */		        
#endif
);
extern Pixmap XCreateBitmapFromData(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    _Xconst char*	/* data */,
    unsigned int	/* width */,
    unsigned int	/* height */
#endif
);
extern Pixmap XCreatePixmapFromBitmapData(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    char*		/* data */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    unsigned long	/* fg */,
    unsigned long	/* bg */,
    unsigned int	/* depth */
#endif
);
extern Window XCreateSimpleWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* parent */,
    int			/* x */,
    int			/* y */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    unsigned int	/* border_width */,
    unsigned long	/* border */,
    unsigned long	/* background */
#endif
);
extern Window XGetSelectionOwner(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Atom		/* selection */
#endif
);
extern Window XCreateWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* parent */,
    int			/* x */,
    int			/* y */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    unsigned int	/* border_width */,
    int			/* depth */,
    unsigned int	/* class */,
    Visual*		/* visual */,
    unsigned long	/* valuemask */,
    XSetWindowAttributes*	/* attributes */
#endif
); 
extern Colormap *XListInstalledColormaps(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    int*		/* num_return */
#endif
);
extern char **XListFonts(
#if NeedFunctionPrototypes
    Display*		/* display */,
    _Xconst char*	/* pattern */,
    int			/* maxnames */,
    int*		/* actual_count_return */
#endif
);
extern char **XListFontsWithInfo(
#if NeedFunctionPrototypes
    Display*		/* display */,
    _Xconst char*	/* pattern */,
    int			/* maxnames */,
    int*		/* count_return */,
    XFontStruct**	/* info_return */
#endif
);
extern char **XGetFontPath(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int*		/* npaths_return */
#endif
);
extern char **XListExtensions(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int*		/* nextensions_return */
#endif
);
extern Atom *XListProperties(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    int*		/* num_prop_return */
#endif
);
extern XHostAddress *XListHosts(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int*		/* nhosts_return */,
    Bool*		/* state_return */
#endif
);
extern KeySym XKeycodeToKeysym(
#if NeedFunctionPrototypes
    Display*		/* display */,
#if NeedWidePrototypes
    unsigned int	/* keycode */,
#else
    KeyCode		/* keycode */,
#endif
    int			/* index */
#endif
);
extern KeySym XLookupKeysym(
#if NeedFunctionPrototypes
    XKeyEvent*		/* key_event */,
    int			/* index */
#endif
);
extern KeySym *XGetKeyboardMapping(
#if NeedFunctionPrototypes
    Display*		/* display */,
#if NeedWidePrototypes
    unsigned int	/* first_keycode */,
#else
    KeyCode		/* first_keycode */,
#endif
    int			/* keycode_count */,
    int*		/* keysyms_per_keycode_return */
#endif
);
extern KeySym XStringToKeysym(
#if NeedFunctionPrototypes
    _Xconst char*	/* string */
#endif
);
extern long XMaxRequestSize(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);
extern long XExtendedMaxRequestSize(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);
extern char *XResourceManagerString(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);
extern char *XScreenResourceString(
#if NeedFunctionPrototypes
	Screen*		/* screen */
#endif
);
extern unsigned long XDisplayMotionBufferSize(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);
extern VisualID XVisualIDFromVisual(
#if NeedFunctionPrototypes
    Visual*		/* visual */
#endif
);

/* routines for dealing with extensions */

extern XExtCodes *XInitExtension(
#if NeedFunctionPrototypes
    Display*		/* display */,
    _Xconst char*	/* name */
#endif
);

extern XExtCodes *XAddExtension(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);
extern XExtData *XFindOnExtensionList(
#if NeedFunctionPrototypes
    XExtData**		/* structure */,
    int			/* number */
#endif
);
extern XExtData **XEHeadOfExtensionList(
#if NeedFunctionPrototypes
    XEDataObject	/* object */
#endif
);

/* these are routines for which there are also macros */
extern Window XRootWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */
#endif
);
extern Window XDefaultRootWindow(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);
extern Window XRootWindowOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);
extern Visual *XDefaultVisual(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */
#endif
);
extern Visual *XDefaultVisualOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);
extern GC XDefaultGC(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */
#endif
);
extern GC XDefaultGCOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);
extern unsigned long XBlackPixel(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */
#endif
);
extern unsigned long XWhitePixel(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */
#endif
);
extern unsigned long XAllPlanes(
#if NeedFunctionPrototypes
    void
#endif
);
extern unsigned long XBlackPixelOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);
extern unsigned long XWhitePixelOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);
extern unsigned long XNextRequest(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);
extern unsigned long XLastKnownRequestProcessed(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);
extern char *XServerVendor(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);
extern char *XDisplayString(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);
extern Colormap XDefaultColormap(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */
#endif
);
extern Colormap XDefaultColormapOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);
extern Display *XDisplayOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);
extern Screen *XScreenOfDisplay(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */
#endif
);
extern Screen *XDefaultScreenOfDisplay(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);
extern long XEventMaskOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);

extern int XScreenNumberOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);

typedef int (*XErrorHandler) (	    /* WARNING, this type not in Xlib spec */
#if NeedFunctionPrototypes
    Display*		/* display */,
    XErrorEvent*	/* error_event */
#endif
);

extern XErrorHandler XSetErrorHandler (
#if NeedFunctionPrototypes
    XErrorHandler	/* handler */
#endif
);


typedef int (*XIOErrorHandler) (    /* WARNING, this type not in Xlib spec */
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern XIOErrorHandler XSetIOErrorHandler (
#if NeedFunctionPrototypes
    XIOErrorHandler	/* handler */
#endif
);


extern XPixmapFormatValues *XListPixmapFormats(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int*		/* count_return */
#endif
);
extern int *XListDepths(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */,
    int*		/* count_return */
#endif
);

/* ICCCM routines for things that don't require special include files; */
/* other declarations are given in Xutil.h                             */
extern Status XReconfigureWMWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    int			/* screen_number */,
    unsigned int	/* mask */,
    XWindowChanges*	/* changes */
#endif
);

extern Status XGetWMProtocols(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Atom**		/* protocols_return */,
    int*		/* count_return */
#endif
);
extern Status XSetWMProtocols(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Atom*		/* protocols */,
    int			/* count */
#endif
);
extern Status XIconifyWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    int			/* screen_number */
#endif
);
extern Status XWithdrawWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    int			/* screen_number */
#endif
);
extern Status XGetCommand(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    char***		/* argv_return */,
    int*		/* argc_return */
#endif
);
extern Status XGetWMColormapWindows(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Window**		/* windows_return */,
    int*		/* count_return */
#endif
);
extern Status XSetWMColormapWindows(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Window*		/* colormap_windows */,
    int			/* count */
#endif
);
extern void XFreeStringList(
#if NeedFunctionPrototypes
    char**		/* list */
#endif
);
extern void XSetTransientForHint(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Window		/* prop_window */
#endif
);

/* The following are given in alphabetical order */

extern void XActivateScreenSaver(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern void XAddHost(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XHostAddress*	/* host */
#endif
);

extern void XAddHosts(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XHostAddress*	/* hosts */,
    int			/* num_hosts */    
#endif
);

extern void XAddToExtensionList(
#if NeedFunctionPrototypes
    struct _XExtData**	/* structure */,
    XExtData*		/* ext_data */
#endif
);

extern void XAddToSaveSet(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern Status XAllocColor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */,
    XColor*		/* screen_in_out */
#endif
);

extern Status XAllocColorCells(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */,
    Bool	        /* contig */,
    unsigned long*	/* plane_masks_return */,
    unsigned int	/* nplanes */,
    unsigned long*	/* pixels_return */,
    unsigned int 	/* npixels */
#endif
);

extern Status XAllocColorPlanes(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */,
    Bool		/* contig */,
    unsigned long*	/* pixels_return */,
    int			/* ncolors */,
    int			/* nreds */,
    int			/* ngreens */,
    int			/* nblues */,
    unsigned long*	/* rmask_return */,
    unsigned long*	/* gmask_return */,
    unsigned long*	/* bmask_return */
#endif
);

extern Status XAllocNamedColor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */,
    _Xconst char*	/* color_name */,
    XColor*		/* screen_def_return */,
    XColor*		/* exact_def_return */
#endif
);

extern void XAllowEvents(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* event_mode */,
    Time		/* time */
#endif
);

extern void XAutoRepeatOff(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern void XAutoRepeatOn(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern void XBell(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* percent */
#endif
);

extern int XBitmapBitOrder(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern int XBitmapPad(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern int XBitmapUnit(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern int XCellsOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);

extern void XChangeActivePointerGrab(
#if NeedFunctionPrototypes
    Display*		/* display */,
    unsigned int	/* event_mask */,
    Cursor		/* cursor */,
    Time		/* time */
#endif
);

extern void XChangeGC(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    unsigned long	/* valuemask */,
    XGCValues*		/* values */
#endif
);

extern void XChangeKeyboardControl(
#if NeedFunctionPrototypes
    Display*		/* display */,
    unsigned long	/* value_mask */,
    XKeyboardControl*	/* values */
#endif
);

extern void XChangeKeyboardMapping(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* first_keycode */,
    int			/* keysyms_per_keycode */,
    KeySym*		/* keysyms */,
    int			/* num_codes */
#endif
);

extern void XChangePointerControl(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Bool		/* do_accel */,
    Bool		/* do_threshold */,
    int			/* accel_numerator */,
    int			/* accel_denominator */,
    int			/* threshold */
#endif
);

extern void XChangeProperty(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Atom		/* property */,
    Atom		/* type */,
    int			/* format */,
    int			/* mode */,
    _Xconst unsigned char*	/* data */,
    int			/* nelements */
#endif
);

extern void XChangeSaveSet(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    int			/* change_mode */
#endif
);

extern void XChangeWindowAttributes(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    unsigned long	/* valuemask */,
    XSetWindowAttributes* /* attributes */
#endif
);

extern Bool XCheckIfEvent(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XEvent*		/* event_return */,
    Bool (*) (
#if NeedNestedPrototypes
	       Display*			/* display */,
               XEvent*			/* event */,
               XPointer			/* arg */
#endif
             )		/* predicate */,
    XPointer		/* arg */
#endif
);

extern Bool XCheckMaskEvent(
#if NeedFunctionPrototypes
    Display*		/* display */,
    long		/* event_mask */,
    XEvent*		/* event_return */
#endif
);

extern Bool XCheckTypedEvent(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* event_type */,
    XEvent*		/* event_return */
#endif
);

extern Bool XCheckTypedWindowEvent(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    int			/* event_type */,
    XEvent*		/* event_return */
#endif
);

extern Bool XCheckWindowEvent(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    long		/* event_mask */,
    XEvent*		/* event_return */
#endif
);

extern void XCirculateSubwindows(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    int			/* direction */
#endif
);

extern void XCirculateSubwindowsDown(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern void XCirculateSubwindowsUp(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern void XClearArea(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    int			/* x */,
    int			/* y */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    Bool		/* exposures */
#endif
);

extern void XClearWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern void XCloseDisplay(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern void XConfigureWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    unsigned int	/* value_mask */,
    XWindowChanges*	/* values */		 
#endif
);

extern int XConnectionNumber(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern void XConvertSelection(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Atom		/* selection */,
    Atom 		/* target */,
    Atom		/* property */,
    Window		/* requestor */,
    Time		/* time */
#endif
);

extern void XCopyArea(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* src */,
    Drawable		/* dest */,
    GC			/* gc */,
    int			/* src_x */,
    int			/* src_y */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    int			/* dest_x */,
    int			/* dest_y */
#endif
);

extern void XCopyGC(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* src */,
    unsigned long	/* valuemask */,
    GC			/* dest */
#endif
);

extern void XCopyPlane(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* src */,
    Drawable		/* dest */,
    GC			/* gc */,
    int			/* src_x */,
    int			/* src_y */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    int			/* dest_x */,
    int			/* dest_y */,
    unsigned long	/* plane */
#endif
);

extern int XDefaultDepth(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */
#endif
);

extern int XDefaultDepthOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);

extern int XDefaultScreen(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern void XDefineCursor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Cursor		/* cursor */
#endif
);

extern void XDeleteProperty(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Atom		/* property */
#endif
);

extern void XDestroyWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern void XDestroySubwindows(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern int XDoesBackingStore(
#if NeedFunctionPrototypes
    Screen*		/* screen */    
#endif
);

extern Bool XDoesSaveUnders(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);

extern void XDisableAccessControl(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);


extern int XDisplayCells(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */
#endif
);

extern int XDisplayHeight(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */
#endif
);

extern int XDisplayHeightMM(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */
#endif
);

extern void XDisplayKeycodes(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int*		/* min_keycodes_return */,
    int*		/* max_keycodes_return */
#endif
);

extern int XDisplayPlanes(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */
#endif
);

extern int XDisplayWidth(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */
#endif
);

extern int XDisplayWidthMM(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen_number */
#endif
);

extern void XDrawArc(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    int			/* angle1 */,
    int			/* angle2 */
#endif
);

extern void XDrawArcs(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    XArc*		/* arcs */,
    int			/* narcs */
#endif
);

extern void XDrawImageString(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    _Xconst char*	/* string */,
    int			/* length */
#endif
);

extern void XDrawImageString16(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    _Xconst XChar2b*	/* string */,
    int			/* length */
#endif
);

extern void XDrawLine(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x1 */,
    int			/* y1 */,
    int			/* x2 */,
    int			/* y2 */
#endif
);

extern void XDrawLines(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    XPoint*		/* points */,
    int			/* npoints */,
    int			/* mode */
#endif
);

extern void XDrawPoint(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */
#endif
);

extern void XDrawPoints(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    XPoint*		/* points */,
    int			/* npoints */,
    int			/* mode */
#endif
);

extern void XDrawRectangle(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    unsigned int	/* width */,
    unsigned int	/* height */
#endif
);

extern void XDrawRectangles(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    XRectangle*		/* rectangles */,
    int			/* nrectangles */
#endif
);

extern void XDrawSegments(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    XSegment*		/* segments */,
    int			/* nsegments */
#endif
);

extern void XDrawString(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    _Xconst char*	/* string */,
    int			/* length */
#endif
);

extern void XDrawString16(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    _Xconst XChar2b*	/* string */,
    int			/* length */
#endif
);

extern void XDrawText(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    XTextItem*		/* items */,
    int			/* nitems */
#endif
);

extern void XDrawText16(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    XTextItem16*	/* items */,
    int			/* nitems */
#endif
);

extern void XEnableAccessControl(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern int XEventsQueued(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* mode */
#endif
);

extern Status XFetchName(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    char**		/* window_name_return */
#endif
);

extern void XFillArc(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    int			/* angle1 */,
    int			/* angle2 */
#endif
);

extern void XFillArcs(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    XArc*		/* arcs */,
    int			/* narcs */
#endif
);

extern void XFillPolygon(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    XPoint*		/* points */,
    int			/* npoints */,
    int			/* shape */,
    int			/* mode */
#endif
);

extern void XFillRectangle(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    unsigned int	/* width */,
    unsigned int	/* height */
#endif
);

extern void XFillRectangles(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    XRectangle*		/* rectangles */,
    int			/* nrectangles */
#endif
);

extern void XFlush(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern void XForceScreenSaver(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* mode */
#endif
);

extern void XFree(
#if NeedFunctionPrototypes
    void*		/* data */
#endif
);

extern void XFreeColormap(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */
#endif
);

extern void XFreeColors(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */,
    unsigned long*	/* pixels */,
    int			/* npixels */,
    unsigned long	/* planes */
#endif
);

extern void XFreeCursor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Cursor		/* cursor */
#endif
);

extern void XFreeExtensionList(
#if NeedFunctionPrototypes
    char**		/* list */    
#endif
);

extern void XFreeFont(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XFontStruct*	/* font_struct */
#endif
);

extern void XFreeFontInfo(
#if NeedFunctionPrototypes
    char**		/* names */,
    XFontStruct*	/* free_info */,
    int			/* actual_count */
#endif
);

extern void XFreeFontNames(
#if NeedFunctionPrototypes
    char**		/* list */
#endif
);

extern void XFreeFontPath(
#if NeedFunctionPrototypes
    char**		/* list */
#endif
);

extern void XFreeGC(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */
#endif
);

extern void XFreeModifiermap(
#if NeedFunctionPrototypes
    XModifierKeymap*	/* modmap */
#endif
);

extern void XFreePixmap(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Pixmap		/* pixmap */
#endif
);

extern int XGeometry(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* screen */,
    _Xconst char*	/* position */,
    _Xconst char*	/* default_position */,
    unsigned int	/* bwidth */,
    unsigned int	/* fwidth */,
    unsigned int	/* fheight */,
    int			/* xadder */,
    int			/* yadder */,
    int*		/* x_return */,
    int*		/* y_return */,
    int*		/* width_return */,
    int*		/* height_return */
#endif
);

extern void XGetErrorDatabaseText(
#if NeedFunctionPrototypes
    Display*		/* display */,
    _Xconst char*	/* name */,
    _Xconst char*	/* message */,
    _Xconst char*	/* default_string */,
    char*		/* buffer_return */,
    int			/* length */
#endif
);

extern void XGetErrorText(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* code */,
    char*		/* buffer_return */,
    int			/* length */
#endif
);

extern Bool XGetFontProperty(
#if NeedFunctionPrototypes
    XFontStruct*	/* font_struct */,
    Atom		/* atom */,
    unsigned long*	/* value_return */
#endif
);

extern Status XGetGCValues(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    unsigned long	/* valuemask */,
    XGCValues*		/* values_return */
#endif
);

extern Status XGetGeometry(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    Window*		/* root_return */,
    int*		/* x_return */,
    int*		/* y_return */,
    unsigned int*	/* width_return */,
    unsigned int*	/* height_return */,
    unsigned int*	/* border_width_return */,
    unsigned int*	/* depth_return */
#endif
);

extern Status XGetIconName(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    char**		/* icon_name_return */
#endif
);

extern void XGetInputFocus(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window*		/* focus_return */,
    int*		/* revert_to_return */
#endif
);

extern void XGetKeyboardControl(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XKeyboardState*	/* values_return */
#endif
);

extern void XGetPointerControl(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int*		/* accel_numerator_return */,
    int*		/* accel_denominator_return */,
    int*		/* threshold_return */
#endif
);

extern int XGetPointerMapping(
#if NeedFunctionPrototypes
    Display*		/* display */,
    unsigned char*	/* map_return */,
    int			/* nmap */
#endif
);

extern void XGetScreenSaver(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int*		/* timeout_return */,
    int*		/* interval_return */,
    int*		/* prefer_blanking_return */,
    int*		/* allow_exposures_return */
#endif
);

extern Status XGetTransientForHint(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Window*		/* prop_window_return */
#endif
);

extern int XGetWindowProperty(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Atom		/* property */,
    long		/* long_offset */,
    long		/* long_length */,
    Bool		/* delete */,
    Atom		/* req_type */,
    Atom*		/* actual_type_return */,
    int*		/* actual_format_return */,
    unsigned long*	/* nitems_return */,
    unsigned long*	/* bytes_after_return */,
    unsigned char**	/* prop_return */
#endif
);

extern Status XGetWindowAttributes(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    XWindowAttributes*	/* window_attributes_return */
#endif
);

extern void XGrabButton(
#if NeedFunctionPrototypes
    Display*		/* display */,
    unsigned int	/* button */,
    unsigned int	/* modifiers */,
    Window		/* grab_window */,
    Bool		/* owner_events */,
    unsigned int	/* event_mask */,
    int			/* pointer_mode */,
    int			/* keyboard_mode */,
    Window		/* confine_to */,
    Cursor		/* cursor */
#endif
);

extern void XGrabKey(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* keycode */,
    unsigned int	/* modifiers */,
    Window		/* grab_window */,
    Bool		/* owner_events */,
    int			/* pointer_mode */,
    int			/* keyboard_mode */
#endif
);

extern int XGrabKeyboard(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* grab_window */,
    Bool		/* owner_events */,
    int			/* pointer_mode */,
    int			/* keyboard_mode */,
    Time		/* time */
#endif
);

extern int XGrabPointer(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* grab_window */,
    Bool		/* owner_events */,
    unsigned int	/* event_mask */,
    int			/* pointer_mode */,
    int			/* keyboard_mode */,
    Window		/* confine_to */,
    Cursor		/* cursor */,
    Time		/* time */
#endif
);

extern void XGrabServer(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern int XHeightMMOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);

extern int XHeightOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);

extern void XIfEvent(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XEvent*		/* event_return */,
    Bool (*) (
#if NeedNestedPrototypes
	       Display*			/* display */,
               XEvent*			/* event */,
               XPointer			/* arg */
#endif
             )		/* predicate */,
    XPointer		/* arg */
#endif
);

extern int XImageByteOrder(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern void XInstallColormap(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */
#endif
);

extern KeyCode XKeysymToKeycode(
#if NeedFunctionPrototypes
    Display*		/* display */,
    KeySym		/* keysym */
#endif
);

extern void XKillClient(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XID			/* resource */
#endif
);

extern unsigned long XLastKnownRequestProcessed(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern Status XLookupColor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */,
    _Xconst char*	/* color_name */,
    XColor*		/* exact_def_return */,
    XColor*		/* screen_def_return */
#endif
);

extern void XLowerWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern void XMapRaised(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern void XMapSubwindows(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern void XMapWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern void XMaskEvent(
#if NeedFunctionPrototypes
    Display*		/* display */,
    long		/* event_mask */,
    XEvent*		/* event_return */
#endif
);

extern int XMaxCmapsOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);

extern int XMinCmapsOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);

extern void XMoveResizeWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    int			/* x */,
    int			/* y */,
    unsigned int	/* width */,
    unsigned int	/* height */
#endif
);

extern void XMoveWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    int			/* x */,
    int			/* y */
#endif
);

extern void XNextEvent(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XEvent*		/* event_return */
#endif
);

extern void XNoOp(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern Status XParseColor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */,
    _Xconst char*	/* spec */,
    XColor*		/* exact_def_return */
#endif
);

extern int XParseGeometry(
#if NeedFunctionPrototypes
    _Xconst char*	/* parsestring */,
    int*		/* x_return */,
    int*		/* y_return */,
    unsigned int*	/* width_return */,
    unsigned int*	/* height_return */
#endif
);

extern void XPeekEvent(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XEvent*		/* event_return */
#endif
);

extern void XPeekIfEvent(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XEvent*		/* event_return */,
    Bool (*) (
#if NeedNestedPrototypes
	       Display*		/* display */,
               XEvent*		/* event */,
               XPointer		/* arg */
#endif
             )		/* predicate */,
    XPointer		/* arg */
#endif
);

extern int XPending(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern int XPlanesOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
    
#endif
);

extern int XProtocolRevision(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern int XProtocolVersion(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);


extern void XPutBackEvent(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XEvent*		/* event */
#endif
);

extern void XPutImage(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    XImage*		/* image */,
    int			/* src_x */,
    int			/* src_y */,
    int			/* dest_x */,
    int			/* dest_y */,
    unsigned int	/* width */,
    unsigned int	/* height */	  
#endif
);

extern int XQLength(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern Status XQueryBestCursor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    unsigned int        /* width */,
    unsigned int	/* height */,
    unsigned int*	/* width_return */,
    unsigned int*	/* height_return */
#endif
);

extern Status XQueryBestSize(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* class */,
    Drawable		/* which_screen */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    unsigned int*	/* width_return */,
    unsigned int*	/* height_return */
#endif
);

extern Status XQueryBestStipple(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* which_screen */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    unsigned int*	/* width_return */,
    unsigned int*	/* height_return */
#endif
);

extern Status XQueryBestTile(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* which_screen */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    unsigned int*	/* width_return */,
    unsigned int*	/* height_return */
#endif
);

extern void XQueryColor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */,
    XColor*		/* def_in_out */
#endif
);

extern void XQueryColors(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */,
    XColor*		/* defs_in_out */,
    int			/* ncolors */
#endif
);

extern Bool XQueryExtension(
#if NeedFunctionPrototypes
    Display*		/* display */,
    _Xconst char*	/* name */,
    int*		/* major_opcode_return */,
    int*		/* first_event_return */,
    int*		/* first_error_return */
#endif
);

extern void XQueryKeymap(
#if NeedFunctionPrototypes
    Display*		/* display */,
    char [32]		/* keys_return */
#endif
);

extern Bool XQueryPointer(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Window*		/* root_return */,
    Window*		/* child_return */,
    int*		/* root_x_return */,
    int*		/* root_y_return */,
    int*		/* win_x_return */,
    int*		/* win_y_return */,
    unsigned int*       /* mask_return */
#endif
);

extern void XQueryTextExtents(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XID			/* font_ID */,
    _Xconst char*	/* string */,
    int			/* nchars */,
    int*		/* direction_return */,
    int*		/* font_ascent_return */,
    int*		/* font_descent_return */,
    XCharStruct*	/* overall_return */    
#endif
);

extern void XQueryTextExtents16(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XID			/* font_ID */,
    _Xconst XChar2b*	/* string */,
    int			/* nchars */,
    int*		/* direction_return */,
    int*		/* font_ascent_return */,
    int*		/* font_descent_return */,
    XCharStruct*	/* overall_return */
#endif
);

extern Status XQueryTree(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Window*		/* root_return */,
    Window*		/* parent_return */,
    Window**		/* children_return */,
    unsigned int*	/* nchildren_return */
#endif
);

extern void XRaiseWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern int XReadBitmapFile(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable 		/* d */,
    _Xconst char*	/* filename */,
    unsigned int*	/* width_return */,
    unsigned int*	/* height_return */,
    Pixmap*		/* bitmap_return */,
    int*		/* x_hot_return */,
    int*		/* y_hot_return */
#endif
);

extern void XRebindKeysym(
#if NeedFunctionPrototypes
    Display*		/* display */,
    KeySym		/* keysym */,
    KeySym*		/* list */,
    int			/* mod_count */,
    _Xconst unsigned char*	/* string */,
    int			/* bytes_string */
#endif
);

extern void XRecolorCursor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Cursor		/* cursor */,
    XColor*		/* foreground_color */,
    XColor*		/* background_color */
#endif
);

extern void XRefreshKeyboardMapping(
#if NeedFunctionPrototypes
    XMappingEvent*	/* event_map */    
#endif
);

extern void XRemoveFromSaveSet(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern void XRemoveHost(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XHostAddress*	/* host */
#endif
);

extern void XRemoveHosts(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XHostAddress*	/* hosts */,
    int			/* num_hosts */
#endif
);

extern void XReparentWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Window		/* parent */,
    int			/* x */,
    int			/* y */
#endif
);

extern void XResetScreenSaver(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern void XResizeWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    unsigned int	/* width */,
    unsigned int	/* height */
#endif
);

extern void XRestackWindows(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window*		/* windows */,
    int			/* nwindows */
#endif
);

extern void XRotateBuffers(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* rotate */
#endif
);

extern void XRotateWindowProperties(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Atom*		/* properties */,
    int			/* num_prop */,
    int			/* npositions */
#endif
);

extern int XScreenCount(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern void XSelectInput(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    long		/* event_mask */
#endif
);

extern Status XSendEvent(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Bool		/* propagate */,
    long		/* event_mask */,
    XEvent*		/* event_send */
#endif
);

extern void XSetAccessControl(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* mode */
#endif
);

extern void XSetArcMode(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    int			/* arc_mode */
#endif
);

extern void XSetBackground(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    unsigned long	/* background */
#endif
);

extern void XSetClipMask(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    Pixmap		/* pixmap */
#endif
);

extern void XSetClipOrigin(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    int			/* clip_x_origin */,
    int			/* clip_y_origin */
#endif
);

extern void XSetClipRectangles(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    int			/* clip_x_origin */,
    int			/* clip_y_origin */,
    XRectangle*		/* rectangles */,
    int			/* n */,
    int			/* ordering */
#endif
);

extern void XSetCloseDownMode(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* close_mode */
#endif
);

extern void XSetCommand(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    char**		/* argv */,
    int			/* argc */
#endif
);

extern void XSetDashes(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    int			/* dash_offset */,
    _Xconst char*	/* dash_list */,
    int			/* n */
#endif
);

extern void XSetFillRule(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    int			/* fill_rule */
#endif
);

extern void XSetFillStyle(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    int			/* fill_style */
#endif
);

extern void XSetFont(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    Font		/* font */
#endif
);

extern void XSetFontPath(
#if NeedFunctionPrototypes
    Display*		/* display */,
    char**		/* directories */,
    int			/* ndirs */	     
#endif
);

extern void XSetForeground(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    unsigned long	/* foreground */
#endif
);

extern void XSetFunction(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    int			/* function */
#endif
);

extern void XSetGraphicsExposures(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    Bool		/* graphics_exposures */
#endif
);

extern void XSetIconName(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    _Xconst char*	/* icon_name */
#endif
);

extern void XSetInputFocus(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* focus */,
    int			/* revert_to */,
    Time		/* time */
#endif
);

extern void XSetLineAttributes(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    unsigned int	/* line_width */,
    int			/* line_style */,
    int			/* cap_style */,
    int			/* join_style */
#endif
);

extern int XSetModifierMapping(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XModifierKeymap*	/* modmap */
#endif
);

extern void XSetPlaneMask(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    unsigned long	/* plane_mask */
#endif
);

extern int XSetPointerMapping(
#if NeedFunctionPrototypes
    Display*		/* display */,
    _Xconst unsigned char*	/* map */,
    int			/* nmap */
#endif
);

extern void XSetScreenSaver(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* timeout */,
    int			/* interval */,
    int			/* prefer_blanking */,
    int			/* allow_exposures */
#endif
);

extern void XSetSelectionOwner(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Atom	        /* selection */,
    Window		/* owner */,
    Time		/* time */
#endif
);

extern void XSetState(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    unsigned long 	/* foreground */,
    unsigned long	/* background */,
    int			/* function */,
    unsigned long	/* plane_mask */
#endif
);

extern void XSetStipple(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    Pixmap		/* stipple */
#endif
);

extern void XSetSubwindowMode(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    int			/* subwindow_mode */
#endif
);

extern void XSetTSOrigin(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    int			/* ts_x_origin */,
    int			/* ts_y_origin */
#endif
);

extern void XSetTile(
#if NeedFunctionPrototypes
    Display*		/* display */,
    GC			/* gc */,
    Pixmap		/* tile */
#endif
);

extern void XSetWindowBackground(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    unsigned long	/* background_pixel */
#endif
);

extern void XSetWindowBackgroundPixmap(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Pixmap		/* background_pixmap */
#endif
);

extern void XSetWindowBorder(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    unsigned long	/* border_pixel */
#endif
);

extern void XSetWindowBorderPixmap(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Pixmap		/* border_pixmap */
#endif
);

extern void XSetWindowBorderWidth(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    unsigned int	/* width */
#endif
);

extern void XSetWindowColormap(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    Colormap		/* colormap */
#endif
);

extern void XStoreBuffer(
#if NeedFunctionPrototypes
    Display*		/* display */,
    _Xconst char*	/* bytes */,
    int			/* nbytes */,
    int			/* buffer */
#endif
);

extern void XStoreBytes(
#if NeedFunctionPrototypes
    Display*		/* display */,
    _Xconst char*	/* bytes */,
    int			/* nbytes */
#endif
);

extern void XStoreColor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */,
    XColor*		/* color */
#endif
);

extern void XStoreColors(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */,
    XColor*		/* color */,
    int			/* ncolors */
#endif
);

extern void XStoreName(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    _Xconst char*	/* window_name */
#endif
);

extern void XStoreNamedColor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */,
    _Xconst char*	/* color */,
    unsigned long	/* pixel */,
    int			/* flags */
#endif
);

extern void XSync(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Bool		/* discard */
#endif
);

extern void XTextExtents(
#if NeedFunctionPrototypes
    XFontStruct*	/* font_struct */,
    _Xconst char*	/* string */,
    int			/* nchars */,
    int*		/* direction_return */,
    int*		/* font_ascent_return */,
    int*		/* font_descent_return */,
    XCharStruct*	/* overall_return */
#endif
);

extern void XTextExtents16(
#if NeedFunctionPrototypes
    XFontStruct*	/* font_struct */,
    _Xconst XChar2b*	/* string */,
    int			/* nchars */,
    int*		/* direction_return */,
    int*		/* font_ascent_return */,
    int*		/* font_descent_return */,
    XCharStruct*	/* overall_return */
#endif
);

extern int XTextWidth(
#if NeedFunctionPrototypes
    XFontStruct*	/* font_struct */,
    _Xconst char*	/* string */,
    int			/* count */
#endif
);

extern int XTextWidth16(
#if NeedFunctionPrototypes
    XFontStruct*	/* font_struct */,
    _Xconst XChar2b*	/* string */,
    int			/* count */
#endif
);

extern Bool XTranslateCoordinates(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* src_w */,
    Window		/* dest_w */,
    int			/* src_x */,
    int			/* src_y */,
    int*		/* dest_x_return */,
    int*		/* dest_y_return */,
    Window*		/* child_return */
#endif
);

extern void XUndefineCursor(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern void XUngrabButton(
#if NeedFunctionPrototypes
    Display*		/* display */,
    unsigned int	/* button */,
    unsigned int	/* modifiers */,
    Window		/* grab_window */
#endif
);

extern void XUngrabKey(
#if NeedFunctionPrototypes
    Display*		/* display */,
    int			/* keycode */,
    unsigned int	/* modifiers */,
    Window		/* grab_window */
#endif
);

extern void XUngrabKeyboard(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Time		/* time */
#endif
);

extern void XUngrabPointer(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Time		/* time */
#endif
);

extern void XUngrabServer(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern void XUninstallColormap(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Colormap		/* colormap */
#endif
);

extern void XUnloadFont(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Font		/* font */
#endif
);

extern void XUnmapSubwindows(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern void XUnmapWindow(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */
#endif
);

extern int XVendorRelease(
#if NeedFunctionPrototypes
    Display*		/* display */
#endif
);

extern void XWarpPointer(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* src_w */,
    Window		/* dest_w */,
    int			/* src_x */,
    int			/* src_y */,
    unsigned int	/* src_width */,
    unsigned int	/* src_height */,
    int			/* dest_x */,
    int			/* dest_y */	     
#endif
);

extern int XWidthMMOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);

extern int XWidthOfScreen(
#if NeedFunctionPrototypes
    Screen*		/* screen */
#endif
);

extern void XWindowEvent(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    long		/* event_mask */,
    XEvent*		/* event_return */
#endif
);

extern int XWriteBitmapFile(
#if NeedFunctionPrototypes
    Display*		/* display */,
    _Xconst char*	/* filename */,
    Pixmap		/* bitmap */,
    unsigned int	/* width */,
    unsigned int	/* height */,
    int			/* x_hot */,
    int			/* y_hot */		     
#endif
);

extern Bool XSupportsLocale(
#if NeedFunctionPrototypes
    void
#endif
);

extern char *XSetLocaleModifiers(
#if NeedFunctionPrototypes
    _Xconst char*	/* modifier_list */
#endif
);

extern XFontSet XCreateFontSet(
#if NeedFunctionPrototypes
    Display*		/* display */,
    _Xconst char*	/* base_font_name_list */,
    char***		/* missing_charset_list */,
    int*		/* missing_charset_count */,
    char**		/* def_string */
#endif
);

extern void XFreeFontSet(
#if NeedFunctionPrototypes
    Display*		/* display */,
    XFontSet		/* font_set */
#endif
);

extern int XFontsOfFontSet(
#if NeedFunctionPrototypes
    XFontSet		/* font_set */,
    XFontStruct***	/* font_struct_list */,
    char***		/* font_name_list */
#endif
);

extern char *XBaseFontNameListOfFontSet(
#if NeedFunctionPrototypes
    XFontSet		/* font_set */
#endif
);

extern char *XLocaleOfFontSet(
#if NeedFunctionPrototypes
    XFontSet		/* font_set */
#endif
);

extern Bool XContextDependentDrawing(
#if NeedFunctionPrototypes
    XFontSet		/* font_set */
#endif
);

extern XFontSetExtents *XExtentsOfFontSet(
#if NeedFunctionPrototypes
    XFontSet		/* font_set */
#endif
);

extern int XmbTextEscapement(
#if NeedFunctionPrototypes
    XFontSet		/* font_set */,
    _Xconst char*	/* text */,
    int			/* bytes_text */
#endif
);

extern int XwcTextEscapement(
#if NeedFunctionPrototypes
    XFontSet		/* font_set */,
    wchar_t*		/* text */,
    int			/* num_wchars */
#endif
);

extern int XmbTextExtents(
#if NeedFunctionPrototypes
    XFontSet		/* font_set */,
    _Xconst char*	/* text */,
    int			/* bytes_text */,
    XRectangle*		/* overall_ink_return */,
    XRectangle*		/* overall_logical_return */
#endif
);

extern int XwcTextExtents(
#if NeedFunctionPrototypes
    XFontSet		/* font_set */,
    wchar_t*		/* text */,
    int			/* num_wchars */,
    XRectangle*		/* overall_ink_return */,
    XRectangle*		/* overall_logical_return */
#endif
);

extern Status XmbTextPerCharExtents(
#if NeedFunctionPrototypes
    XFontSet		/* font_set */,
    _Xconst char*	/* text */,
    int			/* bytes_text */,
    XRectangle*		/* ink_extents_buffer */,
    XRectangle*		/* logical_extents_buffer */,
    int			/* buffer_size */,
    int*		/* num_chars */,
    XRectangle*		/* overall_ink_return */,
    XRectangle*		/* overall_logical_return */
#endif
);

extern Status XwcTextPerCharExtents(
#if NeedFunctionPrototypes
    XFontSet		/* font_set */,
    wchar_t*		/* text */,
    int			/* num_wchars */,
    XRectangle*		/* ink_extents_buffer */,
    XRectangle*		/* logical_extents_buffer */,
    int			/* buffer_size */,
    int*		/* num_chars */,
    XRectangle*		/* overall_ink_return */,
    XRectangle*		/* overall_logical_return */
#endif
);

extern void XmbDrawText(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    XmbTextItem*	/* text_items */,
    int			/* nitems */
#endif
);

extern void XwcDrawText(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    XwcTextItem*	/* text_items */,
    int			/* nitems */
#endif
);

extern void XmbDrawString(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    XFontSet		/* font_set */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    _Xconst char*	/* text */,
    int			/* bytes_text */
#endif
);

extern void XwcDrawString(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    XFontSet		/* font_set */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    wchar_t*		/* text */,
    int			/* num_wchars */
#endif
);

extern void XmbDrawImageString(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    XFontSet		/* font_set */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    _Xconst char*	/* text */,
    int			/* bytes_text */
#endif
);

extern void XwcDrawImageString(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    XFontSet		/* font_set */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    wchar_t*		/* text */,
    int			/* num_wchars */
#endif
);

extern XIM XOpenIM(
#if NeedFunctionPrototypes
    Display*			/* dpy */,
    struct _XrmHashBucketRec*	/* rdb */,
    char*			/* res_name */,
    char*			/* res_class */
#endif
);

extern Status XCloseIM(
#if NeedFunctionPrototypes
    XIM /* im */
#endif
);

extern char *XGetIMValues(
#if NeedVarargsPrototypes
    XIM /* im */, ...
#endif
);

extern Display *XDisplayOfIM(
#if NeedFunctionPrototypes
    XIM /* im */
#endif
);

extern char *XLocaleOfIM(
#if NeedFunctionPrototypes
    XIM /* im*/
#endif
);

extern XIC XCreateIC(
#if NeedVarargsPrototypes
    XIM /* im */, ...
#endif
);

extern void XDestroyIC(
#if NeedFunctionPrototypes
    XIC /* ic */
#endif
);

extern void XSetICFocus(
#if NeedFunctionPrototypes
    XIC /* ic */
#endif
);

extern void XUnsetICFocus(
#if NeedFunctionPrototypes
    XIC /* ic */
#endif
);

extern wchar_t *XwcResetIC(
#if NeedFunctionPrototypes
    XIC /* ic */
#endif
);

extern char *XmbResetIC(
#if NeedFunctionPrototypes
    XIC /* ic */
#endif
);

extern char *XSetICValues(
#if NeedVarargsPrototypes
    XIC /* ic */, ...
#endif
);

extern char *XGetICValues(
#if NeedVarargsPrototypes
    XIC /* ic */, ...
#endif
);

extern XIM XIMOfIC(
#if NeedFunctionPrototypes
    XIC /* ic */
#endif
);

extern Bool XFilterEvent(
#if NeedFunctionPrototypes
    XEvent*	/* event */,
    Window	/* window */
#endif
);

extern int XmbLookupString(
#if NeedFunctionPrototypes
    XIC			/* ic */,
    XKeyPressedEvent*	/* event */,
    char*		/* buffer_return */,
    int			/* bytes_buffer */,
    KeySym*		/* keysym_return */,
    Status*		/* status_return */
#endif
);

extern int XwcLookupString(
#if NeedFunctionPrototypes
    XIC			/* ic */,
    XKeyPressedEvent*	/* event */,
    wchar_t*		/* buffer_return */,
    int			/* wchars_buffer */,
    KeySym*		/* keysym_return */,
    Status*		/* status_return */
#endif
);

extern XVaNestedList XVaCreateNestedList(
#if NeedVarargsPrototypes
    int /*unused*/, ...
#endif
);

_XFUNCPROTOEND

#ifdef MAC_TCL
#   undef Cursor
#   undef Region
#endif

#endif /* _XLIB_H_ */







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







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

<
<
<
<
<
<
<

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













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













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

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









1176
1177
1178
1179
1180
1181
1182


































































































































































































































































































































































































































































































































































































1183
1184
1185
1186
1187
1188
1189





1190












































































































































































































































































































































1191







1192
















































































































































































































































































































1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205








































































































































































1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218

























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































1219






1220

























































































































































































































































































































































































































1221
1222
1223
1224
1225
1226
1227
1228
1229
    XIMStatusDataType type;
    union {
	XIMText *text;
	Pixmap  bitmap;
    } data;
} XIMStatusDrawCallbackStruct;



































































































































































































































































































































































































































































































































































































typedef int (*XErrorHandler) (	    /* WARNING, this type not in Xlib spec */
#if NeedFunctionPrototypes
    Display*		/* display */,
    XErrorEvent*	/* error_event */
#endif
);






_XFUNCPROTOBEGIN






































































































































































































































































































































































































































































































































































































































































extern void XDrawLine(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x1 */,
    int			/* y1 */,
    int			/* x2 */,
    int			/* y2 */
#endif
);










































































































































































extern void XFillRectangle(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Drawable		/* d */,
    GC			/* gc */,
    int			/* x */,
    int			/* y */,
    unsigned int	/* width */,
    unsigned int	/* height */
#endif
);

































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































#include "tkIntXlibDecls.h"


























































































































































































































































































































































































































_XFUNCPROTOEND

#ifdef MAC_TCL
#   undef Cursor
#   undef Region
#endif

#endif /* _XLIB_H_ */

Changes to xlib/X11/Xutil.h.

444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
    Display*		/* display */,
    Window		/* window */,
    XTextProperty*	/* text_prop_return */,
    Atom		/* property */
#endif
);

extern XVisualInfo *XGetVisualInfo(
#if NeedFunctionPrototypes
    Display*		/* display */,
    long		/* vinfo_mask */,
    XVisualInfo*	/* vinfo_template */,
    int*		/* nitems_return */
#endif
);

extern Status XGetWMClientMachine(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    XTextProperty*	/* text_prop_return */
#endif







<
<
<
<
<
<
<
<







444
445
446
447
448
449
450








451
452
453
454
455
456
457
    Display*		/* display */,
    Window		/* window */,
    XTextProperty*	/* text_prop_return */,
    Atom		/* property */
#endif
);










extern Status XGetWMClientMachine(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    XTextProperty*	/* text_prop_return */
#endif
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
    Display*		/* display */,
    Window		/* w */,
    XTextProperty*	/* text_prop */,
    Atom		/* property */
#endif
);

extern void XSetWMClientMachine(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    XTextProperty*	/* text_prop */
#endif
);

extern void XSetWMHints(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    XWMHints*		/* wm_hints */
#endif
);







<
<
<
<
<
<
<
<







640
641
642
643
644
645
646








647
648
649
650
651
652
653
    Display*		/* display */,
    Window		/* w */,
    XTextProperty*	/* text_prop */,
    Atom		/* property */
#endif
);









extern void XSetWMHints(
#if NeedFunctionPrototypes
    Display*		/* display */,
    Window		/* w */,
    XWMHints*		/* wm_hints */
#endif
);
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
#if NeedFunctionPrototypes
    Region		/* r */,
    int			/* dx */,
    int			/* dy */
#endif
);

extern Status XStringListToTextProperty(
#if NeedFunctionPrototypes
    char**		/* list */,
    int			/* count */,
    XTextProperty*	/* text_prop_return */
#endif
);

extern void XSubtractRegion(
#if NeedFunctionPrototypes
    Region		/* sra */,
    Region		/* srb */,
    Region		/* dr_return */
#endif
);







<
<
<
<
<
<
<
<







742
743
744
745
746
747
748








749
750
751
752
753
754
755
#if NeedFunctionPrototypes
    Region		/* r */,
    int			/* dx */,
    int			/* dy */
#endif
);









extern void XSubtractRegion(
#if NeedFunctionPrototypes
    Region		/* sra */,
    Region		/* srb */,
    Region		/* dr_return */
#endif
);

Changes to xlib/X11/keysymdef.h.

80
81
82
83
84
85
86





87
88
89
90
91
92
93
#define XK_Prior		0xFF55	/* Prior, previous */
#define XK_Page_Up		0xFF55
#define XK_Next			0xFF56	/* Next */
#define XK_Page_Down		0xFF56
#define XK_End			0xFF57	/* EOL */
#define XK_Begin		0xFF58	/* BOL */







/* Misc Functions */

#define XK_Select		0xFF60	/* Select, mark */
#define XK_Print		0xFF61
#define XK_Execute		0xFF62	/* Execute, run, do */
#define XK_Insert		0xFF63	/* Insert, insert here */







>
>
>
>
>







80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
#define XK_Prior		0xFF55	/* Prior, previous */
#define XK_Page_Up		0xFF55
#define XK_Next			0xFF56	/* Next */
#define XK_Page_Down		0xFF56
#define XK_End			0xFF57	/* EOL */
#define XK_Begin		0xFF58	/* BOL */

/* Special Windows keyboard keys */

#define XK_Win_L		0xFF5B	/* Left-hand Windows */
#define XK_Win_R		0xFF5C	/* Right-hand Windows */
#define XK_App			0xFF5D	/* Menu key */

/* Misc Functions */

#define XK_Select		0xFF60	/* Select, mark */
#define XK_Print		0xFF61
#define XK_Execute		0xFF62	/* Execute, run, do */
#define XK_Insert		0xFF63	/* Insert, insert here */

Changes to xlib/xbytes.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * xbytes.h --
 *
 *	Declaration of table to reverse bit order of bytes.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) xbytes.h 1.1 95/05/09 17:32:51
 */

#ifndef _XBYTES
#define _XBYTES

/*
 * The bits in a byte can be reversed so the least significant becomes










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * xbytes.h --
 *
 *	Declaration of table to reverse bit order of bytes.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: xbytes.h,v 1.1.4.1 1998/09/30 02:19:43 stanton Exp $
 */

#ifndef _XBYTES
#define _XBYTES

/*
 * The bits in a byte can be reversed so the least significant becomes

Changes to xlib/xcolors.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * xcolors.c --
 *
 *	This file contains the routines used to map from X color
 *	names to RGB and pixel values.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) xcolors.c 1.6 97/09/02 09:41:50
 */

#include <tkInt.h>

/*
 * Define an array that defines the mapping from color names to RGB values.
 * Note that this array must be kept sorted alphabetically so that the











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * xcolors.c --
 *
 *	This file contains the routines used to map from X color
 *	names to RGB and pixel values.
 *
 * Copyright (c) 1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: xcolors.c,v 1.1.4.1 1998/09/30 02:19:43 stanton Exp $
 */

#include <tkInt.h>

/*
 * Define an array that defines the mapping from color names to RGB values.
 * Note that this array must be kept sorted alphabetically so that the

Changes to xlib/xdraw.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * xdraw.c --
 *
 *	This file contains generic procedures related to X drawing
 *	primitives.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) xdraw.c 1.2 96/02/15 18:55:46
 */

#include "tk.h"

/*
 *----------------------------------------------------------------------
 *











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * xdraw.c --
 *
 *	This file contains generic procedures related to X drawing
 *	primitives.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: xdraw.c,v 1.1.4.1 1998/09/30 02:19:44 stanton Exp $
 */

#include "tk.h"

/*
 *----------------------------------------------------------------------
 *

Changes to xlib/xgc.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * xgc.c --
 *
 *	This file contains generic routines for manipulating X graphics
 *	contexts. 
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) xgc.c 1.8 96/10/11 14:59:39
 */

#include <tkInt.h>

#ifdef MAC_TCL
#	include <Xlib.h>
#else











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/* 
 * xgc.c --
 *
 *	This file contains generic routines for manipulating X graphics
 *	contexts. 
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: xgc.c,v 1.1.4.2 1999/04/06 02:48:30 redman Exp $
 */

#include <tkInt.h>

#ifdef MAC_TCL
#	include <Xlib.h>
#else
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
XFreeGC(d, gc)
    Display * d;
    GC gc;
{
    if (gc != None) {
	if (gc->clip_mask != None) {
	    ckfree((char*) gc->clip_mask);
	}







<
|







146
147
148
149
150
151
152

153
154
155
156
157
158
159
160
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */


void XFreeGC(d, gc)
    Display * d;
    GC gc;
{
    if (gc != None) {
	if (gc->clip_mask != None) {
	    ckfree((char*) gc->clip_mask);
	}

Changes to xlib/ximage.c.

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
/* 
 * ximage.c --
 *
 *	X bitmap and image routines.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) ximage.c 1.6 96/07/23 16:59:10
 */

#include "tkInt.h"


/*
 *----------------------------------------------------------------------
 *
 * XCreateBitmapFromData --
 *
 *	Construct a single plane pixmap from bitmap data.





 *
 * Results:
 *	Returns a new Pixmap.
 *
 * Side effects:
 *	Allocates a new bitmap and drawable.
 *










|











>
>
>
>
>







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
/* 
 * ximage.c --
 *
 *	X bitmap and image routines.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: ximage.c,v 1.1.4.1 1998/09/30 02:19:45 stanton Exp $
 */

#include "tkInt.h"


/*
 *----------------------------------------------------------------------
 *
 * XCreateBitmapFromData --
 *
 *	Construct a single plane pixmap from bitmap data.
 *
 *	NOTE: This procedure has the correct behavior on Windows and
 *	the Macintosh, but not on UNIX.  This is probably because the
 *	emulation for XPutImage on those platforms compensates for whatever
 *	is wrong here :-)
 *
 * Results:
 *	Returns a new Pixmap.
 *
 * Side effects:
 *	Allocates a new bitmap and drawable.
 *
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
    ximage.bitmap_pad = 8;
    ximage.bytes_per_line = (width+7)/8;

    TkPutImage(NULL, 0, display, pix, gc, &ximage, 0, 0, 0, 0, width, height);
    XFreeGC(display, gc);
    return pix;
}

/*
 *----------------------------------------------------------------------
 *
 * XReadBitmapFile --
 *
 *	Loads a bitmap image in X bitmap format into the specified
 *	drawable.
 *
 * Results:
 *	Sets the size, hotspot, and bitmap on success.
 *
 * Side effects:
 *	Creates a new bitmap from the file data.
 *
 *----------------------------------------------------------------------
 */

int
XReadBitmapFile(display, d, filename, width_return, height_return,
	bitmap_return, x_hot_return, y_hot_return) 
    Display* display;
    Drawable d;
    _Xconst char* filename;
    unsigned int* width_return;
    unsigned int* height_return;
    Pixmap* bitmap_return;
    int* x_hot_return;
    int* y_hot_return;
{
    Tcl_Interp *dummy;
    char *data;

    dummy = Tcl_CreateInterp();

    data = TkGetBitmapData(dummy, NULL, (char *) filename,
	    (int *) width_return, (int *) height_return, x_hot_return,
	    y_hot_return);
    if (data == NULL) {
	return BitmapFileInvalid;
    }

    *bitmap_return = XCreateBitmapFromData(display, d, data, *width_return,
	    *height_return);

    Tcl_DeleteInterp(dummy);
    ckfree(data);
    return BitmapSuccess;
}







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
65
66
67
68
69
70
71

















































    ximage.bitmap_pad = 8;
    ximage.bytes_per_line = (width+7)/8;

    TkPutImage(NULL, 0, display, pix, gc, &ximage, 0, 0, 0, 0, width, height);
    XFreeGC(display, gc);
    return pix;
}

















































Changes to xlib/xutil.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * xutil.c --
 *
 *	This function contains generic X emulation routines.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) xutil.c 1.10 96/04/09 23:26:21
 */

#include <stdlib.h>
#include <tk.h>

#ifdef MAC_TCL
#       include <Xutil.h>










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * xutil.c --
 *
 *	This function contains generic X emulation routines.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: xutil.c,v 1.1.4.1 1998/09/30 02:19:45 stanton Exp $
 */

#include <stdlib.h>
#include <tk.h>

#ifdef MAC_TCL
#       include <Xutil.h>